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 = 9 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: |