[mirrors/Programs.git] / turbobasic / 1998 / 3RD-PA.RTY / QBASIC / GORILLA.BAS

'                         Q B a s i c   G o r i l l a s\r
'\r
'                   Copyright (C) Microsoft Corporation 1990\r
'\r
' Your mission is to hit your opponent with the exploding banana\r
' by varying the angle and power of your throw, taking into account\r
' wind speed, gravity, and the city skyline.\r
'\r
' Speed of this game is determined by the constant SPEEDCONST.  If the\r
' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line\r
' below.  The larger the number the faster the game will go.\r
'\r
' To run this game, press Shift+F5.\r
'\r
' To exit QBasic, press Alt, F, X.\r
'\r
' To get help on a BASIC keyword, move the cursor to the keyword and press\r
' F1 or click the right mouse button.\r
'\r
\r
'Set default data type to integer for faster game play\r
DEFINT A-Z\r
\r
'Sub Declarations\r
DECLARE SUB DoSun (Mouth)\r
DECLARE SUB SetScreen ()\r
DECLARE SUB EndGame ()\r
DECLARE SUB Center (Row, Text$)\r
DECLARE SUB Intro ()\r
DECLARE SUB SparklePause ()\r
DECLARE SUB GetInputs (Player1$, Player2$, NumGames)\r
DECLARE SUB PlayGame (Player1$, Player2$, NumGames)\r
DECLARE SUB DoExplosion (x#, y#)\r
DECLARE SUB MakeCityScape (BCoor() AS ANY)\r
DECLARE SUB PlaceGorillas (BCoor() AS ANY)\r
DECLARE SUB UpdateScores (Record(), PlayerNum, Results)\r
DECLARE SUB DrawGorilla (x, y, arms)\r
DECLARE SUB GorillaIntro (Player1$, Player2$)\r
DECLARE SUB Rest (t#)\r
DECLARE SUB VictoryDance (Player)\r
DECLARE SUB ClearGorillas ()\r
DECLARE SUB DrawBan (xc#, yc#, r, bc)\r
DECLARE FUNCTION Scl (n!)\r
DECLARE FUNCTION GetNum# (Row, Col)\r
DECLARE FUNCTION DoShot (PlayerNum, x, y)\r
DECLARE FUNCTION ExplodeGorilla (x#, y#)\r
DECLARE FUNCTION Getn# (Row, Col)\r
DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
DECLARE FUNCTION CalcDelay! ()\r
\r
'Make all arrays Dynamic\r
'$DYNAMIC\r
\r
'User-Defined TYPEs\r
TYPE XYPoint\r
  XCoor AS INTEGER\r
  YCoor AS INTEGER\r
END TYPE\r
\r
'Constants\r
CONST SPEEDCONST = 500\r
CONST TRUE = -1\r
CONST FALSE = NOT TRUE\r
CONST HITSELF = 1\r
CONST BACKATTR = 0\r
CONST OBJECTCOLOR = 1\r
CONST WINDOWCOLOR = 14\r
CONST SUNATTR = 3\r
CONST SUNHAPPY = FALSE\r
CONST SUNSHOCK = TRUE\r
CONST RIGHTUP = 1\r
CONST LEFTUP = 2\r
CONST ARMSDOWN = 3\r
\r
'Global Variables\r
DIM SHARED GorillaX(1 TO 2)  'Location of the two gorillas\r
DIM SHARED GorillaY(1 TO 2)\r
DIM SHARED LastBuilding\r
\r
DIM SHARED pi#\r
DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of banana\r
DIM SHARED GorD&(120)        'Graphical picture of Gorilla arms down\r
DIM SHARED GorL&(120)        'Gorilla left arm raised\r
DIM SHARED GorR&(120)        'Gorilla right arm raised\r
\r
DIM SHARED gravity#\r
DIM SHARED Wind\r
\r
'Screen Mode Variables\r
DIM SHARED ScrHeight\r
DIM SHARED ScrWidth\r
DIM SHARED Mode\r
DIM SHARED MaxCol\r
\r
'Screen Color Variables\r
DIM SHARED ExplosionColor\r
DIM SHARED SunColor\r
DIM SHARED BackColor\r
DIM SHARED SunHit\r
\r
DIM SHARED SunHt\r
DIM SHARED GHeight\r
DIM SHARED MachSpeed AS SINGLE\r
\r
  DEF FnRan (x) = INT(RND(1) * x) + 1\r
  DEF SEG = 0                         ' Set NumLock to ON\r
  KeyFlags = PEEK(1047)\r
  IF (KeyFlags AND 32) = 0 THEN\r
    POKE 1047, KeyFlags OR 32\r
  END IF\r
  DEF SEG\r
\r
  GOSUB InitVars\r
  Intro\r
  GetInputs Name1$, Name2$, NumGames\r
  GorillaIntro Name1$, Name2$\r
  PlayGame Name1$, Name2$, NumGames\r
 \r
  DEF SEG = 0                         ' Restore NumLock state\r
  POKE 1047, KeyFlags\r
  DEF SEG\r
END\r
\r
\r
CGABanana:\r
  'BananaLeft\r
  DATA 327686, -252645316, 60\r
  'BananaDown\r
  DATA 196618, -1057030081, 49344\r
  'BananaUp\r
  DATA 196618, -1056980800, 63\r
  'BananaRight\r
  DATA 327686,  1010580720, 240\r
\r
EGABanana:\r
  'BananaLeft\r
  DATA 458758,202116096,471604224,943208448,943208448,943208448,471604224,202116096,0\r
  'BananaDown\r
  DATA 262153, -2134835200, -2134802239, -2130771968, -2130738945,8323072, 8323199, 4063232, 4063294\r
  'BananaUp\r
  DATA 262153, 4063232, 4063294, 8323072, 8323199, -2130771968, -2130738945, -2134835200,-2134802239\r
  'BananaRight\r
  DATA 458758, -1061109760, -522133504, 1886416896, 1886416896, 1886416896,-522133504,-1061109760,0\r
\r
InitVars:\r
  pi# = 4 * ATN(1#)\r
\r
  'This is a clever way to pick the best graphics mode available\r
  ON ERROR GOTO ScreenModeError\r
  Mode = 9\r
  SCREEN Mode\r
  ON ERROR GOTO PaletteError\r
  IF Mode = 9 THEN PALETTE 4, 0   'Check for 64K EGA\r
  ON ERROR GOTO 0\r
\r
  MachSpeed = CalcDelay\r
\r
  IF Mode = 9 THEN\r
    ScrWidth = 640\r
    ScrHeight = 350\r
    GHeight = 25\r
    RESTORE EGABanana\r
    REDIM LBan&(8), RBan&(8), UBan&(8), DBan&(8)\r
\r
    FOR i = 0 TO 8\r
      READ LBan&(i)\r
    NEXT i\r
\r
    FOR i = 0 TO 8\r
      READ DBan&(i)\r
    NEXT i\r
\r
    FOR i = 0 TO 8\r
      READ UBan&(i)\r
    NEXT i\r
\r
    FOR i = 0 TO 8\r
      READ RBan&(i)\r
    NEXT i\r
\r
    SunHt = 39\r
\r
  ELSE\r
\r
    ScrWidth = 320\r
    ScrHeight = 200\r
    GHeight = 12\r
    RESTORE CGABanana\r
    REDIM LBan&(2), RBan&(2), UBan&(2), DBan&(2)\r
    REDIM GorL&(20), GorD&(20), GorR&(20)\r
\r
    FOR i = 0 TO 2\r
      READ LBan&(i)\r
    NEXT i\r
    FOR i = 0 TO 2\r
      READ DBan&(i)\r
    NEXT i\r
    FOR i = 0 TO 2\r
      READ UBan&(i)\r
    NEXT i\r
    FOR i = 0 TO 2\r
      READ RBan&(i)\r
    NEXT i\r
\r
    MachSpeed = MachSpeed * 1.3\r
    SunHt = 20\r
  END IF\r
RETURN\r
\r
ScreenModeError:\r
  IF Mode = 1 THEN\r
    CLS\r
    LOCATE 10, 5\r
    PRINT "Sorry, you must have CGA, EGA color, or VGA graphics to play GORILLA.BAS"\r
    END\r
  ELSE\r
    Mode = 1\r
    RESUME\r
  END IF\r
\r
PaletteError:\r
  Mode = 1            '64K EGA cards will run in CGA mode.\r
  RESUME NEXT\r
\r
REM $STATIC\r
'CalcDelay:\r
'  Checks speed of the machine.\r
FUNCTION CalcDelay!\r
\r
  s! = TIMER\r
  DO\r
    i! = i! + 1\r
  LOOP UNTIL TIMER - s! >= .5\r
  CalcDelay! = i!\r
\r
END FUNCTION\r
\r
' Center:\r
'   Centers and prints a text string on a given row\r
' Parameters:\r
'   Row - screen row number\r
'   Text$ - text to be printed\r
'\r
SUB Center (Row, Text$)\r
  Col = MaxCol \ 2\r
  LOCATE Row, Col - (LEN(Text$) / 2 + .5)\r
  PRINT Text$;\r
END SUB\r
\r
' DoExplosion:\r
'   Produces explosion when a shot is fired\r
' Parameters:\r
'   X#, Y# - location of explosion\r
'\r
SUB DoExplosion (x#, y#)\r
\r
  PLAY "MBO0L32EFGEFDC"\r
  Radius = ScrHeight / 50\r
  IF Mode = 9 THEN Inc# = .5 ELSE Inc# = .41\r
  FOR c# = 0 TO Radius STEP Inc#\r
    CIRCLE (x#, y#), c#, ExplosionColor\r
  NEXT c#\r
  FOR c# = Radius TO 0 STEP (-1 * Inc#)\r
    CIRCLE (x#, y#), c#, BACKATTR\r
    FOR i = 1 TO 100\r
    NEXT i\r
    Rest .005\r
  NEXT c#\r
END SUB\r
\r
' DoShot:\r
'   Controls banana shots by accepting player input and plotting\r
'   shot angle\r
' Parameters:\r
'   PlayerNum - Player\r
'   x, y - Player's gorilla position\r
'\r
FUNCTION DoShot (PlayerNum, x, y)\r
\r
  'Input shot\r
  IF PlayerNum = 1 THEN\r
    LocateCol = 1\r
  ELSE\r
    IF Mode = 9 THEN\r
      LocateCol = 66\r
    ELSE\r
      LocateCol = 26\r
    END IF\r
  END IF\r
\r
  LOCATE 2, LocateCol\r
  PRINT "Angle:";\r
  Angle# = GetNum#(2, LocateCol + 7)\r
\r
  LOCATE 3, LocateCol\r
  PRINT "Velocity:";\r
  Velocity = GetNum#(3, LocateCol + 10)\r
\r
  IF PlayerNum = 2 THEN\r
    Angle# = 180 - Angle#\r
  END IF\r
\r
  'Erase input\r
  FOR i = 1 TO 4\r
    LOCATE i, 1\r
    PRINT SPACE$(30 \ (80 \ MaxCol));\r
    LOCATE i, (50 \ (80 \ MaxCol))\r
    PRINT SPACE$(30 \ (80 \ MaxCol));\r
  NEXT\r
\r
  SunHit = FALSE\r
  PlayerHit = PlotShot(x, y, Angle#, Velocity, PlayerNum)\r
  IF PlayerHit = 0 THEN\r
    DoShot = FALSE\r
  ELSE\r
    DoShot = TRUE\r
    IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum\r
    VictoryDance PlayerNum\r
  END IF\r
\r
END FUNCTION\r
\r
' DoSun:\r
'   Draws the sun at the top of the screen.\r
' Parameters:\r
'   Mouth - If TRUE draws "O" mouth else draws a smile mouth.\r
'\r
SUB DoSun (Mouth)\r
\r
  'set position of sun\r
  x = ScrWidth \ 2: y = Scl(25)\r
\r
  'clear old sun\r
  LINE (x - Scl(22), y - Scl(18))-(x + Scl(22), y + Scl(18)), BACKATTR, BF\r
\r
  'draw new sun:\r
  'body\r
  CIRCLE (x, y), Scl(12), SUNATTR\r
  PAINT (x, y), SUNATTR\r
\r
  'rays\r
  LINE (x - Scl(20), y)-(x + Scl(20), y), SUNATTR\r
  LINE (x, y - Scl(15))-(x, y + Scl(15)), SUNATTR\r
\r
  LINE (x - Scl(15), y - Scl(10))-(x + Scl(15), y + Scl(10)), SUNATTR\r
  LINE (x - Scl(15), y + Scl(10))-(x + Scl(15), y - Scl(10)), SUNATTR\r
\r
  LINE (x - Scl(8), y - Scl(13))-(x + Scl(8), y + Scl(13)), SUNATTR\r
  LINE (x - Scl(8), y + Scl(13))-(x + Scl(8), y - Scl(13)), SUNATTR\r
\r
  LINE (x - Scl(18), y - Scl(5))-(x + Scl(18), y + Scl(5)), SUNATTR\r
  LINE (x - Scl(18), y + Scl(5))-(x + Scl(18), y - Scl(5)), SUNATTR\r
\r
  'mouth\r
  IF Mouth THEN  'draw "o" mouth\r
    CIRCLE (x, y + Scl(5)), Scl(2.9), 0\r
    PAINT (x, y + Scl(5)), 0, 0\r
  ELSE           'draw smile\r
    CIRCLE (x, y), Scl(8), 0, (210 * pi# / 180), (330 * pi# / 180)\r
  END IF\r
\r
  'eyes\r
  CIRCLE (x - 3, y - 2), 1, 0\r
  CIRCLE (x + 3, y - 2), 1, 0\r
  PSET (x - 3, y - 2), 0\r
  PSET (x + 3, y - 2), 0\r
\r
END SUB\r
\r
'DrawBan:\r
'  Draws the banana\r
'Parameters:\r
'  xc# - Horizontal Coordinate\r
'  yc# - Vertical Coordinate\r
'  r - rotation position (0-3). (  \_/  ) /-\\r
'  bc - if TRUE then DrawBan draws the banana ELSE it erases the banana\r
SUB DrawBan (xc#, yc#, r, bc)\r
\r
SELECT CASE r\r
  CASE 0\r
    IF bc THEN PUT (xc#, yc#), LBan&, PSET ELSE PUT (xc#, yc#), LBan&, XOR\r
  CASE 1\r
    IF bc THEN PUT (xc#, yc#), UBan&, PSET ELSE PUT (xc#, yc#), UBan&, XOR\r
  CASE 2\r
    IF bc THEN PUT (xc#, yc#), DBan&, PSET ELSE PUT (xc#, yc#), DBan&, XOR\r
  CASE 3\r
    IF bc THEN PUT (xc#, yc#), RBan&, PSET ELSE PUT (xc#, yc#), RBan&, XOR\r
END SELECT\r
\r
END SUB\r
\r
'DrawGorilla:\r
'  Draws the Gorilla in either CGA or EGA mode\r
'  and saves the graphics data in an array.\r
'Parameters:\r
'  x - x coordinate of gorilla\r
'  y - y coordinate of the gorilla\r
'  arms - either Left up, Right up, or both down\r
SUB DrawGorilla (x, y, arms)\r
  DIM i AS SINGLE   ' Local index must be single precision\r
\r
  'draw head\r
  LINE (x - Scl(4), y)-(x + Scl(2.9), y + Scl(6)), OBJECTCOLOR, BF\r
  LINE (x - Scl(5), y + Scl(2))-(x + Scl(4), y + Scl(4)), OBJECTCOLOR, BF\r
\r
  'draw eyes/brow\r
  LINE (x - Scl(3), y + Scl(2))-(x + Scl(2), y + Scl(2)), 0\r
\r
  'draw nose if ega\r
  IF Mode = 9 THEN\r
    FOR i = -2 TO -1\r
      PSET (x + i, y + 4), 0\r
      PSET (x + i + 3, y + 4), 0\r
    NEXT i\r
  END IF\r
\r
  'neck\r
  LINE (x - Scl(3), y + Scl(7))-(x + Scl(2), y + Scl(7)), OBJECTCOLOR\r
\r
  'body\r
  LINE (x - Scl(8), y + Scl(8))-(x + Scl(6.9), y + Scl(14)), OBJECTCOLOR, BF\r
  LINE (x - Scl(6), y + Scl(15))-(x + Scl(4.9), y + Scl(20)), OBJECTCOLOR, BF\r
\r
  'legs\r
  FOR i = 0 TO 4\r
    CIRCLE (x + Scl(i), y + Scl(25)), Scl(10), OBJECTCOLOR, 3 * pi# / 4, 9 * pi# / 8\r
    CIRCLE (x + Scl(-6) + Scl(i - .1), y + Scl(25)), Scl(10), OBJECTCOLOR, 15 * pi# / 8, pi# / 4\r
  NEXT\r
\r
  'chest\r
  CIRCLE (x - Scl(4.9), y + Scl(10)), Scl(4.9), 0, 3 * pi# / 2, 0\r
  CIRCLE (x + Scl(4.9), y + Scl(10)), Scl(4.9), 0, pi#, 3 * pi# / 2\r
\r
  FOR i = -5 TO -1\r
    SELECT CASE arms\r
      CASE 1\r
        'Right arm up\r
        CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4\r
        CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(4)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4\r
        GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorR&\r
      CASE 2\r
        'Left arm up\r
        CIRCLE (x + Scl(i - .1), y + Scl(4)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4\r
        CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4\r
        GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorL&\r
      CASE 3\r
        'Both arms down\r
        CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4\r
        CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4\r
        GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorD&\r
    END SELECT\r
  NEXT i\r
END SUB\r
\r
'ExplodeGorilla:\r
'  Causes gorilla explosion when a direct hit occurs\r
'Parameters:\r
'  X#, Y# - shot location\r
FUNCTION ExplodeGorilla (x#, y#)\r
  YAdj = Scl(12)\r
  XAdj = Scl(5)\r
  SclX# = ScrWidth / 320\r
  SclY# = ScrHeight / 200\r
  IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2\r
  PLAY "MBO0L16EFGEFDC"\r
\r
  FOR i = 1 TO 8 * SclX#\r
    CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), i, ExplosionColor, , , -1.57\r
    LINE (GorillaX(PlayerHit) + 7 * SclX#, GorillaY(PlayerHit) + 9 * SclY# - i)-(GorillaX(PlayerHit), GorillaY(PlayerHit) + 9 * SclY# - i), ExplosionColor\r
  NEXT i\r
\r
  FOR i = 1 TO 16 * SclX#\r
    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
    CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57\r
  NEXT i\r
\r
  FOR i = 24 * SclX# TO 1 STEP -1\r
    CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, BACKATTR, , , -1.57\r
    FOR Count = 1 TO 200\r
    NEXT\r
  NEXT i\r
\r
  ExplodeGorilla = PlayerHit\r
END FUNCTION\r
\r
'GetInputs:\r
'  Gets user inputs at beginning of game\r
'Parameters:\r
'  Player1$, Player2$ - player names\r
'  NumGames - number of games to play\r
SUB GetInputs (Player1$, Player2$, NumGames)\r
  COLOR 7, 0\r
  CLS\r
\r
  LOCATE 8, 15\r
  LINE INPUT "Name of Player 1 (Default = 'Player 1'): "; Player1$\r
  IF Player1$ = "" THEN\r
    Player1$ = "Player 1"\r
  ELSE\r
    Player1$ = LEFT$(Player1$, 10)\r
  END IF\r
\r
  LOCATE 10, 15\r
  LINE INPUT "Name of Player 2 (Default = 'Player 2'): "; Player2$\r
  IF Player2$ = "" THEN\r
    Player2$ = "Player 2"\r
  ELSE\r
    Player2$ = LEFT$(Player2$, 10)\r
  END IF\r
\r
  DO\r
    LOCATE 12, 56: PRINT SPACE$(25);\r
    LOCATE 12, 13\r
    INPUT "Play to how many total points (Default = 3)"; game$\r
    NumGames = VAL(LEFT$(game$, 2))\r
  LOOP UNTIL NumGames > 0 AND LEN(game$) < 3 OR LEN(game$) = 0\r
  IF NumGames = 0 THEN NumGames = 3\r
\r
  DO\r
    LOCATE 14, 53: PRINT SPACE$(28);\r
    LOCATE 14, 17\r
    INPUT "Gravity in Meters/Sec (Earth = 9.8)"; grav$\r
    gravity# = VAL(grav$)\r
  LOOP UNTIL gravity# > 0 OR LEN(grav$) = 0\r
  IF gravity# = 0 THEN gravity# = 9.8\r
END SUB\r
\r
'GetNum:\r
'  Gets valid numeric input from user\r
'Parameters:\r
'  Row, Col - location to echo input\r
FUNCTION GetNum# (Row, Col)\r
  Result$ = ""\r
  Done = FALSE\r
  WHILE INKEY$ <> "": WEND   'Clear keyboard buffer\r
\r
  DO WHILE NOT Done\r
\r
    LOCATE Row, Col\r
    PRINT Result$; CHR$(95); "    ";\r
\r
    Kbd$ = INKEY$\r
    SELECT CASE Kbd$\r
      CASE "0" TO "9"\r
        Result$ = Result$ + Kbd$\r
      CASE "."\r
        IF INSTR(Result$, ".") = 0 THEN\r
          Result$ = Result$ + Kbd$\r
        END IF\r
      CASE CHR$(13)\r
        IF VAL(Result$) > 360 THEN\r
          Result$ = ""\r
        ELSE\r
          Done = TRUE\r
        END IF\r
      CASE CHR$(8)\r
        IF LEN(Result$) > 0 THEN\r
          Result$ = LEFT$(Result$, LEN(Result$) - 1)\r
        END IF\r
      CASE ELSE\r
        IF LEN(Kbd$) > 0 THEN\r
          BEEP\r
        END IF\r
      END SELECT\r
  LOOP\r
\r
  LOCATE Row, Col\r
  PRINT Result$; " ";\r
\r
  GetNum# = VAL(Result$)\r
END FUNCTION\r
\r
'GorillaIntro:\r
'  Displays gorillas on screen for the first time\r
'  allows the graphical data to be put into an array\r
'Parameters:\r
'  Player1$, Player2$ - The names of the players\r
'\r
SUB GorillaIntro (Player1$, Player2$)\r
  LOCATE 16, 34: PRINT "--------------"\r
  LOCATE 18, 34: PRINT "V = View Intro"\r
  LOCATE 19, 34: PRINT "P = Play Game"\r
  LOCATE 21, 35: PRINT "Your Choice?"\r
\r
  DO WHILE Char$ = ""\r
    Char$ = INKEY$\r
  LOOP\r
\r
  IF Mode = 1 THEN\r
    x = 125\r
    y = 100\r
  ELSE\r
    x = 278\r
    y = 175\r
  END IF\r
\r
  SCREEN Mode\r
  SetScreen\r
\r
  IF Mode = 1 THEN Center 5, "Please wait while gorillas are drawn."\r
\r
  VIEW PRINT 9 TO 24\r
\r
  IF Mode = 9 THEN PALETTE OBJECTCOLOR, BackColor\r
 \r
  DrawGorilla x, y, ARMSDOWN\r
  CLS 2\r
  DrawGorilla x, y, LEFTUP\r
  CLS 2\r
  DrawGorilla x, y, RIGHTUP\r
  CLS 2\r
 \r
  VIEW PRINT 1 TO 25\r
  IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46\r
 \r
  IF UCASE$(Char$) = "V" THEN\r
    Center 2, "Q B A S I C   G O R I L L A S"\r
    Center 5, "             STARRING:               "\r
    P$ = Player1$ + " AND " + Player2$\r
    Center 7, P$\r
\r
    PUT (x - 13, y), GorD&, PSET\r
    PUT (x + 47, y), GorD&, PSET\r
    Rest 1\r
\r
    PUT (x - 13, y), GorL&, PSET\r
    PUT (x + 47, y), GorR&, PSET\r
    PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b"\r
    Rest .3\r
\r
    PUT (x - 13, y), GorR&, PSET\r
    PUT (x + 47, y), GorL&, PSET\r
    PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-"\r
    Rest .3\r
\r
    PUT (x - 13, y), GorL&, PSET\r
    PUT (x + 47, y), GorR&, PSET\r
    PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-"\r
    Rest .3\r
\r
    PUT (x - 13, y), GorR&, PSET\r
    PUT (x + 47, y), GorL&, PSET\r
    PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b"\r
    Rest .3\r
\r
    FOR i = 1 TO 4\r
      PUT (x - 13, y), GorL&, PSET\r
      PUT (x + 47, y), GorR&, PSET\r
      PLAY "T160O0L32EFGEFDC"\r
      Rest .1\r
      PUT (x - 13, y), GorR&, PSET\r
      PUT (x + 47, y), GorL&, PSET\r
      PLAY "T160O0L32EFGEFDC"\r
      Rest .1\r
    NEXT\r
  END IF\r
END SUB\r
\r
'Intro:\r
'  Displays game introduction\r
SUB Intro\r
\r
  SCREEN 0\r
  WIDTH 80, 25\r
  MaxCol = 80\r
  COLOR 15, 0\r
  CLS\r
\r
  Center 4, "Q B a s i c    G O R I L L A S"\r
  COLOR 7\r
  Center 6, "Copyright (C) Microsoft Corporation 1990"\r
  Center 8, "Your mission is to hit your opponent with the exploding"\r
  Center 9, "banana by varying the angle and power of your throw, taking"\r
  Center 10, "into account wind speed, gravity, and the city skyline."\r
  Center 11, "The wind speed is shown by a directional arrow at the bottom"\r
  Center 12, "of the playing field, its length relative to its strength."\r
  Center 24, "Press any key to continue"\r
\r
  PLAY "MBT160O1L8CDEDCDL4ECC"\r
  SparklePause\r
  IF Mode = 1 THEN MaxCol = 40\r
END SUB\r
\r
'MakeCityScape:\r
'  Creates random skyline for game\r
'Parameters:\r
'  BCoor() - a user-defined type array which stores the coordinates of\r
'  the upper left corner of each building.\r
SUB MakeCityScape (BCoor() AS XYPoint)\r
\r
  x = 2\r
\r
  'Set the sloping trend of the city scape. NewHt is new building height\r
  Slope = FnRan(6)\r
  SELECT CASE Slope\r
    CASE 1: NewHt = 15                 'Upward slope\r
    CASE 2: NewHt = 130                'Downward slope\r
    CASE 3 TO 5: NewHt = 15            '"V" slope - most common\r
    CASE 6: NewHt = 130                'Inverted "V" slope\r
  END SELECT\r
\r
  IF Mode = 9 THEN\r
    BottomLine = 335                   'Bottom of building\r
    HtInc = 10                         'Increase value for new height\r
    DefBWidth = 37                     'Default building height\r
    RandomHeight = 120                 'Random height difference\r
    WWidth = 3                         'Window width\r
    WHeight = 6                        'Window height\r
    WDifV = 15                         'Counter for window spacing - vertical\r
    WDifh = 10                         'Counter for window spacing - horizontal\r
  ELSE\r
    BottomLine = 190\r
    HtInc = 6\r
    NewHt = NewHt * 20 \ 35            'Adjust for CGA\r
    DefBWidth = 18\r
    RandomHeight = 54\r
    WWidth = 1\r
    WHeight = 2\r
    WDifV = 5\r
    WDifh = 4\r
  END IF\r
\r
  CurBuilding = 1\r
  DO\r
\r
    SELECT CASE Slope\r
      CASE 1\r
        NewHt = NewHt + HtInc\r
      CASE 2\r
        NewHt = NewHt - HtInc\r
      CASE 3 TO 5\r
        IF x > ScrWidth \ 2 THEN\r
          NewHt = NewHt - 2 * HtInc\r
        ELSE\r
          NewHt = NewHt + 2 * HtInc\r
        END IF\r
      CASE 4\r
        IF x > ScrWidth \ 2 THEN\r
          NewHt = NewHt + 2 * HtInc\r
        ELSE\r
          NewHt = NewHt - 2 * HtInc\r
        END IF\r
    END SELECT\r
\r
    'Set width of building and check to see if it would go off the screen\r
    BWidth = FnRan(DefBWidth) + DefBWidth\r
    IF x + BWidth > ScrWidth THEN BWidth = ScrWidth - x - 2\r
\r
    'Set height of building and check to see if it goes below screen\r
    BHeight = FnRan(RandomHeight) + NewHt\r
    IF BHeight < HtInc THEN BHeight = HtInc\r
\r
    'Check to see if Building is too high\r
    IF BottomLine - BHeight <= MaxHeight + GHeight THEN BHeight = MaxHeight + GHeight - 5\r
\r
    'Set the coordinates of the building into the array\r
    BCoor(CurBuilding).XCoor = x\r
    BCoor(CurBuilding).YCoor = BottomLine - BHeight\r
\r
    IF Mode = 9 THEN BuildingColor = FnRan(3) + 4 ELSE BuildingColor = 2\r
\r
    'Draw the building, outline first, then filled\r
    LINE (x - 1, BottomLine + 1)-(x + BWidth + 1, BottomLine - BHeight - 1), BACKGROUND, B\r
    LINE (x, BottomLine)-(x + BWidth, BottomLine - BHeight), BuildingColor, BF\r
\r
    'Draw the windows\r
    c = x + 3\r
    DO\r
      FOR i = BHeight - 3 TO 7 STEP -WDifV\r
        IF Mode <> 9 THEN\r
          WinColr = (FnRan(2) - 2) * -3\r
        ELSEIF FnRan(4) = 1 THEN\r
          WinColr = 8\r
        ELSE\r
          WinColr = WINDOWCOLOR\r
        END IF\r
        LINE (c, BottomLine - i)-(c + WWidth, BottomLine - i + WHeight), WinColr, BF\r
      NEXT\r
      c = c + WDifh\r
    LOOP UNTIL c >= x + BWidth - 3\r
\r
    x = x + BWidth + 2\r
\r
    CurBuilding = CurBuilding + 1\r
\r
  LOOP UNTIL x > ScrWidth - HtInc\r
\r
  LastBuilding = CurBuilding - 1\r
\r
  'Set Wind speed\r
  Wind = FnRan(10) - 5\r
  IF FnRan(3) = 1 THEN\r
    IF Wind > 0 THEN\r
      Wind = Wind + FnRan(10)\r
    ELSE\r
      Wind = Wind - FnRan(10)\r
    END IF\r
  END IF\r
\r
  'Draw Wind speed arrow\r
  IF Wind <> 0 THEN\r
    WindLine = Wind * 3 * (ScrWidth \ 320)\r
    LINE (ScrWidth \ 2, ScrHeight - 5)-(ScrWidth \ 2 + WindLine, ScrHeight - 5), ExplosionColor\r
    IF Wind > 0 THEN ArrowDir = -2 ELSE ArrowDir = 2\r
    LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 - 2), ExplosionColor\r
    LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 + 2), ExplosionColor\r
  END IF\r
END SUB\r
\r
'PlaceGorillas:\r
'  PUTs the Gorillas on top of the buildings.  Must have drawn\r
'  Gorillas first.\r
'Parameters:\r
'  BCoor() - user-defined TYPE array which stores upper left coordinates\r
'  of each building.\r
SUB PlaceGorillas (BCoor() AS XYPoint)\r
    \r
  IF Mode = 9 THEN\r
    XAdj = 14\r
    YAdj = 30\r
  ELSE\r
    XAdj = 7\r
    YAdj = 16\r
  END IF\r
  SclX# = ScrWidth / 320\r
  SclY# = ScrHeight / 200\r
    \r
  'Place gorillas on second or third building from edge\r
  FOR i = 1 TO 2\r
    IF i = 1 THEN BNum = FnRan(2) + 1 ELSE BNum = LastBuilding - FnRan(2)\r
\r
    BWidth = BCoor(BNum + 1).XCoor - BCoor(BNum).XCoor\r
    GorillaX(i) = BCoor(BNum).XCoor + BWidth / 2 - XAdj\r
    GorillaY(i) = BCoor(BNum).YCoor - YAdj\r
    PUT (GorillaX(i), GorillaY(i)), GorD&, PSET\r
  NEXT i\r
\r
END SUB\r
\r
'PlayGame:\r
'  Main game play routine\r
'Parameters:\r
'  Player1$, Player2$ - player names\r
'  NumGames - number of games to play\r
SUB PlayGame (Player1$, Player2$, NumGames)\r
  DIM BCoor(0 TO 30) AS XYPoint\r
  DIM TotalWins(1 TO 2)\r
\r
  J = 1\r
  \r
  FOR i = 1 TO NumGames\r
    \r
    CLS\r
    RANDOMIZE (TIMER)\r
    CALL MakeCityScape(BCoor())\r
    CALL PlaceGorillas(BCoor())\r
    DoSun SUNHAPPY\r
    Hit = FALSE\r
    DO WHILE Hit = FALSE\r
      J = 1 - J\r
      LOCATE 1, 1\r
      PRINT Player1$\r
      LOCATE 1, (MaxCol - 1 - LEN(Player2$))\r
      PRINT Player2$\r
      Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2)))\r
      Tosser = J + 1: Tossee = 3 - J\r
\r
      'Plot the shot.  Hit is true if Gorilla gets hit.\r
      Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser))\r
\r
      'Reset the sun, if it got hit\r
      IF SunHit THEN DoSun SUNHAPPY\r
\r
      IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit)\r
    LOOP\r
    SLEEP 1\r
  NEXT i\r
\r
  SCREEN 0\r
  WIDTH 80, 25\r
  COLOR 7, 0\r
  MaxCol = 80\r
  CLS\r
\r
  Center 8, "GAME OVER!"\r
  Center 10, "Score:"\r
  LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1)\r
  LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2)\r
  Center 24, "Press any key to continue"\r
  SparklePause\r
  COLOR 7, 0\r
  CLS\r
END SUB\r
\r
'PlayGame:\r
'  Plots banana shot across the screen\r
'Parameters:\r
'  StartX, StartY - starting shot location\r
'  Angle - shot angle\r
'  Velocity - shot velocity\r
'  PlayerNum - the banana thrower\r
FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
\r
  Angle# = Angle# / 180 * pi#  'Convert degree angle to radians\r
  Radius = Mode MOD 7\r
\r
  InitXVel# = COS(Angle#) * Velocity\r
  InitYVel# = SIN(Angle#) * Velocity\r
\r
  oldx# = StartX\r
  oldy# = StartY\r
\r
  'draw gorilla toss\r
  IF PlayerNum = 1 THEN\r
    PUT (StartX, StartY), GorL&, PSET\r
  ELSE\r
    PUT (StartX, StartY), GorR&, PSET\r
  END IF\r
  \r
  'throw sound\r
  PLAY "MBo0L32A-L64CL16BL64A+"\r
  Rest .1\r
\r
  'redraw gorilla\r
  PUT (StartX, StartY), GorD&, PSET\r
\r
  adjust = Scl(4)                   'For scaling CGA\r
\r
  xedge = Scl(9) * (2 - PlayerNum)  'Find leading edge of banana for check\r
\r
  Impact = FALSE\r
  ShotInSun = FALSE\r
  OnScreen = TRUE\r
  PlayerHit = 0\r
  NeedErase = FALSE\r
\r
  StartXPos = StartX\r
  StartYPos = StartY - adjust - 3\r
\r
  IF PlayerNum = 2 THEN\r
    StartXPos = StartXPos + Scl(25)\r
    direction = Scl(4)\r
  ELSE\r
    direction = Scl(-4)\r
  END IF\r
\r
  IF Velocity < 2 THEN              'Shot too slow - hit self\r
    x# = StartX\r
    y# = StartY\r
    pointval = OBJECTCOLOR\r
  END IF\r
   \r
  DO WHILE (NOT Impact) AND OnScreen\r
 \r
  Rest .02\r
\r
  'Erase old banana, if necessary\r
  IF NeedErase THEN\r
    NeedErase = FALSE\r
    CALL DrawBan(oldx#, oldy#, oldrot, FALSE)\r
  END IF\r
\r
  x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)\r
  y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350)\r
         \r
  IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN\r
    OnScreen = FALSE\r
  END IF\r
\r
          \r
  IF OnScreen AND y# > 0 THEN\r
\r
    'check it\r
    LookY = 0\r
    LookX = Scl(8 * (2 - PlayerNum))\r
    DO\r
      pointval = POINT(x# + LookX, y# + LookY)\r
      IF pointval = 0 THEN\r
        Impact = FALSE\r
        IF ShotInSun = TRUE THEN\r
          IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE\r
        END IF\r
      ELSEIF pointval = SUNATTR AND y# < SunHt THEN\r
        IF NOT SunHit THEN DoSun SUNSHOCK\r
        SunHit = TRUE\r
        ShotInSun = TRUE\r
      ELSE\r
        Impact = TRUE\r
      END IF\r
      LookX = LookX + direction\r
      LookY = LookY + Scl(6)\r
    LOOP UNTIL Impact OR LookX <> Scl(4)\r
   \r
    IF NOT ShotInSun AND NOT Impact THEN\r
      'plot it\r
      rot = (t# * 10) MOD 4\r
      CALL DrawBan(x#, y#, rot, TRUE)\r
      NeedErase = TRUE\r
    END IF\r
            \r
    oldx# = x#\r
    oldy# = y#\r
    oldrot = rot\r
\r
  END IF\r
\r
      \r
  t# = t# + .1\r
\r
  LOOP\r
\r
  IF pointval <> OBJECTCOLOR AND Impact THEN\r
    CALL DoExplosion(x# + adjust, y# + adjust)\r
  ELSEIF pointval = OBJECTCOLOR THEN\r
    PlayerHit = ExplodeGorilla(x#, y#)\r
  END IF\r
\r
  PlotShot = PlayerHit\r
\r
END FUNCTION\r
\r
'Rest:\r
'  pauses the program\r
SUB Rest (t#)\r
  s# = TIMER\r
  t2# = MachSpeed * t# / SPEEDCONST\r
  DO\r
  LOOP UNTIL TIMER - s# > t2#\r
END SUB\r
\r
'Scl:\r
'  Pass the number in to scaling for cga.  If the number is a decimal, then we\r
'  want to scale down for cga or scale up for ega.  This allows a full range\r
'  of numbers to be generated for scaling.\r
'  (i.e. for 3 to get scaled to 1, pass in 2.9)\r
FUNCTION Scl (n!)\r
\r
  IF n! <> INT(n!) THEN\r
      IF Mode = 1 THEN n! = n! - 1\r
  END IF\r
  IF Mode = 1 THEN\r
      Scl = CINT(n! / 2 + .1)\r
  ELSE\r
      Scl = CINT(n!)\r
  END IF\r
\r
END FUNCTION\r
\r
'SetScreen:\r
'  Sets the appropriate color statements\r
SUB SetScreen\r
\r
  IF Mode = 9 THEN\r
    ExplosionColor = 2\r
    BackColor = 1\r
    PALETTE 0, 1\r
    PALETTE 1, 46\r
    PALETTE 2, 44\r
    PALETTE 3, 54\r
    PALETTE 5, 7\r
    PALETTE 6, 4\r
    PALETTE 7, 3\r
    PALETTE 9, 63       'Display Color\r
  ELSE\r
    ExplosionColor = 2\r
    BackColor = 0\r
    COLOR BackColor, 2\r
\r
  END IF\r
\r
END SUB\r
\r
'SparklePause:\r
'  Creates flashing border for intro and game over screens\r
SUB SparklePause\r
\r
  COLOR 4, 0\r
  A$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "\r
  WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
\r
  WHILE INKEY$ = ""\r
    FOR A = 1 TO 5\r
      LOCATE 1, 1                             'print horizontal sparkles\r
      PRINT MID$(A$, A, 80);\r
      LOCATE 22, 1\r
      PRINT MID$(A$, 6 - A, 80);\r
\r
      FOR b = 2 TO 21                         'Print Vertical sparkles\r
        c = (A + b) MOD 5\r
        IF c = 1 THEN\r
          LOCATE b, 80\r
          PRINT "*";\r
          LOCATE 23 - b, 1\r
          PRINT "*";\r
        ELSE\r
          LOCATE b, 80\r
          PRINT " ";\r
          LOCATE 23 - b, 1\r
          PRINT " ";\r
        END IF\r
      NEXT b\r
    NEXT A\r
  WEND\r
END SUB\r
\r
'UpdateScores:\r
'  Updates players' scores\r
'Parameters:\r
'  Record - players' scores\r
'  PlayerNum - player\r
'  Results - results of player's shot\r
SUB UpdateScores (Record(), PlayerNum, Results)\r
  IF Results = HITSELF THEN\r
    Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1\r
  ELSE\r
    Record(PlayerNum) = Record(PlayerNum) + 1\r
  END IF\r
END SUB\r
\r
'VictoryDance:\r
'  gorilla dances after he has eliminated his opponent\r
'Parameters:\r
'  Player - which gorilla is dancing\r
SUB VictoryDance (Player)\r
\r
  FOR i# = 1 TO 4\r
    PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET\r
    PLAY "MFO0L32EFGEFDC"\r
    Rest .2\r
    PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET\r
    PLAY "MFO0L32EFGEFDC"\r
    Rest .2\r
  NEXT\r
END SUB\r
\r