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