turbobasic/DODELAM.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 STOP
  75 END
  76
  77
  78
  79
  80   Player1$, Player2$ - player names
  81 '  NumGames - number of games to play
  82 SUB PlayGame (Player1$, Player2$, NumGames)
  83   DIM BCoor(0 TO 30) AS XYPoint
  84   DIM TotalWins(1 TO 2)
  85
  86   J = 1
  87
  88   FOR i = 1 TO NumGames
  89
  90     CLS
  91     RANDOMIZE (TIMER)
  92     CALL MakeCityScape(BCoor())
  93     CALL PlaceGorillas(BCoor())
  94     DoSun SUNHAPPY
  95     Hit = FALSE
  96     DO WHILE Hit = FALSE
  97       J = 1 - J
  98       LOCATE 1, 1
  99       PRINT Player1$
 100       LOCATE 1, (MaxCol - 1 - LEN(Player2$))
 101       PRINT Player2$
 102       Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2)))
 103       Tosser = J + 1: Tossee = 3 - J
 104
 105       'Plot the shot.  Hit is true if Gorilla gets hit.
 106       Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser))
 107
 108       'Reset the sun, if it got hit
 109       IF SunHit THEN DoSun SUNHAPPY
 110
 111       IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit)
 112     LOOP
 113     SLEEP 1
 114   NEXT i
 115
 116   SCREEN 0
 117   WIDTH 80, 25
 118   COLOR 7, 0
 119   MaxCol = 80
 120   CLS
 121
 122   Center 8, "GAME OVER!"
 123   Center 10, "Score:"
 124   LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1)
 125   LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2)
 126   Center 24, "Press any key to continue"
 127   SparklePause
 128   COLOR 7, 0
 129   CLS
 130 END SUB
 131
 132 'PlayGame:
 133 '  Plots banana shot across the screen
 134 'Parameters:
 135 '  StartX, StartY - starting shot location
 136 '  Angle - shot angle
 137 '  Velocity - shot velocity
 138 '  PlayerNum - the banana thrower
 139 FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)
 140
 141   Angle# = Angle# / 180 * pi#  'Convert degree angle to radians
 142   Radius = Mode MOD 7
 143
 144   InitXVel# = COS(Angle#) * Velocity
 145   InitYVel# = SIN(Angle#) * Velocity
 146
 147   oldx# = StartX
 148   oldy# = StartY
 149
 150   'draw gorilla toss
 151   IF PlayerNum = 1 THEN
 152     PUT (StartX, StartY), GorL&, PSET
 153   ELSE
 154     PUT (StartX, StartY), GorR&, PSET
 155   END IF
 156
 157   'throw sound
 158   PLAY "MBo0L32A-L64CL16BL64A+"
 159   Rest .1
 160
 161   'redraw gorilla
 162   PUT (StartX, StartY), GorD&, PSET
 163
 164   adjust = Scl(4)                   'For scaling CGA
 165
 166   xedge = Scl(9) * (2 - PlayerNum)  'Find leading edge of banana for check
 167
 168   Impact = FALSE
 169   ShotInSun = FALSE
 170   OnScreen = TRUE
 171   PlayerHit = 0
 172   NeedErase = FALSE
 173
 174   StartXPos = StartX
 175   StartYPos = StartY - adjust - 3
 176
 177   IF PlayerNum = 2 THEN
 178     StartXPos = StartXPos + Scl(25)
 179     direction = Scl(4)
 180   ELSE
 181     direction = Scl(-4)
 182   END IF
 183
 184   IF Velocity < 2 THEN              'Shot too slow - hit self
 185     x# = StartX
 186     y# = StartY
 187     pointval = OBJECTCOLOR
 188   END IF
 189
 190   DO WHILE (NOT Impact) AND OnScreen
 191
 192   Rest .02
 193
 194   'Erase old banana, if necessary
 195   IF NeedErase THEN
 196     NeedErase = FALSE
 197     CALL DrawBan(oldx#, oldy#, oldrot, FALSE)
 198   END IF
 199
 200   x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)
 201   y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350)
 202
 203   IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN
 204     OnScreen = FALSE
 205   END IF
 206
 207
 208   IF OnScreen AND y# > 0 THEN
 209
 210     'check it
 211     LookY = 0
 212     LookX = Scl(8 * (2 - PlayerNum))
 213     DO
 214       pointval = POINT(x# + LookX, y# + LookY)
 215       IF pointval = 0 THEN
 216         Impact = FALSE
 217         IF ShotInSun = TRUE THEN
 218           IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE
 219         END IF
 220       ELSEIF pointval = SUNATTR AND y# < SunHt THEN
 221         IF NOT SunHit THEN DoSun SUNSHOCK
 222         SunHit = TRUE
 223         ShotInSun = TRUE
 224       ELSE
 225         Impact = TRUE
 226       END IF
 227       LookX = LookX + direction
 228       LookY = LookY + Scl(6)
 229     LOOP UNTIL Impact OR LookX <> Scl(4)
 230
 231     IF NOT ShotInSun AND NOT Impact THEN
 232       'plot it
 233       rot = (t# * 10) MOD 4
 234       CALL DrawBan(x#, y#, rot, TRUE)
 235       NeedErase = TRUE
 236     END IF
 237
 238     oldx# = x#
 239     oldy# = y#
 240     oldrot = rot
 241
 242   END IF
 243
 244
 245   t# = t# + .1
 246
 247   LOOP
 248
 249   IF pointval <> OBJECTCOLOR AND Impact THEN
 250     CALL DoExplosion(x# + adjust, y# + adjust)
 251   ELSEIF pointval = OBJECTCOLOR THEN
 252     PlayerHit = ExplodeGorilla(x#, y#)
 253   END IF
 254
 255   PlotShot = PlayerHit
 256
 257 END FUNCTION
 258
 259 'Rest:
 260 '  pauses the program
 261 SUB Rest (t#)
 262   s# = TIMER
 263   t2# = MachSpeed * t# / SPEEDCONST
 264   DO
 265   LOOP UNTIL TIMER - s# > t2#
 266 END SUB
 267
 268 'Scl:
 269 '  Pass the number in to scaling for cga.  If the number is a decimal, then we
 270 '  want to scale down for cga or scale up for ega.  This allows a full range
 271 '  of numbers to be generated for scaling.
 272 '  (i.e. for 3 to get scaled to 1, pass in 2.9)
 273 FUNCTION Scl (n!)
 274
 275   IF n! <> INT(n!) THEN
 276       IF Mode = 1 THEN n! = n! - 1
 277   END IF
 278   IF Mode = 1 THEN
 279       Scl = CINT(n! / 2 + .1)
 280   ELSE
 281       Scl = CINT(n!)
 282   END IF
 283
 284 END FUNCTION
 285
 286 'SetScreen:
 287 '  Sets the appropriate color statements
 288 SUB SetScreen
 289
 290   IF Mode = 9 THEN
 291     ExplosionColor = 2
 292     BackColor = 1
 293     PALETTE 0, 1
 294     PALETTE 1, 46
 295     PALETTE 2, 44
 296     PALETTE 3, 54
 297     PALETTE 5, 7
 298     PALETTE 6, 4
 299     PALETTE 7, 3
 300     PALETTE 9, 63       'Display Color
 301   ELSE
 302     ExplosionColor = 2
 303     BackColor = 0
 304     COLOR BackColor, 2
 305
 306   END IF
 307
 308 END SUB
 309
 310 'SparklePause:
 311 '  Creates flashing border for intro and game over screens
 312 SUB SparklePause
 313
 314   COLOR 4, 0
 315   A$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "
 316   WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
 317
 318   WHILE INKEY$ = ""
 319     FOR A = 1 TO 5
 320       LOCATE 1, 1                             'print horizontal sparkles
 321       PRINT MID$(A$, A, 80);
 322       LOCATE 22, 1
 323       PRINT MID$(A$, 6 - A, 80);
 324
 325       FOR b = 2 TO 21                         'Print Vertical sparkles
 326         c = (A + b) MOD 5
 327         IF c = 1 THEN
 328           LOCATE b, 80
 329           PRINT "*";
 330           LOCATE 23 - b, 1
 331           PRINT "*";
 332         ELSE
 333           LOCATE b, 80
 334           PRINT " ";
 335           LOCATE 23 - b, 1
 336           PRINT " ";
 337         END IF
 338       NEXT b
 339     NEXT A
 340   WEND
 341 END SUB
 342
 343 'UpdateScores:
 344 '  Updates players' scores
 345 'Parameters:
 346 '  Record - players' scores
 347 '  PlayerNum - player
 348 '  Results - results of player's shot
 349 SUB UpdateScores (Record(), PlayerNum, Results)
 350   IF Results = HITSELF THEN
 351     Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1
 352   ELSE
 353     Record(PlayerNum) = Record(PlayerNum) + 1
 354   END IF
 355 END SUB
 356
 357 'VictoryDance:
 358 '  gorilla dances after he has eliminated his opponent
 359 'Parameters:
 360 '  Player - which gorilla is dancing
 361 SUB VictoryDance (Player)
 362
 363   FOR i# = 1 TO 4
 364     PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET
 365     PLAY "MFO0L32EFGEFDC"
 366     Rest .2
 367     PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET
 368     PLAY "MFO0L32EFGEFDC"
 369     Rest .2
 370   NEXT
 371 END SUB
 372
 373 \1a