1 '                         Q B a s i c   G o r i l l a s
2 '
3 '                   Copyright (C) Microsoft Corporation 1990
4 '
5 ' Your mission is to hit your opponent with the exploding banana
6 ' by varying the angle and power of your throw, taking into account
7 ' wind speed, gravity, and the city skyline.
8 '
9 ' Speed of this game is determined by the constant SPEEDCONST.  If the
10 ' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line
11 ' below.  The larger the number the faster the game will go.
12 '
13 ' To run this game, press Shift+F5.
14 '
15 ' To exit QBasic, press Alt, F, X.
16 '
17 ' To get help on a BASIC keyword, move the cursor to the keyword and press
18 ' F1 or click the right mouse button.
19 '
20 
21 'Set default data type to integer for faster game play
22 DEFINT A-Z
23 
24 'Sub Declarations
25 DECLARE SUB DoSun (Mouth)
26 DECLARE SUB SetScreen ()
27 DECLARE SUB EndGame ()
28 DECLARE SUB Center (Row, Text$)
29 DECLARE SUB Intro ()
30 DECLARE SUB SparklePause ()
31 DECLARE SUB GetInputs (Player1$, Player2$, NumGames)
32 DECLARE SUB PlayGame (Player1$, Player2$, NumGames)
33 DECLARE SUB DoExplosion (x#, y#)
34 DECLARE SUB MakeCityScape (BCoor() AS ANY)
35 DECLARE SUB PlaceGorillas (BCoor() AS ANY)
36 DECLARE SUB UpdateScores (Record(), PlayerNum, Results)
37 DECLARE SUB DrawGorilla (x, y, arms)
38 DECLARE SUB GorillaIntro (Player1$, Player2$)
39 DECLARE SUB Rest (t#)
40 DECLARE SUB VictoryDance (Player)
41 DECLARE SUB ClearGorillas ()
42 DECLARE SUB DrawBan (xc#, yc#, r, bc)
43 DECLARE FUNCTION Scl (n!)
44 DECLARE FUNCTION GetNum# (Row, Col)
45 DECLARE FUNCTION DoShot (PlayerNum, x, y)
46 DECLARE FUNCTION ExplodeGorilla (x#, y#)
47 DECLARE FUNCTION Getn# (Row, Col)
48 DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)
49 DECLARE FUNCTION CalcDelay! ()
50 
51 'Make all arrays Dynamic
52 '$DYNAMIC
53 
54 'User-Defined TYPEs
55 TYPE XYPoint
56   XCoor AS INTEGER
57   YCoor AS INTEGER
58 END TYPE
59 
60 'Constants
61 CONST SPEEDCONST = 500
62 CONST TRUE = -1
63 CONST FALSE = NOT TRUE
64 CONST HITSELF = 1
65 CONST BACKATTR = 0
66 CONST OBJECTCOLOR = 1
67 CONST WINDOWCOLOR = 14
68 CONST SUNATTR = 3
69 CONST SUNHAPPY = FALSE
70 CONST SUNSHOCK = TRUE
71 CONST RIGHTUP = 1
72 CONST LEFTUP = 2
73 CONST ARMSDOWN = 3
74 
75 'Global Variables
76 DIM SHARED GorillaX(1 TO 2)  'Location of the two gorillas
77 DIM SHARED GorillaY(1 TO 2)
78 DIM SHARED LastBuilding
79 
80 DIM SHARED pi#
81 DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of banana
82 DIM SHARED GorD&(120)        'Graphical picture of Gorilla arms down
83 DIM SHARED GorL&(120)        'Gorilla left arm raised
84 DIM SHARED GorR&(120)        'Gorilla right arm raised
85 
86 DIM SHARED gravity#
87 DIM SHARED Wind
88 
89 'Screen Mode Variables
90 DIM SHARED ScrHeight
91 DIM SHARED ScrWidth
92 DIM SHARED Mode
93 DIM SHARED MaxCol
94 
95 'Screen Color Variables
96 DIM SHARED ExplosionColor
97 DIM SHARED SunColor
98 DIM SHARED BackColor
99 DIM SHARED SunHit
100 
101 DIM SHARED SunHt
102 DIM SHARED GHeight
103 DIM SHARED MachSpeed AS SINGLE
104 
105   DEF FnRan (x) = INT(RND(1) * x) + 1
106   DEF SEG = 0                         ' Set NumLock to ON
107   KeyFlags = PEEK(1047)
108   IF (KeyFlags AND 32) = 0 THEN
109     POKE 1047, KeyFlags OR 32
110   END IF
111   DEF SEG
112 
113   GOSUB InitVars
114   Intro
115   GetInputs Name1$, Name2$, NumGames
116   GorillaIntro Name1$, Name2$
117   PlayGame Name1$, Name2$, NumGames
118  
119   DEF SEG = 0                         ' Restore NumLock state
120   POKE 1047, KeyFlags
121   DEF SEG
122 END
123 
124 
125 CGABanana:
126   'BananaLeft
127   DATA 327686, -252645316, 60
128   'BananaDown
129   DATA 196618, -1057030081, 49344
130   'BananaUp
131   DATA 196618, -1056980800, 63
132   'BananaRight
133   DATA 327686,  1010580720, 240
134 
135 EGABanana:
136   'BananaLeft
137   DATA 458758,202116096,471604224,943208448,943208448,943208448,471604224,202116096,0
138   'BananaDown
139   DATA 262153, -2134835200, -2134802239, -2130771968, -2130738945,8323072, 8323199, 4063232, 4063294
140   'BananaUp
141   DATA 262153, 4063232, 4063294, 8323072, 8323199, -2130771968, -2130738945, -2134835200,-2134802239
142   'BananaRight
143   DATA 458758, -1061109760, -522133504, 1886416896, 1886416896, 1886416896,-522133504,-1061109760,0
144 
145 InitVars:
146   pi# = 4 * ATN(1#)
147 
148   'This is a clever way to pick the best graphics mode available
149   ON ERROR GOTO ScreenModeError
150   Mode = 1
151   SCREEN Mode
152   ON ERROR GOTO PaletteError
153   IF Mode = 9 THEN PALETTE 4, 0   'Check for 64K EGA
154   ON ERROR GOTO 0
155 
156   MachSpeed = CalcDelay
157 
158   IF Mode = 9 THEN
159     ScrWidth = 640
160     ScrHeight = 350
161     GHeight = 25
162     RESTORE EGABanana
163     REDIM LBan&(8), RBan&(8), UBan&(8), DBan&(8)
164 
165     FOR i = 0 TO 8
166       READ LBan&(i)
167     NEXT i
168 
169     FOR i = 0 TO 8
170       READ DBan&(i)
171     NEXT i
172 
173     FOR i = 0 TO 8
174       READ UBan&(i)
175     NEXT i
176 
177     FOR i = 0 TO 8
178       READ RBan&(i)
179     NEXT i
180 
181     SunHt = 39
182 
183   ELSE
184 
185     ScrWidth = 320
186     ScrHeight = 200
187     GHeight = 12
188     RESTORE CGABanana
189     REDIM LBan&(2), RBan&(2), UBan&(2), DBan&(2)
190     REDIM GorL&(20), GorD&(20), GorR&(20)
191 
192     FOR i = 0 TO 2
193       READ LBan&(i)
194     NEXT i
195     FOR i = 0 TO 2
196       READ DBan&(i)
197     NEXT i
198     FOR i = 0 TO 2
199       READ UBan&(i)
200     NEXT i
201     FOR i = 0 TO 2
202       READ RBan&(i)
203     NEXT i
204 
205     MachSpeed = MachSpeed * 1.3
206     SunHt = 20
207   END IF
208 RETURN
209 
210 ScreenModeError:
211   IF Mode = 1 THEN
212     CLS
213     LOCATE 10, 5
214     PRINT "Sorry, you must have CGA, EGA color, or VGA graphics to play GORILLA.BAS"
215     END
216   ELSE
217     Mode = 1
218     RESUME
219   END IF
220 
221 PaletteError:
222   Mode = 1            '64K EGA cards will run in CGA mode.
223   RESUME NEXT
224 
225 REM $STATIC
226 'CalcDelay:
227 '  Checks speed of the machine.
228 FUNCTION CalcDelay!
229 
230   s! = TIMER
231   DO
232     i! = i! + 1
233   LOOP UNTIL TIMER - s! >= .5
234   CalcDelay! = i!
235 
236 END FUNCTION
237 
238 ' Center:
239 '   Centers and prints a text string on a given row
240 ' Parameters:
241 '   Row - screen row number
242 '   Text$ - text to be printed
243 '
244 SUB Center (Row, Text$)
245   Col = MaxCol \ 2
246   LOCATE Row, Col - (LEN(Text$) / 2 + .5)
247   PRINT Text$;
248 END SUB
249 
250 ' DoExplosion:
251 '   Produces explosion when a shot is fired
252 ' Parameters:
253 '   X#, Y# - location of explosion
254 '
255 SUB DoExplosion (x#, y#)
256 
257   PLAY "MBO0L32EFGEFDC"
258   Radius = ScrHeight / 50
259   IF Mode = 9 THEN Inc# = .5 ELSE Inc# = .41
260   FOR c# = 0 TO Radius STEP Inc#
261     CIRCLE (x#, y#), c#, ExplosionColor
262   NEXT c#
263   FOR c# = Radius TO 0 STEP (-1 * Inc#)
264     CIRCLE (x#, y#), c#, BACKATTR
265     FOR i = 1 TO 100
266     NEXT i
267     Rest .005
268   NEXT c#
269 END SUB
270 
271 ' DoShot:
272 '   Controls banana shots by accepting player input and plotting
273 '   shot angle
274 ' Parameters:
275 '   PlayerNum - Player
276 '   x, y - Player's gorilla position
277 '
278 FUNCTION DoShot (PlayerNum, x, y)
279 
280   'Input shot
281   IF PlayerNum = 1 THEN
282     LocateCol = 1
283   ELSE
284     IF Mode = 9 THEN
285       LocateCol = 66
286     ELSE
287       LocateCol = 26
288     END IF
289   END IF
290 
291   LOCATE 2, LocateCol
292   PRINT "Angle:";
293   Angle# = GetNum#(2, LocateCol + 7)
294 
295   LOCATE 3, LocateCol
296   PRINT "Velocity:";
297   Velocity = GetNum#(3, LocateCol + 10)
298 
299   IF PlayerNum = 2 THEN
300     Angle# = 180 - Angle#
301   END IF
302 
303   'Erase input
304   FOR i = 1 TO 4
305     LOCATE i, 1
306     PRINT SPACE$(30 \ (80 \ MaxCol));
307     LOCATE i, (50 \ (80 \ MaxCol))
308     PRINT SPACE$(30 \ (80 \ MaxCol));
309   NEXT
310 
311   SunHit = FALSE
312   PlayerHit = PlotShot(x, y, Angle#, Velocity, PlayerNum)
313   IF PlayerHit = 0 THEN
314     DoShot = FALSE
315   ELSE
316     DoShot = TRUE
317     IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum
318     VictoryDance PlayerNum
319   END IF
320 
321 END FUNCTION
322 
323 ' DoSun:
324 '   Draws the sun at the top of the screen.
325 ' Parameters:
326 '   Mouth - If TRUE draws "O" mouth else draws a smile mouth.
327 '
328 SUB DoSun (Mouth)
329 
330   'set position of sun
331   x = ScrWidth \ 2: y = Scl(25)
332 
333   'clear old sun
334   LINE (x - Scl(22), y - Scl(18))-(x + Scl(22), y + Scl(18)), BACKATTR, BF
335 
336   'draw new sun:
337   'body
338   CIRCLE (x, y), Scl(12), SUNATTR
339   PAINT (x, y), SUNATTR
340 
341   'rays
342   LINE (x - Scl(20), y)-(x + Scl(20), y), SUNATTR
343   LINE (x, y - Scl(15))-(x, y + Scl(15)), SUNATTR
344 
345   LINE (x - Scl(15), y - Scl(10))-(x + Scl(15), y + Scl(10)), SUNATTR
346   LINE (x - Scl(15), y + Scl(10))-(x + Scl(15), y - Scl(10)), SUNATTR
347 
348   LINE (x - Scl(8), y - Scl(13))-(x + Scl(8), y + Scl(13)), SUNATTR
349   LINE (x - Scl(8), y + Scl(13))-(x + Scl(8), y - Scl(13)), SUNATTR
350 
351   LINE (x - Scl(18), y - Scl(5))-(x + Scl(18), y + Scl(5)), SUNATTR
352   LINE (x - Scl(18), y + Scl(5))-(x + Scl(18), y - Scl(5)), SUNATTR
353 
354   'mouth
355   IF Mouth THEN  'draw "o" mouth
356     CIRCLE (x, y + Scl(5)), Scl(2.9), 0
357     PAINT (x, y + Scl(5)), 0, 0
358   ELSE           'draw smile
359     CIRCLE (x, y), Scl(8), 0, (210 * pi# / 180), (330 * pi# / 180)
360   END IF
361 
362   'eyes
363   CIRCLE (x - 3, y - 2), 1, 0
364   CIRCLE (x + 3, y - 2), 1, 0
365   PSET (x - 3, y - 2), 0
366   PSET (x + 3, y - 2), 0
367 
368 END SUB
369 
370 'DrawBan:
371 '  Draws the banana
372 'Parameters:
373 '  xc# - Horizontal Coordinate
374 '  yc# - Vertical Coordinate
375 '  r - rotation position (0-3). (  \_/  ) /-\
376 '  bc - if TRUE then DrawBan draws the banana ELSE it erases the banana
377 SUB DrawBan (xc#, yc#, r, bc)
378 
379 SELECT CASE r
380   CASE 0
381     IF bc THEN PUT (xc#, yc#), LBan&, PSET ELSE PUT (xc#, yc#), LBan&, XOR
382   CASE 1
383     IF bc THEN PUT (xc#, yc#), UBan&, PSET ELSE PUT (xc#, yc#), UBan&, XOR
384   CASE 2
385     IF bc THEN PUT (xc#, yc#), DBan&, PSET ELSE PUT (xc#, yc#), DBan&, XOR
386   CASE 3
387     IF bc THEN PUT (xc#, yc#), RBan&, PSET ELSE PUT (xc#, yc#), RBan&, XOR
388 END SELECT
389 
390 END SUB
391 
392 'DrawGorilla:
393 '  Draws the Gorilla in either CGA or EGA mode
394 '  and saves the graphics data in an array.
395 'Parameters:
396 '  x - x coordinate of gorilla
397 '  y - y coordinate of the gorilla
398 '  arms - either Left up, Right up, or both down
399 SUB DrawGorilla (x, y, arms)
400   DIM i AS SINGLE   ' Local index must be single precision
401 
402   'draw head
403   LINE (x - Scl(4), y)-(x + Scl(2.9), y + Scl(6)), OBJECTCOLOR, BF
404   LINE (x - Scl(5), y + Scl(2))-(x + Scl(4), y + Scl(4)), OBJECTCOLOR, BF
405 
406   'draw eyes/brow
407   LINE (x - Scl(3), y + Scl(2))-(x + Scl(2), y + Scl(2)), 0
408 
409   'draw nose if ega
410   IF Mode = 9 THEN
411     FOR i = -2 TO -1
412       PSET (x + i, y + 4), 0
413       PSET (x + i + 3, y + 4), 0
414     NEXT i
415   END IF
416 
417   'neck
418   LINE (x - Scl(3), y + Scl(7))-(x + Scl(2), y + Scl(7)), OBJECTCOLOR
419 
420   'body
421   LINE (x - Scl(8), y + Scl(8))-(x + Scl(6.9), y + Scl(14)), OBJECTCOLOR, BF
422   LINE (x - Scl(6), y + Scl(15))-(x + Scl(4.9), y + Scl(20)), OBJECTCOLOR, BF
423 
424   'legs
425   FOR i = 0 TO 4
426     CIRCLE (x + Scl(i), y + Scl(25)), Scl(10), OBJECTCOLOR, 3 * pi# / 4, 9 * pi# / 8
427     CIRCLE (x + Scl(-6) + Scl(i - .1), y + Scl(25)), Scl(10), OBJECTCOLOR, 15 * pi# / 8, pi# / 4
428   NEXT
429 
430   'chest
431   CIRCLE (x - Scl(4.9), y + Scl(10)), Scl(4.9), 0, 3 * pi# / 2, 0
432   CIRCLE (x + Scl(4.9), y + Scl(10)), Scl(4.9), 0, pi#, 3 * pi# / 2
433 
434   FOR i = -5 TO -1
435     SELECT CASE arms
436       CASE 1
437         'Right arm up
438         CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
439         CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(4)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
440         GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorR&
441       CASE 2
442         'Left arm up
443         CIRCLE (x + Scl(i - .1), y + Scl(4)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
444         CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
445         GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorL&
446       CASE 3
447         'Both arms down
448         CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
449         CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
450         GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorD&
451     END SELECT
452   NEXT i
453 END SUB
454 
455 'ExplodeGorilla:
456 '  Causes gorilla explosion when a direct hit occurs
457 'Parameters:
458 '  X#, Y# - shot location
459 FUNCTION ExplodeGorilla (x#, y#)
460   YAdj = Scl(12)
461   XAdj = Scl(5)
462   SclX# = ScrWidth / 320
463   SclY# = ScrHeight / 200
464   IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2
465   PLAY "MBO0L16EFGEFDC"
466 
467   FOR i = 1 TO 8 * SclX#
468     CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), i, ExplosionColor, , , -1.57
469     LINE (GorillaX(PlayerHit) + 7 * SclX#, GorillaY(PlayerHit) + 9 * SclY# - i)-(GorillaX(PlayerHit), GorillaY(PlayerHit) + 9 * SclY# - i), ExplosionColor
470   NEXT i
471 
472   FOR i = 1 TO 16 * SclX#
473     IF i < (8 * SclX#) THEN CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), (8 * SclX# + 1) - i, BACKATTR, , , -1.57
474     CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57
475   NEXT i
476 
477   FOR i = 24 * SclX# TO 1 STEP -1
478     CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, BACKATTR, , , -1.57
479     FOR Count = 1 TO 200
480     NEXT
481   NEXT i
482 
483   ExplodeGorilla = PlayerHit
484 END FUNCTION
485 
486 'GetInputs:
487 '  Gets user inputs at beginning of game
488 'Parameters:
489 '  Player1$, Player2$ - player names
490 '  NumGames - number of games to play
491 SUB GetInputs (Player1$, Player2$, NumGames)
492   COLOR 7, 0
493   CLS
494 
495   LOCATE 8, 15
496   LINE INPUT "Name of Player 1 (Default = 'Player 1'): "; Player1$
497   IF Player1$ = "" THEN
498     Player1$ = "Player 1"
499   ELSE
500     Player1$ = LEFT$(Player1$, 10)
501   END IF
502 
503   LOCATE 10, 15
504   LINE INPUT "Name of Player 2 (Default = 'Player 2'): "; Player2$
505   IF Player2$ = "" THEN
506     Player2$ = "Player 2"
507   ELSE
508     Player2$ = LEFT$(Player2$, 10)
509   END IF
510 
511   DO
512     LOCATE 12, 56: PRINT SPACE$(25);
513     LOCATE 12, 13
514     INPUT "Play to how many total points (Default = 3)"; game$
515     NumGames = VAL(LEFT$(game$, 2))
516   LOOP UNTIL NumGames > 0 AND LEN(game$) < 3 OR LEN(game$) = 0
517   IF NumGames = 0 THEN NumGames = 3
518 
519   DO
520     LOCATE 14, 53: PRINT SPACE$(28);
521     LOCATE 14, 17
522     INPUT "Gravity in Meters/Sec (Earth = 9.8)"; grav$
523     gravity# = VAL(grav$)
524   LOOP UNTIL gravity# > 0 OR LEN(grav$) = 0
525   IF gravity# = 0 THEN gravity# = 9.8
526 END SUB
527 
528 'GetNum:
529 '  Gets valid numeric input from user
530 'Parameters:
531 '  Row, Col - location to echo input
532 FUNCTION GetNum# (Row, Col)
533   Result$ = ""
534   Done = FALSE
535   WHILE INKEY$ <> "": WEND   'Clear keyboard buffer
536 
537   DO WHILE NOT Done
538 
539     LOCATE Row, Col
540     PRINT Result$; CHR$(95); "    ";
541 
542     Kbd$ = INKEY$
543     SELECT CASE Kbd$
544       CASE "0" TO "9"
545         Result$ = Result$ + Kbd$
546       CASE "."
547         IF INSTR(Result$, ".") = 0 THEN
548           Result$ = Result$ + Kbd$
549         END IF
550       CASE CHR$(13)
551         IF VAL(Result$) > 360 THEN
552           Result$ = ""
553         ELSE
554           Done = TRUE
555         END IF
556       CASE CHR$(8)
557         IF LEN(Result$) > 0 THEN
558           Result$ = LEFT$(Result$, LEN(Result$) - 1)
559         END IF
560       CASE ELSE
561         IF LEN(Kbd$) > 0 THEN
562           BEEP
563         END IF
564       END SELECT
565   LOOP
566 
567   LOCATE Row, Col
568   PRINT Result$; " ";
569 
570   GetNum# = VAL(Result$)
571 END FUNCTION
572 
573 'GorillaIntro:
574 '  Displays gorillas on screen for the first time
575 '  allows the graphical data to be put into an array
576 'Parameters:
577 '  Player1$, Player2$ - The names of the players
578 '
579 SUB GorillaIntro (Player1$, Player2$)
580   LOCATE 16, 34: PRINT "--------------"
581   LOCATE 18, 34: PRINT "V = View Intro"
582   LOCATE 19, 34: PRINT "P = Play Game"
583   LOCATE 21, 35: PRINT "Your Choice?"
584 
585   DO WHILE Char$ = ""
586     Char$ = INKEY$
587   LOOP
588 
589   IF Mode = 1 THEN
590     x = 125
591     y = 100
592   ELSE
593     x = 278
594     y = 175
595   END IF
596 
597   SCREEN Mode
598   SetScreen
599 
600   IF Mode = 1 THEN Center 5, "Please wait while gorillas are drawn."
601 
602   VIEW PRINT 9 TO 24
603 
604   IF Mode = 9 THEN PALETTE OBJECTCOLOR, BackColor
605  
606   DrawGorilla x, y, ARMSDOWN
607   CLS 2
608   DrawGorilla x, y, LEFTUP
609   CLS 2
610   DrawGorilla x, y, RIGHTUP
611   CLS 2
612  
613   VIEW PRINT 1 TO 25
614   IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46
615  
616   IF UCASE$(Char$) = "V" THEN
617     Center 2, "Q B A S I C   G O R I L L A S"
618     Center 5, "             STARRING:               "
619     P$ = Player1$ + " AND " + Player2$
620     Center 7, P$
621 
622     PUT (x - 13, y), GorD&, PSET
623     PUT (x + 47, y), GorD&, PSET
624     Rest 1
625 
626     PUT (x - 13, y), GorL&, PSET
627     PUT (x + 47, y), GorR&, PSET
628     PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b"
629     Rest .3
630 
631     PUT (x - 13, y), GorR&, PSET
632     PUT (x + 47, y), GorL&, PSET
633     PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-"
634     Rest .3
635 
636     PUT (x - 13, y), GorL&, PSET
637     PUT (x + 47, y), GorR&, PSET
638     PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-"
639     Rest .3
640 
641     PUT (x - 13, y), GorR&, PSET
642     PUT (x + 47, y), GorL&, PSET
643     PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b"
644     Rest .3
645 
646     FOR i = 1 TO 4
647       PUT (x - 13, y), GorL&, PSET
648       PUT (x + 47, y), GorR&, PSET
649       PLAY "T160O0L32EFGEFDC"
650       Rest .1
651       PUT (x - 13, y), GorR&, PSET
652       PUT (x + 47, y), GorL&, PSET
653       PLAY "T160O0L32EFGEFDC"
654       Rest .1
655     NEXT
656   END IF
657 END SUB
658 
659 'Intro:
660 '  Displays game introduction
661 SUB Intro
662 
663   SCREEN 0
664   WIDTH 80, 25
665   MaxCol = 80
666   COLOR 15, 0
667   CLS
668 
669   Center 4, "Q B a s i c    G O R I L L A S"
670   COLOR 7
671   Center 6, "Copyright (C) Microsoft Corporation 1990"
672   Center 8, "Your mission is to hit your opponent with the exploding"
673   Center 9, "banana by varying the angle and power of your throw, taking"
674   Center 10, "into account wind speed, gravity, and the city skyline."
675   Center 11, "The wind speed is shown by a directional arrow at the bottom"
676   Center 12, "of the playing field, its length relative to its strength."
677   Center 24, "Press any key to continue"
678 
679   PLAY "MBT160O1L8CDEDCDL4ECC"
680   SparklePause
681   IF Mode = 1 THEN MaxCol = 40
682 END SUB
683 
684 'MakeCityScape:
685 '  Creates random skyline for game
686 'Parameters:
687 '  BCoor() - a user-defined type array which stores the coordinates of
688 '  the upper left corner of each building.
689 SUB MakeCityScape (BCoor() AS XYPoint)
690 
691   x = 2
692 
693   'Set the sloping trend of the city scape. NewHt is new building height
694   Slope = FnRan(6)
695   SELECT CASE Slope
696     CASE 1: NewHt = 15                 'Upward slope
697     CASE 2: NewHt = 130                'Downward slope
698     CASE 3 TO 5: NewHt = 15            '"V" slope - most common
699     CASE 6: NewHt = 130                'Inverted "V" slope
700   END SELECT
701 
702   IF Mode = 9 THEN
703     BottomLine = 335                   'Bottom of building
704     HtInc = 10                         'Increase value for new height
705     DefBWidth = 37                     'Default building height
706     RandomHeight = 120                 'Random height difference
707     WWidth = 3                         'Window width
708     WHeight = 6                        'Window height
709     WDifV = 15                         'Counter for window spacing - vertical
710     WDifh = 10                         'Counter for window spacing - horizontal
711   ELSE
712     BottomLine = 190
713     HtInc = 6
714     NewHt = NewHt * 20 \ 35            'Adjust for CGA
715     DefBWidth = 18
716     RandomHeight = 54
717     WWidth = 1
718     WHeight = 2
719     WDifV = 5
720     WDifh = 4
721   END IF
722 
723   CurBuilding = 1
724   DO
725 
726     SELECT CASE Slope
727       CASE 1
728         NewHt = NewHt + HtInc
729       CASE 2
730         NewHt = NewHt - HtInc
731       CASE 3 TO 5
732         IF x > ScrWidth \ 2 THEN
733           NewHt = NewHt - 2 * HtInc
734         ELSE
735           NewHt = NewHt + 2 * HtInc
736         END IF
737       CASE 4
738         IF x > ScrWidth \ 2 THEN
739           NewHt = NewHt + 2 * HtInc
740         ELSE
741           NewHt = NewHt - 2 * HtInc
742         END IF
743     END SELECT
744 
745     'Set width of building and check to see if it would go off the screen
746     BWidth = FnRan(DefBWidth) + DefBWidth
747     IF x + BWidth > ScrWidth THEN BWidth = ScrWidth - x - 2
748 
749     'Set height of building and check to see if it goes below screen
750     BHeight = FnRan(RandomHeight) + NewHt
751     IF BHeight < HtInc THEN BHeight = HtInc
752 
753     'Check to see if Building is too high
754     IF BottomLine - BHeight <= MaxHeight + GHeight THEN BHeight = MaxHeight + GHeight - 5
755 
756     'Set the coordinates of the building into the array
757     BCoor(CurBuilding).XCoor = x
758     BCoor(CurBuilding).YCoor = BottomLine - BHeight
759 
760     IF Mode = 9 THEN BuildingColor = FnRan(3) + 4 ELSE BuildingColor = 2
761 
762     'Draw the building, outline first, then filled
763     LINE (x - 1, BottomLine + 1)-(x + BWidth + 1, BottomLine - BHeight - 1), BACKGROUND, B
764     LINE (x, BottomLine)-(x + BWidth, BottomLine - BHeight), BuildingColor, BF
765 
766     'Draw the windows
767     c = x + 3
768     DO
769       FOR i = BHeight - 3 TO 7 STEP -WDifV
770         IF Mode <> 9 THEN
771           WinColr = (FnRan(2) - 2) * -3
772         ELSEIF FnRan(4) = 1 THEN
773           WinColr = 8
774         ELSE
775           WinColr = WINDOWCOLOR
776         END IF
777         LINE (c, BottomLine - i)-(c + WWidth, BottomLine - i + WHeight), WinColr, BF
778       NEXT
779       c = c + WDifh
780     LOOP UNTIL c >= x + BWidth - 3
781 
782     x = x + BWidth + 2
783 
784     CurBuilding = CurBuilding + 1
785 
786   LOOP UNTIL x > ScrWidth - HtInc
787 
788   LastBuilding = CurBuilding - 1
789 
790   'Set Wind speed
791   Wind = FnRan(10) - 5
792   IF FnRan(3) = 1 THEN
793     IF Wind > 0 THEN
794       Wind = Wind + FnRan(10)
795     ELSE
796       Wind = Wind - FnRan(10)
797     END IF
798   END IF
799 
800   'Draw Wind speed arrow
801   IF Wind <> 0 THEN
802     WindLine = Wind * 3 * (ScrWidth \ 320)
803     LINE (ScrWidth \ 2, ScrHeight - 5)-(ScrWidth \ 2 + WindLine, ScrHeight - 5), ExplosionColor
804     IF Wind > 0 THEN ArrowDir = -2 ELSE ArrowDir = 2
805     LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 - 2), ExplosionColor
806     LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 + 2), ExplosionColor
807   END IF
808 END SUB
809 
810 'PlaceGorillas:
811 '  PUTs the Gorillas on top of the buildings.  Must have drawn
812 '  Gorillas first.
813 'Parameters:
814 '  BCoor() - user-defined TYPE array which stores upper left coordinates
815 '  of each building.
816 SUB PlaceGorillas (BCoor() AS XYPoint)
817     
818   IF Mode = 9 THEN
819     XAdj = 14
820     YAdj = 30
821   ELSE
822     XAdj = 7
823     YAdj = 16
824   END IF
825   SclX# = ScrWidth / 320
826   SclY# = ScrHeight / 200
827     
828   'Place gorillas on second or third building from edge
829   FOR i = 1 TO 2
830     IF i = 1 THEN BNum = FnRan(2) + 1 ELSE BNum = LastBuilding - FnRan(2)
831 
832     BWidth = BCoor(BNum + 1).XCoor - BCoor(BNum).XCoor
833     GorillaX(i) = BCoor(BNum).XCoor + BWidth / 2 - XAdj
834     GorillaY(i) = BCoor(BNum).YCoor - YAdj
835     PUT (GorillaX(i), GorillaY(i)), GorD&, PSET
836   NEXT i
837 
838 END SUB
839 
840 'PlayGame:
841 '  Main game play routine
842 'Parameters:
843 '  Player1$, Player2$ - player names
844 '  NumGames - number of games to play
845 SUB PlayGame (Player1$, Player2$, NumGames)
846   DIM BCoor(0 TO 30) AS XYPoint
847   DIM TotalWins(1 TO 2)
848 
849   J = 1
850   
851   FOR i = 1 TO NumGames
852     
853     CLS
854     RANDOMIZE (TIMER)
855     CALL MakeCityScape(BCoor())
856     CALL PlaceGorillas(BCoor())
857     DoSun SUNHAPPY
858     Hit = FALSE
859     DO WHILE Hit = FALSE
860       J = 1 - J
861       LOCATE 1, 1
862       PRINT Player1$
863       LOCATE 1, (MaxCol - 1 - LEN(Player2$))
864       PRINT Player2$
865       Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2)))
866       Tosser = J + 1: Tossee = 3 - J
867 
868       'Plot the shot.  Hit is true if Gorilla gets hit.
869       Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser))
870 
871       'Reset the sun, if it got hit
872       IF SunHit THEN DoSun SUNHAPPY
873 
874       IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit)
875     LOOP
876     SLEEP 1
877   NEXT i
878 
879   SCREEN 0
880   WIDTH 80, 25
881   COLOR 7, 0
882   MaxCol = 80
883   CLS
884 
885   Center 8, "GAME OVER!"
886   Center 10, "Score:"
887   LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1)
888   LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2)
889   Center 24, "Press any key to continue"
890   SparklePause
891   COLOR 7, 0
892   CLS
893 END SUB
894 
895 'PlayGame:
896 '  Plots banana shot across the screen
897 'Parameters:
898 '  StartX, StartY - starting shot location
899 '  Angle - shot angle
900 '  Velocity - shot velocity
901 '  PlayerNum - the banana thrower
902 FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)
903 
904   Angle# = Angle# / 180 * pi#  'Convert degree angle to radians
905   Radius = Mode MOD 7
906 
907   InitXVel# = COS(Angle#) * Velocity
908   InitYVel# = SIN(Angle#) * Velocity
909 
910   oldx# = StartX
911   oldy# = StartY
912 
913   'draw gorilla toss
914   IF PlayerNum = 1 THEN
915     PUT (StartX, StartY), GorL&, PSET
916   ELSE
917     PUT (StartX, StartY), GorR&, PSET
918   END IF
919   
920   'throw sound
921   PLAY "MBo0L32A-L64CL16BL64A+"
922   Rest .1
923 
924   'redraw gorilla
925   PUT (StartX, StartY), GorD&, PSET
926 
927   adjust = Scl(4)                   'For scaling CGA
928 
929   xedge = Scl(9) * (2 - PlayerNum)  'Find leading edge of banana for check
930 
931   Impact = FALSE
932   ShotInSun = FALSE
933   OnScreen = TRUE
934   PlayerHit = 0
935   NeedErase = FALSE
936 
937   StartXPos = StartX
938   StartYPos = StartY - adjust - 3
939 
940   IF PlayerNum = 2 THEN
941     StartXPos = StartXPos + Scl(25)
942     direction = Scl(4)
943   ELSE
944     direction = Scl(-4)
945   END IF
946 
947   IF Velocity < 2 THEN              'Shot too slow - hit self
948     x# = StartX
949     y# = StartY
950     pointval = OBJECTCOLOR
951   END IF
952    
953   DO WHILE (NOT Impact) AND OnScreen
954  
955   Rest .02
956 
957   'Erase old banana, if necessary
958   IF NeedErase THEN
959     NeedErase = FALSE
960     CALL DrawBan(oldx#, oldy#, oldrot, FALSE)
961   END IF
962 
963   x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)
964   y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350)
965          
966   IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN
967     OnScreen = FALSE
968   END IF
969 
970           
971   IF OnScreen AND y# > 0 THEN
972 
973     'check it
974     LookY = 0
975     LookX = Scl(8 * (2 - PlayerNum))
976     DO
977       pointval = POINT(x# + LookX, y# + LookY)
978       IF pointval = 0 THEN
979         Impact = FALSE
980         IF ShotInSun = TRUE THEN
981           IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE
982         END IF
983       ELSEIF pointval = SUNATTR AND y# < SunHt THEN
984         IF NOT SunHit THEN DoSun SUNSHOCK
985         SunHit = TRUE
986         ShotInSun = TRUE
987       ELSE
988         Impact = TRUE
989       END IF
990       LookX = LookX + direction
991       LookY = LookY + Scl(6)
992     LOOP UNTIL Impact OR LookX <> Scl(4)
993    
994     IF NOT ShotInSun AND NOT Impact THEN
995       'plot it
996       rot = (t# * 10) MOD 4
997       CALL DrawBan(x#, y#, rot, TRUE)
998       NeedErase = TRUE
999     END IF
1000             
1001     oldx# = x#
1002     oldy# = y#
1003     oldrot = rot
1004 
1005   END IF
1006 
1007       
1008   t# = t# + .1
1009 
1010   LOOP
1011 
1012   IF pointval <> OBJECTCOLOR AND Impact THEN
1013     CALL DoExplosion(x# + adjust, y# + adjust)
1014   ELSEIF pointval = OBJECTCOLOR THEN
1015     PlayerHit = ExplodeGorilla(x#, y#)
1016   END IF
1017 
1018   PlotShot = PlayerHit
1019 
1020 END FUNCTION
1021 
1022 'Rest:
1023 '  pauses the program
1024 SUB Rest (t#)
1025   s# = TIMER
1026   t2# = MachSpeed * t# / SPEEDCONST
1027   DO
1028   LOOP UNTIL TIMER - s# > t2#
1029 END SUB
1030 
1031 'Scl:
1032 '  Pass the number in to scaling for cga.  If the number is a decimal, then we
1033 '  want to scale down for cga or scale up for ega.  This allows a full range
1034 '  of numbers to be generated for scaling.
1035 '  (i.e. for 3 to get scaled to 1, pass in 2.9)
1036 FUNCTION Scl (n!)
1037 
1038   IF n! <> INT(n!) THEN
1039       IF Mode = 1 THEN n! = n! - 1
1040   END IF
1041   IF Mode = 1 THEN
1042       Scl = CINT(n! / 2 + .1)
1043   ELSE
1044       Scl = CINT(n!)
1045   END IF
1046 
1047 END FUNCTION
1048 
1049 'SetScreen:
1050 '  Sets the appropriate color statements
1051 SUB SetScreen
1052 
1053   IF Mode = 9 THEN
1054     ExplosionColor = 2
1055     BackColor = 1
1056     PALETTE 0, 1
1057     PALETTE 1, 46
1058     PALETTE 2, 44
1059     PALETTE 3, 54
1060     PALETTE 5, 7
1061     PALETTE 6, 4
1062     PALETTE 7, 3
1063     PALETTE 9, 63       'Display Color
1064   ELSE
1065     ExplosionColor = 2
1066     BackColor = 0
1067     COLOR BackColor, 2
1068 
1069   END IF
1070 
1071 END SUB
1072 
1073 'SparklePause:
1074 '  Creates flashing border for intro and game over screens
1075 SUB SparklePause
1076 
1077   COLOR 4, 0
1078   A$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "
1079   WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
1080 
1081   WHILE INKEY$ = ""
1082     FOR A = 1 TO 5
1083       LOCATE 1, 1                             'print horizontal sparkles
1084       PRINT MID$(A$, A, 80);
1085       LOCATE 22, 1
1086       PRINT MID$(A$, 6 - A, 80);
1087 
1088       FOR b = 2 TO 21                         'Print Vertical sparkles
1089         c = (A + b) MOD 5
1090         IF c = 1 THEN
1091           LOCATE b, 80
1092           PRINT "*";
1093           LOCATE 23 - b, 1
1094           PRINT "*";
1095         ELSE
1096           LOCATE b, 80
1097           PRINT " ";
1098           LOCATE 23 - b, 1
1099           PRINT " ";
1100         END IF
1101       NEXT b
1102     NEXT A
1103   WEND
1104 END SUB
1105 
1106 'UpdateScores:
1107 '  Updates players' scores
1108 'Parameters:
1109 '  Record - players' scores
1110 '  PlayerNum - player
1111 '  Results - results of player's shot
1112 SUB UpdateScores (Record(), PlayerNum, Results)
1113   IF Results = HITSELF THEN
1114     Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1
1115   ELSE
1116     Record(PlayerNum) = Record(PlayerNum) + 1
1117   END IF
1118 END SUB
1119 
1120 'VictoryDance:
1121 '  gorilla dances after he has eliminated his opponent
1122 'Parameters:
1123 '  Player - which gorilla is dancing
1124 SUB VictoryDance (Player)
1125 
1126   FOR i# = 1 TO 4
1127     PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET
1128     PLAY "MFO0L32EFGEFDC"
1129     Rest .2
1130     PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET
1131     PLAY "MFO0L32EFGEFDC"
1132     Rest .2
1133   NEXT
1134 END SUB
1135