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