turbobasic/1998/3RD-PA.RTY/QBASIC/GORILLA.BAS

   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