Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 'QBASIC GORILLAS 2.2
- 'Version 1.0 (c)1990 Microsoft Corp and/or IBM Corp
- 'Version 2.2 (c)1997-2007 Daniel Beardsmore
- 'See http://telcontar.net/Misc/Gorillas/ for more information
- 'Set default data type to integer for faster game play
- DEFINT A-Z
- 'Sub Declarations
- DECLARE SUB RestReal (t#)
- DECLARE SUB AlertSnd ()
- DECLARE SUB LoadSettings ()
- DECLARE SUB Center (Row, Text$)
- DECLARE SUB DoBeep ()
- DECLARE SUB DoExplosion (x#, y#)
- DECLARE SUB DoSun (Mouth)
- DECLARE SUB DrawBan (xc#, yc#, r, bc)
- DECLARE SUB DrawGorilla (x, y, arms)
- DECLARE SUB ExplodeGorilla (x#, y#, PlayerHit)
- DECLARE SUB Extro ()
- DECLARE SUB GetInputs (Player$(), NumGames, P)
- DECLARE SUB GorillaIntro (Player$(), cIntro)
- DECLARE SUB Intro ()
- DECLARE SUB MakeCityScape (BCoor() AS ANY)
- DECLARE SUB PlaceGorillas (BCoor() AS ANY)
- DECLARE SUB Rest (t#)
- DECLARE SUB SetScreen ()
- DECLARE SUB ShowPrompts (fieldNum AS INTEGER)
- DECLARE SUB Slidy ()
- DECLARE SUB SparklePause (opt AS INTEGER)
- DECLARE SUB Stats (Wins(), NAME$(), Ban!(), P, abortYN)
- DECLARE SUB VictoryDance (Player)
- DECLARE FUNCTION CalcDelay# ()
- DECLARE FUNCTION DoShot (Player$(), PlayerNum, x, y, turn, othX, othY)
- DECLARE FUNCTION GET$ (Row, Col, Prev$, Typ, Max, Esc)
- DECLARE FUNCTION PlayGame (Player$(), NumGames, P)
- DECLARE FUNCTION PlotShot (StartX, StartY, angle#, velocity, PlayerNum, othX, othY)
- DECLARE FUNCTION Scl (N!)
- DECLARE FUNCTION WhereX (num)
- DECLARE FUNCTION WhereY (num)
- 'Make all arrays Dynamic
- '$DYNAMIC
- ' User-Defined TYPEs
- TYPE settings
- useSound AS INTEGER
- useOldExplosions AS INTEGER
- newExplosionRadius AS INTEGER
- useSlidingText AS INTEGER
- defaultGravity AS INTEGER
- defaultRoundQty AS INTEGER
- showIntro AS INTEGER
- forceCGA AS INTEGER
- END TYPE
- TYPE XYPoint
- XCoor AS INTEGER
- YCoor AS INTEGER
- END TYPE
- TYPE PlayerData
- PNam AS STRING * 17
- Rounds AS INTEGER
- Won AS INTEGER
- Accu AS SINGLE
- END TYPE
- ' Constants
- CONST NPLAYERS = 20
- CONST TRUE = -1
- CONST FALSE = NOT TRUE
- CONST HITSELF = 1
- CONST BACKATTR = 0
- CONST OBJECTCOLOR = 1
- CONST WINDOWCOLOR = 14
- CONST SUNHAPPY = FALSE
- CONST SUNSHOCK = TRUE
- CONST RIGHTUP = 1
- CONST LEFTUP = 2
- CONST ARMSDOWN = 3
- ' Global Variables
- DIM SHARED GSettings AS settings
- DIM SHARED lastErrCode
- DIM SHARED SLIDECONST AS LONG
- 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
- DIM SHARED GLeftAngle#
- DIM SHARED GRightAngle#
- DIM SHARED GLeftVeloc
- DIM SHARED GRightVeloc
- 'Screen Mode Variables
- DIM SHARED ScrHeight
- DIM SHARED ScrWidth
- DIM SHARED Mode
- DIM SHARED MaxCol
- ' Screen Color Variables
- DIM SHARED ExplosionColor
- DIM SHARED SUNATTR
- DIM SHARED BackColor
- DIM SHARED SunHt
- DIM SHARED GHeight
- DIM SHARED MachSpeed AS DOUBLE
- DIM SHARED PDefs(1 TO 2)
- DIM Player$(1 TO 2)
- DIM SHARED PDat(1 TO NPLAYERS) AS PlayerData
- DIM SHARED GamePlayedYN
- DIM SHARED DoesFileExist
- DIM NumGames
- ' Load settings before initVars so we can look for forceCGA
- LoadSettings
- ' Check for league table file, and load table entries
- DoesFileExist = 1
- ON ERROR GOTO IsThereNoFile
- OPEN "Gorillas.lge" FOR INPUT AS #1
- ON ERROR GOTO CorruptFile
- IF DoesFileExist = 1 THEN
- INPUT #1, count
- FOR l = 1 TO count
- INPUT #1, PDat(l).PNam, PDat(l).Rounds, PDat(l).Won, PDat(l).Accu
- NEXT
- CLOSE #1
- ON ERROR GOTO 0
- ELSE
- count = 0
- END IF
- 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
- ' Initialisation and sliding text speed calculation
- GOSUB InitVars
- MachSpeed = CalcDelay
- IF MachSpeed < 1000 THEN
- SLIDECONST = (4 * MachSpeed) - 1250
- IF SLIDECONST < 0 THEN SLIDECONST = 0
- ELSE
- SLIDECONST = 2.929 * MachSpeed
- END IF
- ' Program outline
- Gravity = GSettings.defaultGravity
- NumGames = GSettings.defaultRoundQty
- IF Mode = 1 THEN
- REM CGA needs a half-size explosion radius
- GSettings.newExplosionRadius = GSettings.newExplosionRadius \ 2
- END IF
- ' Init screen
- SCREEN 0
- WIDTH 80, 25
- MaxCol = 80
- COLOR 15, 0
- CLS
- GamePlayed = 0
- IF GSettings.showIntro THEN Intro
- more = 1: DO
- GetInputs Player$(), NumGames, count
- GorillaIntro Player$(), DoesFileExist
- more = PlayGame(Player$(), NumGames, count)
- LOOP UNTIL more = 0
- Extro
- COLOR 7: CLS ' Else QBasic crashes here! lol
- DEF SEG = 0 ' Restore NumLock state
- POKE 1047, KeyFlags
- DEF SEG
- SYSTEM
- ' Banana sprite definitions
- 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
- ' Initialise graphics mode and sprites
- InitVars:
- pi# = 4 * ATN(1#)
- IF GSettings.forceCGA THEN
- Mode = 1
- ELSE
- ' Select best graphics mode
- ON ERROR GOTO ScreenModeError
- Mode = 9
- SCREEN Mode
- ON ERROR GOTO PaletteError
- IF Mode = 9 THEN PALETTE 4, 0 'Check for 64K EGA
- END IF
- IF Mode = 9 THEN
- ScrWidth = 640
- ScrHeight = 350
- GHeight = 25
- SUNATTR = 3
- 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 = 43
- ELSE
- ScrWidth = 320
- ScrHeight = 200
- GHeight = 12
- SUNATTR = 3
- 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
- FuckOff:
- lastErrCode = ERR
- RESUME NEXT
- ScreenModeError:
- IF Mode = 1 THEN
- CLS
- LOCATE 10, 5
- PRINT "Sorry, you must have CGA, EGA color or VGA graphics to play Gorillas"
- PRINT
- SYSTEM
- ELSE
- Mode = 1
- RESUME
- END IF
- PaletteError:
- Mode = 1 '64K EGA cards will run in CGA mode.
- RESUME NEXT
- IsThereNoFile:
- DoesFileExist = 0
- RESUME NEXT
- NoSaveStats:
- COLOR 7: CLS
- COLOR 12: PRINT "An error occurred trying to save the stats file GORILLAS.LGE"
- PRINT "The statistics have not been saved.": COLOR 7: PRINT
- CLOSE
- SYSTEM
- CorruptFile:
- PRINT
- BEEP
- COLOR 12: PRINT "An error occurred while attempting to read data from the league"
- PRINT "table file, GORILLAS.LGE. Fix it, get it fixed, or delete it. Simple."
- COLOR 7: PRINT
- SYSTEM
- ' Sliding text data store
- SlidyText:
- DATA 5
- DATA " Q B a s i c G O R I L L A S v2.2",15,1,4
- DATA "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ",7,-1,5
- DATA "DELUXE EDITION",15,1,6
- DATA "Original program (c)1990 Microsoft Corporation",3,1,10
- DATA "Gorillas Deluxe (c)1997-2007 Daniel Beardsmore",2,-1,12
- DATA 10
- DATA "INSTRUCTIONS",9,1,8
- DATA "Your mission is to hit your opponent with an exploding",11,1,10
- DATA "banana by varying the angle and power of your throw, taking",11,-1,11
- DATA "into account wind speed, gravity, and the city skyline.",11,1,12
- DATA "The wind speed is shown by a directional arrow at the bottom",11,-1,14
- DATA "of the playing field, its length relative to its strength.",11,1,15
- DATA "Zero degrees is horizontal, towards your opponent, with 90 degrees",11,-1,16
- DATA "being vertically upwards, and so on. Angles can be from 0 to",11,1,17
- DATA "360 degrees and velocity can range from 1 to 200.",11,-1,18
- DATA "Press any key to continue...",15,1,20
- PartingMessage:
- DATA 1
- DATA "Thank you for playing Gorillas!",11,1,8
- 'Next number is the number of final phrases
- DATA 5
- DATA 1,"May the Schwarz be with you!",14,-1,14
- DATA 1,"Live long and prosper.",14,-1,14
- DATA 1,"Goodbye!",14,-1,14
- DATA 1,"So long!",14,-1,14
- DATA 1,"Adios!",14,-1,14
- Ready:
- DATA 1,"Prepare for battle!",12,1,1
- Setup:
- DATA 1,"Game Setup",14,-1,1
- GameOver:
- DATA 1,"Game Over!",14,-1,3
- Aborted:
- DATA 1,"Game aborted",12,-1,3
- NowWhat:
- DATA 1,"Now What?",14,1,1
- VectorData:
- DATA 39
- DATA 0.582,0.988, 0.608,0.850, 0.663,0.788, 0.738,0.800
- DATA 0.863,0.838, 0.813,0.713, 0.819,0.650, 0.875,0.588
- DATA 1.000,0.563, 0.850,0.450, 0.825,0.400, 0.830,0.340
- DATA 0.925,0.238, 0.775,0.243, 0.694,0.225, 0.650,0.188, 0.630,0.105
- DATA 0.625,0.025, 0.535,0.150, 0.475,0.175, 0.425,0.150
- DATA 0.325,0.044, 0.325,0.150, 0.315,0.208, 0.288,0.250, 0.225,0.275
- DATA 0.053,0.288, 0.150,0.392, 0.175,0.463, 0.144,0.525
- DATA 0.025,0.638, 0.163,0.650, 0.225,0.693, 0.250,0.775
- DATA 0.225,0.905, 0.360,0.825, 0.450,0.823, 0.525,0.863
- DATA 0.582,0.988
- REM $STATIC
- SUB AlertSnd
- IF GSettings.useSound THEN PLAY ">>B10<<"
- END SUB
- '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) + 1
- PRINT Text$;
- END SUB
- SUB DoBeep
- IF GSettings.useSound THEN PLAY "O2A24"
- END SUB
- ' DoExplosion:
- ' Produces explosion when a shot is fired
- ' Parameters:
- ' x#, y# - location of explosion
- '
- SUB DoExplosion (x#, y#)
- DIM radii(1 TO 4, 1 TO 2), colors(1 TO 4)
- IF GSettings.useOldExplosions THEN
- IF GSettings.useSound THEN 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#
- ELSE
- radii(1, 1) = GSettings.newExplosionRadius
- radii(2, 1) = .9 * radii(1, 1)
- radii(3, 1) = .6 * radii(1, 1)
- radii(4, 1) = .45 * radii(1, 1)
- FOR i = 1 TO 4
- radii(i, 2) = .825 * radii(i, 1)
- NEXT
- colors(1) = 4: colors(2) = 2
- colors(3) = 3: colors(4) = 9
- IF GSettings.useSound THEN PLAY "MBO0L32EFGEFDC"
- 'þ Draw grey smoke, EGA/VGA only
- IF Mode = 9 THEN
- CIRCLE (x#, y#), 1.175 * radii(1, 1), 10
- PAINT (x#, y#), 10, 10
- ELSE
- CIRCLE (x#, y#), 1.175 * radii(1, 1), 1
- PAINT (x#, y#), 0, 1
- CIRCLE (x#, y#), 1.175 * radii(1, 1), 0
- END IF
- '? Draw vector explosion graphics
- FOR i = 1 TO 4
- Iwidth = 2 * radii(i, 1): Iheight = 2 * radii(i, 2)
- locX = x# - radii(i, 1): locY = y# - radii(i, 2)
- imageCol = colors(i)
- IF MachSpeed > 700 THEN
- GOSUB DrawShape
- Delay = .5
- ELSE
- CIRCLE (x#, y#), radii(i, 1), imageCol: PAINT (x#, y#), imageCol, imageCol
- Delay = .9
- END IF
- NEXT
- timeStay! = TIMER: DO: LOOP UNTIL TIMER > timeStay! + .1
- CIRCLE (x#, y#), 1.175 * radii(1, 1), 0
- PAINT (x#, y#), 0, 0
- END IF
- EXIT SUB
- DrawShape:
- RESTORE VectorData
- READ noOfPoints, initX!, initY!
- initX! = (initX! * Iwidth) + locX
- initY! = (initY! * Iheight) + locY
- FOR lVar = 1 TO noOfPoints - 1
- READ toX!, toY!
- toX! = (toX! * Iwidth) + locX
- toY! = (toY! * Iheight) + locY
- IF lVar = 1 THEN
- LINE (initX!, initY!)-(toX!, toY!), imageCol
- ELSE
- LINE -(toX!, toY!), imageCol
- END IF
- NEXT
- PAINT (locX + (Iwidth / 2), locY + (Iwidth / 2)), imageCol, imageCol
- RETURN
- END SUB
- ' DoShot:
- ' Controls banana shots by accepting player input and plotting
- ' shot angle
- ' Parameters:
- ' PlayerNum - Player
- ' x, y - Player's gorilla position
- ' turn - do not show zeroes at input prompts on first turn
- '
- FUNCTION DoShot (Player$(), PlayerNum, x, y, turn, othX, othY)
- 'Input shot
- IF PlayerNum = 1 THEN
- LocateCol = 2
- ELSE
- IF Mode = 9 THEN
- LocateCol = 67
- ELSE
- LocateCol = 26
- END IF
- END IF
- IF PlayerNum = 1 THEN
- PrevA# = GLeftAngle#: PrevV# = GLeftVeloc
- ELSE
- IF PlayerNum = 2 THEN
- PrevA# = GRightAngle#: PrevV# = GRightVeloc
- END IF
- END IF
- GAng$ = "": Velo$ = ""
- LOCATE 2, LocateCol + 3: PRINT "Angle:";
- LOCATE 3, LocateCol: PRINT "Velocity:";
- IF turn > 2 THEN
- PRINT PrevV#
- Pa$ = LTRIM$(STR$(PrevA#))
- Pv$ = LTRIM$(STR$(PrevV#))
- ELSE
- Pa$ = "": Pv$ = ""
- END IF
- WHILE INKEY$ <> "": WEND
- DO: pass = 1
- DO
- GAng$ = GET$(2, LocateCol + 10, Pa$, 0, 360, 1)
- IF GAng$ = "" THEN GOSUB AbortGame
- LOOP UNTIL GAng$ <> ""
- IF LEFT$(GAng$, 1) = "*" THEN GAng$ = RIGHT$(GAng$, LEN(GAng$) - 1)
- angle# = VAL(GAng$)
- DO
- Velo$ = GET$(3, LocateCol + 10, Pv$, 1, -200, 1)
- IF Velo$ = "" THEN GOSUB AbortGame
- LOOP UNTIL Velo$ <> ""
- IF LEFT$(Velo$, 1) = "*" THEN
- pass = 0: Velo$ = RIGHT$(Velo$, LEN(Velo$) - 1)
- PrevA# = angle#
- PrevV# = CINT(VAL(Velo$))
- Pa$ = GAng$
- Pv$ = Velo$
- END IF
- velocity = CINT(VAL(Velo$))
- LOOP UNTIL pass = 1
- IF PlayerNum = 1 THEN
- GLeftAngle# = angle#: GLeftVeloc = velocity
- ELSE
- IF PlayerNum = 2 THEN
- GRightAngle# = angle#: GRightVeloc = velocity
- END IF
- END IF
- IF PlayerNum = 2 THEN
- angle# = 180 - angle#
- END IF
- 'Erase input
- FOR i = 1 TO 3 ' Was 4
- 'LOCATE i, 1
- 'PRINT SPACE$(30 \ (80 \ MaxCol));
- 'LOCATE i, (50 \ (80 \ MaxCol))
- 'PRINT SPACE$(30 \ (80 \ MaxCol));
- LOCATE i, 2: PRINT SPACE$(17)
- LOCATE i, MaxCol - 17: PRINT SPACE$(17)
- NEXT
- PlayerHit = PlotShot(x, y, angle#, velocity, PlayerNum, othX, othY)
- IF PlayerHit = 0 THEN
- DoShot = FALSE
- ELSE
- DoShot = TRUE
- IF PlayerHit <> PlayerNum AND turn < 3 THEN
- 'þ Killed opponent in one shot message
- tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .8
- IF GSettings.useSound THEN PLAY "MFO2L24A+>DFA+FD<A+>DFA+FD<A+>DFA+FD<A+4MB"
- COLOR 12
- FOR msg = 1 TO 3
- Center 1, "IN ONE THROW!": tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .25
- Center 1, SPACE$(14): GOSUB DSRestoreSun: tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .25
- NEXT
- ELSE tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .9
- END IF
- IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum
- VictoryDance PlayerNum
- END IF
- EXIT FUNCTION
- AbortGame:
- cont = FALSE: cval = 1: tpause! = TIMER - 2
- IF Mode = 9 THEN COLOR 14
- DO
- IF TIMER > tpause! + .5 THEN
- IF cval = 1 THEN
- Center 1, " Abort game? [Y/N] "
- ELSE
- Center 1, SPACE$(19)
- GOSUB DSRestoreSun
- END IF
- cval = 2 / cval
- tpause! = TIMER
- END IF
- resp$ = UCASE$(INKEY$)
- IF resp$ = "Y" THEN cont = 1
- IF resp$ = "N" THEN cont = 2
- LOOP UNTIL NOT (cont = FALSE)
- IF cont = 1 THEN
- DoShot = 1: EXIT FUNCTION
- ELSE
- IF cval = 2 THEN Center 1, SPACE$(19): DoSun SUNHAPPY
- IF Mode = 1 THEN GOSUB CGARestNames
- IF Mode = 9 THEN COLOR 15
- RETURN
- END IF
- EXIT FUNCTION
- DSRestoreSun:
- sunX = ScrWidth \ 2: sunY = Scl(25)
- LINE (sunX, sunY - Scl(15))-(sunX, sunY), SUNATTR
- LINE (sunX - Scl(8), sunY - Scl(13))-(sunX, sunY), SUNATTR
- LINE (sunX, sunY)-(sunX + Scl(8), sunY - Scl(13)), SUNATTR
- RETURN
- CGARestNames:
- REM Under CGA, the Abort Game prompt can overwrite player names
- LOCATE 1, 2: PRINT Player$(1)
- LOCATE 1, MaxCol - LEN(Player$(2)): PRINT Player$(2)
- RETURN
- 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
- SUB ExplodeGorilla (x#, y#, PlayerHit)
- YAdj = Scl(12)
- XAdj = Scl(5)
- SclX# = ScrWidth / 320
- SclY# = ScrHeight / 200
- IF GSettings.useSound THEN PLAY "MBO0L16EFGEFDC"
- FOR i = 1 TO 16 * SclX#
- CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57
- NEXT i
- timeStay! = TIMER: DO: LOOP UNTIL TIMER > timeStay! + .05
- 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
- END SUB
- SUB Extro
- COLOR 7: CLS
- RESTORE PartingMessage
- Slidy
- READ num
- num = CINT(RND * (num - 1))
- IF num > 0 THEN FOR l = 1 TO num: READ pnum, pmsg$, pnum, pnum, pnum: NEXT
- Slidy
- t! = TIMER: DO: LOOP UNTIL TIMER > t! + 3.8 OR INKEY$ <> ""
- END SUB
- FUNCTION GET$ (Row, Col, Prev$, Typ, Max, Esc)
- ' Row,Col : position
- ' Prev$ : the previous value of the number or string.
- ' Typ : the type of input required: TRUE for string, FALSE for numeric
- ' and 1 for numerical, tabbable while empty
- ' Max : the maximum number of characters for string or the maximum
- ' value for numeric. For numeric, a negative maximum means that the minimum
- ' value is to be one not zero and the maximum value is the absolute value
- ' of Max.
- ' Esc : TRUE if Escape key permitted, FALSE if not permitted, 1 if Escape
- ' clears input rather then undoes
- SpecTab = 0: IF Typ = 1 THEN Typ = FALSE: SpecTab = 1
- IF NOT Typ THEN
- IF Max < 0 THEN Zero = 0 ELSE Zero = -1
- Max = ABS(Max)
- END IF
- Hold$ = Prev$
- cont = 0: Lett$ = "": Curs = 0: Timo! = 0
- Valid$ = "1234567890" + CHR$(8) + CHR$(9) + CHR$(13) + CHR$(27)
- IF Typ THEN Valid$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ- .'!" + Valid$
- LOCATE Row, Col:
- IF Typ THEN
- Bck = Max - LEN(Hold$) + 1
- ELSE
- Bck = LEN(STR$(Max)) - LEN(Hold$)
- END IF
- PRINT Hold$; SPC(Bck);
- DO
- DO
- Timo! = TIMER: Curs = 0: LOCATE Row, Col + LEN(Hold$): IF LEN(Hold$) = Max THEN PRINT "Û" ELSE PRINT "_"
- DO: LOOP UNTIL INKEY$ = ""
- DO
- IF TIMER > Timo! + .5 THEN
- LOCATE Row, Col + LEN(Hold$)
- IF Curs <> 1 THEN
- PRINT " "
- ELSE
- IF Typ AND LEN(Hold$) = Max THEN PRINT "Û" ELSE PRINT "_"
- END IF
- Curs = 1 - Curs
- Timo! = TIMER
- END IF
- Lett$ = INKEY$
- LOOP UNTIL Lett$ <> ""
- LOCATE Row, Col + LEN(Hold$): PRINT " "
- Intra = INSTR(Valid$, UCASE$(Lett$))
- IF Lett$ = CHR$(0) + CHR$(83) THEN Intra = 50 ' DEL key
- IF Intra = 0 THEN DoBeep: DO: LOOP UNTIL INKEY$ = ""
- LOOP UNTIL Intra > 0
- SELECT CASE Intra
- CASE 50
- 'þ DELETE key
- LOCATE Row, Col: PRINT STRING$(LEN(Hold$), " ");
- Hold$ = ""
- CASE 1 TO LEN(Valid$) - 4 'þ Letter, number or symbol
- 'þ Numeric field
- IF NOT Typ THEN 'þ Number
- IF NOT ((Lett$ = "0" AND (NOT Zero AND Hold$ = "")) OR Hold$ = "0") THEN
- IF VAL(Hold$ + Lett$) <= Max THEN
- Hold$ = Hold$ + Lett$
- LOCATE Row, Col: PRINT Hold$
- ELSE DoBeep
- END IF
- ELSE DoBeep
- END IF
- ELSE 'þ Text field
- IF LEN(Hold$) < Max THEN
- Hold$ = Hold$ + Lett$
- LOCATE Row, Col: PRINT Hold$
- ELSE DoBeep
- END IF
- END IF
- CASE LEN(Valid$) - 3
- 'þ BACKSPACE key
- IF LEN(Hold$) > 0 THEN
- Hold$ = LEFT$(Hold$, LEN(Hold$) - 1)
- LOCATE Row, Col: PRINT Hold$; " ";
- ELSE DoBeep
- END IF
- CASE LEN(Valid$) - 2
- 'þ TAB key
- IF (LEN(Hold$) > 0 AND NOT Typ) OR SpecTab = 1 THEN Hold$ = "*" + Hold$: cont = 1 ELSE DoBeep
- CASE LEN(Valid$) - 1
- 'þ RETURN key
- IF LEN(Hold$) > 0 THEN cont = 1 ELSE DoBeep
- CASE LEN(Valid$)
- 'þ ESCAPE key
- IF Esc = TRUE THEN Hold$ = Prev$: cont = 1
- IF Esc = 1 THEN Hold$ = "": cont = 1
- END SELECT
- DO: LOOP UNTIL INKEY$ = ""
- LOOP UNTIL cont = 1
- GET$ = Hold$
- END FUNCTION
- 'GetInputs:
- ' Gets competing players and game configuration play at beginning of game
- ' and manages players list
- 'Parameters:
- ' Player$() - player names
- ' NumGames - number of games to play
- ' P - number of stored players
- SUB GetInputs (Player$(), NumGames, P)
- ' Lay out screen
- CLS : RESTORE Setup: Slidy: COLOR 2: LOCATE 2, 1: PRINT STRING$(80, "Í") 'þ Show screen title
- active = 0: FOR fld = 1 TO 4: GOSUB SetupFields: NEXT 'þ Display fields
- fld = 0: GOSUB SetupFields 'þ Display player names
- ' Fill in players box
- cStat = 0: FOR N = 1 TO P: GOSUB Curs: NEXT
- 'þ Must highlight opponent player (normally done after [ENTER] or [TAB]
- IF PDefs(2) > 0 THEN N = PDefs(2): cStat = 2: GOSUB Curs
- ' Process fields loop
- ' complete: ready to start the game
- ' fld: which field is being processed
- ' numG$: text field to hold number of games
- ' grav$: text field to hold gravity
- complete = 0: fld = 1: numG$ = LTRIM$(STR$(NumGames)): grav$ = LTRIM$(STR$(Gravity))
- DO
- 'þ Highlight current field if there are enough players. Player field not
- ' highlighted until there is a player which can be assigned to it, and the
- ' last two fields are unselectable unless there are enough players
- active = 1: IF P >= 2 THEN GOSUB SetupFields
- SELECT CASE fld
- CASE 1 TO 2
- GOSUB ManagePlayers
- CASE IS = 3
- GOSUB Rounds
- CASE IS = 4
- GOSUB Gravity
- END SELECT
- active = 0: GOSUB SetupFields 'þ Unhighlight current field
- IF NOT complete THEN fld = fld + 1: IF fld = 5 THEN fld = 1
- IF complete AND (PDefs(1) = 0 OR PDefs(2) = 0) THEN fld = 1: complete = 0
- LOOP UNTIL complete
- Player$(1) = RTRIM$(PDat(PDefs(1)).PNam)
- Player$(2) = RTRIM$(PDat(PDefs(2)).PNam)
- NumGames = VAL(numG$)
- Gravity = VAL(grav$)
- 'þ Clear most of the screen
- COLOR , 0: FOR l = 3 TO 24: LOCATE l, 1: PRINT STRING$(80, " "); : NEXT
- EXIT SUB
- 'þþþþþþþþþþþþþþþþþþþþ
- 'þ FIELDS SUBROUTINES
- ManagePlayers:
- cre = 0
- WHILE P < 2 'þ Ensure enough players for the game (only used before league table created)
- cre = 1: GOSUB CreatePlayer
- IF P = 2 THEN GOSUB SetupFields 'þ Finally ready to highlight Player field
- WEND
- cre = 0
- 'þ OK. Assuming that there are enough players to select.
- opp = 2 / fld 'þ PDefs array number of opposite player
- ShowPrompts fld
- IF PDefs(fld) > 0 THEN 'þ Put cursor bar on currently selected player
- x = ((PDefs(fld) - 1) MOD 4) + 1: y = INT((PDefs(fld) - 1) / 4) + 1
- ELSE 'þ Otherwise choose free player
- IF PDefs(opp) <> 1 THEN
- x = 1: y = 1
- ELSE
- 'IF PDefs(opp) = 1 AND P > 1 THEN
- x = 2: y = 1
- END IF
- END IF
- finished = 0: mov = 0: IF P > 1 THEN mov = 1
- DO
- defSwap = 0 'þ Flag for player definition swapping
- N = (y - 1) * 4 + x 'þ Convert cursor bar position into player number
- LOCATE 8 + (fld * 2 - 2), 22
- 'þ Do not display player name if it is taken and swap is not permitted
- IF NOT ((PDefs(fld) = 0 OR PDefs(opp) = 0) AND PDefs(opp) = N) THEN
- COLOR 2, 0: PRINT PDat(N).PNam;
- ELSE
- COLOR 12, 0: PRINT "Can't have. "
- END IF
- IF (PDefs(opp)) = N AND PDefs(fld) > 0 THEN
- LOCATE 8 + (opp * 2 - 2), 23 + LEN(RTRIM$(PDat(PDefs(opp)).PNam))
- COLOR 2, 0: PRINT "("; CHR$(26); " "; RTRIM$(PDat(PDefs(fld)).PNam); ")";
- COLOR 2: LOCATE 7, 3: PRINT "": COLOR 9: LOCATE 7, 5
- PRINT "Pressing [ENTER] now will switch the players over."
- defSwap = 1
- END IF
- IF mov = 1 THEN cur = 1: GOSUB Move
- DO
- KEY$ = INKEY$
- LOOP UNTIL KEY$ <> ""
- COLOR 1, 0
- IF defSwap = 1 THEN
- LOCATE 8 + (opp * 2 - 2), 23 + LEN(RTRIM$(PDat(PDefs(opp)).PNam))
- PRINT STRING$(21, " ")
- LOCATE 7, 3: PRINT STRING$(52, " ")
- END IF
- 'þ Move cursor bar, manipulate players, and select a player to compete
- SELECT CASE UCASE$(KEY$)
- CASE CHR$(0) + CHR$(72)
- IF y > 1 THEN cur = 0: GOSUB Move: y = y - 1: mov = 1 ELSE AlertSnd
- CASE CHR$(0) + CHR$(80)
- IF (y * 4 + x) <= P THEN cur = 0: GOSUB Move: y = y + 1: mov = 1 ELSE AlertSnd
- CASE CHR$(0) + CHR$(75)
- IF x > 1 THEN
- cur = 0: GOSUB Move: x = x - 1: mov = 1
- ELSE
- IF y > 1 THEN
- cur = 0: GOSUB Move: mov = 1: x = 4: y = y - 1
- ELSE
- AlertSnd
- END IF
- END IF
- CASE CHR$(0) + CHR$(77)
- IF x < 4 AND ((y - 1) * 4 + (x + 1)) <= P THEN
- cur = 0: GOSUB Move: x = x + 1: mov = 1
- ELSE
- IF (y * 4 + 1) <= P THEN
- cur = 0: GOSUB Move: mov = 1: x = 1: y = y + 1
- ELSE
- AlertSnd
- END IF
- END IF
- CASE CHR$(9), CHR$(13)
- IF KEY$ = CHR$(13) THEN 'þ Only update player defs if ENTER pressed
- IF PDefs(opp) = N AND PDefs(fld) > 0 THEN
- 'þ Swap player definitions
- SWAP PDefs(1), PDefs(2): COLOR , 0: finished = 1
- cStat = 2: GOSUB Curs
- IF fld = 2 THEN N = PDefs(opp): GOSUB Curs
- ELSEIF PDefs(opp) <> N THEN
- 'þ Define player
- IF PDefs(fld) <> N THEN 'þ Remove green highlight and define PDefs
- IF PDefs(fld) > 0 THEN Nt = N: N = PDefs(fld): cStat = 0: GOSUB Curs: N = Nt
- PDefs(fld) = N
- END IF
- finished = 1
- cStat = 2: GOSUB Curs
- ELSE
- AlertSnd
- END IF
- ELSE
- IF PDefs(fld) > 0 THEN
- 'þ Abort change to definition, and move to next field
- finished = 1
- cur = 0: GOSUB Move 'þ Remove cursor bar
- N = PDefs(fld): cStat = 2: GOSUB Curs 'þ Red highlight
- ELSEIF PDefs(fld) = 0 AND PDefs(opp) <> N THEN
- 'þ Player undefined, so define it
- PDefs(fld) = N: finished = 1
- cStat = 2: GOSUB Curs
- ELSE
- AlertSnd
- END IF
- END IF
- IF finished = 1 THEN
- LOCATE 8 + (fld * 2 - 2), 22: COLOR 10, 0: PRINT PDat(PDefs(fld)).PNam;
- IF defSwap = 1 THEN LOCATE 8 + (opp * 2 - 2), 22: PRINT PDat(PDefs(opp)).PNam;
- END IF
- CASE "N"
- GOSUB CreatePlayer
- CASE "R"
- GOSUB RenamePlayer
- CASE CHR$(0) + CHR$(83)
- GOSUB DeletePlayer
- CASE ELSE
- 'þ Incorrect key pressed
- AlertSnd
- END SELECT
- 'Player chosen
- LOOP UNTIL finished
- RETURN
- CreatePlayer:
- IF P < NPLAYERS THEN
- IF cre = 1 THEN ShowPrompts -12 ELSE ShowPrompts 12
- nx = WhereX(P + 1): ny = WhereY(P + 1)
- cStat = 0: GOSUB Curs: COLOR 10, 1
- PDat(P + 1).PNam = " "
- DO: cont = 1
- IF P < 2 THEN Esc = FALSE ELSE Esc = TRUE 'þ Prevent ESCAPE key when players not yet created
- PDat(P + 1).PNam = RTRIM$(GET$(ny, nx, RTRIM$(PDat(P + 1).PNam), -1, 17, Esc))
- IF LTRIM$(PDat(P + 1).PNam) = "" THEN
- cont = 2
- ELSE
- FOR inl = 1 TO P
- IF PDat(inl).PNam = PDat(P + 1).PNam THEN AlertSnd: cont = 0
- NEXT
- END IF
- LOOP UNTIL cont > 0
- IF cont = 1 THEN
- P = P + 1: DoBeep: x = ((P - 1) MOD 4) + 1: y = INT((P - 1) / 4) + 1
- IF P > 1 THEN N = P - 1: cur = 0: GOSUB Move
- N = (y - 1) * 4 + x: cStat = 0: GOSUB Curs
- ELSEIF cont = 2 THEN
- Nt = N: N = P + 1: cStat = 0: GOSUB Curs
- N = Nt: GOSUB Move
- END IF
- ShowPrompts fld
- ELSE
- AlertSnd
- END IF
- RETURN
- RenamePlayer:
- ShowPrompts 13
- nx = WhereX(P + 1): ny = WhereY(P + 1)
- cStat = 0: GOSUB Curs: COLOR 10, 1
- DO: cont = 1: count = 0
- PDat(N).PNam = GET$(WhereY(N), WhereX(N), RTRIM$(PDat(N).PNam), -1, 17, TRUE)
- IF LEFT$(PDat(N).PNam, 1) = "*" THEN PDat(N).PNam = RIGHT$(PDat(N).PNam, LEN(PDat(N).PNam) - 1)
- FOR inl = 1 TO P
- IF PDat(inl).PNam = PDat(N).PNam THEN count = count + 1
- NEXT: IF count > 1 THEN AlertSnd: cont = 0
- LOOP UNTIL cont = 1: DoBeep
- cStat = 1: GOSUB Curs: ShowPrompts fld: upd = 0
- IF PDefs(1) = N THEN
- upd = 1
- ELSEIF PDefs(2) = N THEN
- upd = 2
- END IF
- IF upd > 0 THEN
- COLOR 10, 0: LOCATE 8 + (upd * 2 - 2), 22
- PRINT PDat(PDefs(upd)).PNam;
- END IF
- RETURN
- DeletePlayer:
- 'þ What to do after the delete
- nextAction = 0
- IF N = PDefs(opp) THEN 'þ Opposite player redefined
- IF NOT (fld = 1 AND P > 2) THEN 'þ But not in this situation
- nextAction = 1
- END IF
- END IF
- IF PDefs(fld) > 0 THEN COLOR 10, 0: LOCATE 8 + (fld * 2 - 2), 22: PRINT PDat(PDefs(fld)).PNam;
- COLOR 0, 0
- FOR l = 3 TO 7: LOCATE l, 1: PRINT STRING$(80, " "); : NEXT
- ShowPrompts 11
- LOCATE 3, 3: COLOR 4
- PRINT "Do you want to delete the player `" + RTRIM$(PDat(N).PNam) + "'?"
- BEEP: DO: DO
- i$ = INKEY$
- LOOP UNTIL i$ <> "": i$ = UCASE$(i$): LOOP UNTIL i$ = "Y" OR i$ = "N"
- COLOR 0, 0: LOCATE 3: PRINT STRING$(80, " ")
- IF i$ = "Y" THEN
- 'þ Corrects PDefs (selected players) values and display
- IF fld = 2 AND PDefs(fld) = 0 AND N = PDefs(opp) THEN
- COLOR 8, 0: LOCATE 10, 22
- PRINT "<undefined> ";
- END IF
- FOR upd = 1 TO 2
- IF PDefs(upd) = N THEN
- COLOR 8, 0: LOCATE 8 + (upd * 2 - 2), 22
- PRINT "<undefined> ";
- PDefs(upd) = 0
- ELSEIF PDefs(upd) > N THEN
- PDefs(upd) = PDefs(upd) - 1
- END IF
- NEXT
- IF P = 2 AND PDefs(fld) = 0 AND PDefs(opp) > 0 THEN
- COLOR 8, 0: LOCATE 8 + (fld * 2 - 2), 22
- PRINT "<undefined> ";
- END IF
- 'þ Tidies up PDat (array of players)
- Pt = P: P = P - 1: Nt = N
- IF N < Pt THEN
- FOR N = N TO P
- PDat(N).PNam = PDat(N + 1).PNam
- PDat(N).Rounds = PDat(N + 1).Rounds
- PDat(N).Won = PDat(N + 1).Won
- PDat(N).Accu = PDat(N + 1).Accu
- IF PDefs(2 * (1 / fld)) = N THEN cStat = 2 ELSE cStat = 0
- GOSUB Curs
- NEXT
- END IF
- 'þ This wipes all trace of the deleted player
- PDat(Pt).Won = 0
- PDat(Pt).PNam = "": PDat(Pt).Accu = 0: PDat(Pt).Rounds = 0
- N = Pt: cStat = 0: GOSUB Curs
- N = Nt
- IF N > P THEN
- N = N - 1: x = x - 1: IF x = 0 THEN x = 1: y = y - 1: IF y = 0 THEN y = 1
- END IF
- IF P > 0 THEN ShowPrompts fld
- IF nextAction > 0 THEN
- cStat = 0: GOSUB Curs 'þ Remove cursor bar
- END IF
- IF PDefs(fld) > 0 THEN
- x = ((PDefs(fld) - 1) MOD 4) + 1: y = INT((PDefs(fld) - 1) / 4) + 1
- ELSEIF N = PDefs(opp) THEN
- IF N > 1 THEN
- x = x - 1: IF x = 0 THEN y = y - 1: x = 4 'þ Back one player
- ELSEIF N < P THEN
- x = x + 1: IF x = 5 THEN y = y + 1: x = 1 'þ Fwd one player
- END IF
- END IF
- IF nextAction = 1 THEN
- active = 0: GOSUB SetupFields
- SWAP fld, opp: active = 1: GOSUB SetupFields
- END IF
- 'þ Ensure always 2 players minimum
- IF P = 1 THEN cre = 1: GOSUB CreatePlayer: cre = 0
- ELSE
- ShowPrompts fld
- END IF
- RETURN
- Rounds:
- ShowPrompts 3
- COLOR 15, 9: numG$ = GET$(20, 51, numG$, 0, -99, FALSE): COLOR 15, 0
- IF LEFT$(numG$, 1) = "*" THEN numG$ = RIGHT$(numG$, LEN(numG$) - 1)
- LOCATE 20, 51: PRINT numG$; SPC(3 - LEN(numG$));
- RETURN
- Gravity:
- ShowPrompts 4
- COLOR 15, 9: grav$ = GET$(22, 51, grav$, 0, -99, FALSE): COLOR 15, 0
- IF LEFT$(grav$, 1) = "*" THEN grav$ = RIGHT$(grav$, LEN(grav$) - 1) ELSE complete = 1
- LOCATE 22, 51: PRINT grav$; SPC(4 - LEN(grav$));
- RETURN
- 'þþþþþþþþþþþþþþþþþþþþþ
- 'þ SUPPORT SUBROUTINES
- ' field display
- SetupFields:
- IF fld = 1 AND active THEN GOSUB DrawBox
- IF fld = 2 AND NOT active THEN GOSUB DrawBox
- IF active THEN COLOR 15 ELSE COLOR 8
- SELECT CASE fld
- CASE IS = 0
- FOR upd = 1 TO 2
- LOCATE 8 + (upd * 2 - 2), 22
- IF PDefs(upd) > 0 THEN
- COLOR 10, 0: PRINT PDat(PDefs(upd)).PNam;
- ELSE
- COLOR 8, 0: PRINT "<undefined>"
- END IF
- NEXT
- CASE IS = 1
- LOCATE 8, 11: PRINT "Player 1 ="
- CASE IS = 2
- LOCATE 10, 11: PRINT "Player 2 ="
- CASE IS = 3
- tStr$ = "Maximum rounds? (1 - 99, Default =" + STR$(GSettings.defaultRoundQty) + "):"
- LOCATE 20, 50 - LEN(tStr$): PRINT tStr$
- CASE IS = 4
- LOCATE 22, 13: PRINT "Gravity in m/sý (1 - 99, Earth = 10):"
- END SELECT
- RETURN
- DrawBox:
- COLOR 2, 0
- IF active THEN
- LOCATE 12, 1: PRINT "É"; STRING$(78, "Í"); "»";
- LOCATE 18, 1: PRINT "È"; STRING$(78, "Í"); "¼";
- FOR l = 13 TO 17: LOCATE l, 1: PRINT "º"; : LOCATE l, 80: PRINT "º"; : NEXT
- ELSE
- LOCATE 12, 1: PRINT "Ú"; STRING$(78, "Ä"); "¿";
- LOCATE 18, 1: PRINT "À"; STRING$(78, "Ä"); "Ù";
- FOR l = 13 TO 17: LOCATE l, 1: PRINT "³"; : LOCATE l, 80: PRINT "³"; : NEXT
- END IF
- RETURN
- ' cursor display
- Move: 'þ Displays or removes cursor bar, calculating highlight colour
- which = 1
- IF PDefs(2 / fld) = N THEN which = 0
- IF PDefs(fld) = N THEN which = 2
- SELECT CASE cur 'þ Blue (1) or black (0) background
- CASE 1
- IF which = 1 THEN
- cStat = 1: GOSUB Curs
- ELSEIF which = 0 THEN
- cStat = 3: GOSUB Curs
- ELSE
- cStat = 5: GOSUB Curs
- END IF
- CASE 0
- IF which = 1 THEN
- cStat = 0: GOSUB Curs
- ELSEIF which = 0 THEN
- cStat = 2: GOSUB Curs
- ELSE
- cStat = 4: GOSUB Curs
- END IF
- END SELECT
- RETURN
- Curs: 'þ Displays or removes cursor bar, being told the highlight colour
- SELECT CASE cStat
- CASE 0
- COLOR 15, 0
- CASE 1
- COLOR 11, 1
- CASE 2
- COLOR 4, 0
- CASE 3
- COLOR 4, 1
- CASE 4
- COLOR 2, 0
- CASE 5
- COLOR 2, 1
- END SELECT
- LOCATE WhereY(N), WhereX(N): PRINT RTRIM$(PDat(N).PNam);
- IF N < P THEN
- PRINT ",";
- ELSEIF N = P THEN
- PRINT ".";
- ELSE
- PRINT " ";
- END IF
- PRINT SPC(17 - LEN(RTRIM$(PDat(N).PNam)));
- RETURN
- END SUB
- 'GorillaIntro:
- ' Displays gorillas on screen for the first time
- ' allows the graphical data to be put into an array
- 'Parameters:
- ' Player$() - The names of the players
- ' cIntro - Is introduction compulsory? (Yes for first ever game)
- '
- SUB GorillaIntro (Player$(), cIntro)
- IF cIntro = 1 THEN 'þ cIntro = 0 means introduction compulsory
- CLS
- LOCATE 1, 36: PRINT STRING$(10, " ")
- RESTORE Ready: Slidy
- COLOR 2: LOCATE 15, 31: PRINT "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
- COLOR 9: LOCATE 17, 34: PRINT "= View Intro"
- LOCATE 18, 34: PRINT "= Play Game"
- LOCATE 19, 34: PRINT "= Quit Gorillas"
- LOCATE 21, 34: PRINT "Your Choice?"
- COLOR 12: LOCATE 17, 32: PRINT "V": LOCATE 18, 32: PRINT "P"
- LOCATE 19, 32: PRINT "Q"
- DO
- Char$ = UCASE$(INKEY$)
- LOOP UNTIL Char$ <> "" AND INSTR("QVP", Char$)
- IF Char$ = "V" THEN cIntro = 0
- IF Char$ = "Q" THEN
- IF GamePlayedYN = 1 THEN Extro
- COLOR 7: CLS : SYSTEM
- END IF
- END IF
- IF Mode = 1 THEN
- x = 125
- y = 100
- ELSE
- x = 286
- y = 175
- END IF
- SCREEN Mode
- SetScreen
- IF Mode = 1 THEN
- MaxCol = 40
- Center 5, "Please wait while gorillas are drawn."
- END IF
- 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
- IF Mode = 1 THEN CLS ' For some reason, the above CLS 2s don't work in CGA
- VIEW PRINT 1 TO 25
- IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46
- IF cIntro = 0 THEN
- IF Mode = 9 THEN
- Rad! = 100: yStep! = 1: DO
- CIRCLE (319, 190), Rad!, 8, , , .5
- CIRCLE (319, 187), Rad!, 11, , , .5
- Rad! = Rad! + yStep!: yStep! = yStep! * 1.1
- LOOP UNTIL 320 + Rad! >= 640
- PAINT (0, 0), 8, 11
- LINE (142, 20)-(491, 20), 3
- LINE (491, 20)-(491, 95), 3
- LINE (491, 95)-(317, 156), 3
- LINE (317, 156)-(142, 95), 3
- LINE (142, 95)-(142, 20), 3
- PAINT (317, 40), 0, 3
- END IF
- IF Mode = 9 THEN COLOR 11
- Center 2, " QBasic G O R I L L A S "
- IF Mode = 9 THEN COLOR 9
- Center 4, "STARRING:"
- P$ = player$(1) + " AND " + player$(2)
- IF Mode = 9 THEN COLOR 3
- Center 5, STRING$(LEN(P$), "Ä")
- IF Mode = 9 THEN COLOR 2
- Center 6, P$
- IF Mode = 9 THEN COLOR 9
- PUT (x - 13, y), GorD&, PSET
- PUT (x + 47, y), GorD&, PSET
- Rest 1
- IF INKEY$ <> "" GOTO GetThisOverWith
- PUT (x - 13, y), GorL&, PSET
- PUT (x + 47, y), GorR&, PSET
- IF GSettings.useSound THEN PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b" ELSE RestReal .18
- Rest .3
- IF INKEY$ <> "" GOTO GetThisOverWith
- PUT (x - 13, y), GorR&, PSET
- PUT (x + 47, y), GorL&, PSET
- IF GSettings.useSound THEN PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-" ELSE RestReal .18
- Rest .3
- IF INKEY$ <> "" GOTO GetThisOverWith
- PUT (x - 13, y), GorL&, PSET
- PUT (x + 47, y), GorR&, PSET
- IF GSettings.useSound THEN PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-" ELSE RestReal .18
- Rest .3
- IF INKEY$ <> "" GOTO GetThisOverWith
- PUT (x - 13, y), GorR&, PSET
- PUT (x + 47, y), GorL&, PSET
- IF GSettings.useSound THEN PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b" ELSE RestReal .18
- Rest .3
- IF INKEY$ <> "" GOTO GetThisOverWith
- FOR i = 1 TO 4
- PUT (x - 13, y), GorL&, PSET
- PUT (x + 47, y), GorR&, PSET
- IF GSettings.useSound THEN PLAY "T160O0L32EFGEFDC" ELSE RestReal .18
- Rest .1
- PUT (x - 13, y), GorR&, PSET
- PUT (x + 47, y), GorL&, PSET
- IF GSettings.useSound THEN PLAY "T160O0L32EFGEFDC" ELSE RestReal .18
- Rest .1
- IF INKEY$ <> "" GOTO GetThisOverWith
- NEXT
- Rest 1
- END IF
- GetThisOverWith:
- ' Finally, the intro can be aborted
- END SUB
- 'Intro:
- ' Displays game introduction
- SUB Intro
- IF GSettings.useSound THEN PLAY "MBT160O2" ' Initialise sound
- WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
- RESTORE SlidyText
- Slidy
- SparklePause (5)
- t$ = STRING$(80, " ")
- FOR s = 5 TO 8: LOCATE s * 2, 1: PRINT t$; : NEXT
- LOCATE 1, 1: PRINT t$: LOCATE 22, 1: PRINT t$
- FOR s = 1 TO 22: LOCATE s, 1: PRINT " "; : LOCATE s, 80: PRINT " "; : NEXT
- Slidy
- SparklePause (0)
- END SUB
- SUB LoadSettings
- DIM currLine$, eqPos, KEY$, value$, nBool
- 'þ set default settings
- GSettings.useSound = 1
- GSettings.useOldExplosions = 0
- GSettings.newExplosionRadius = 40
- GSettings.useSlidingText = 0 '1
- GSettings.defaultGravity = 17
- GSettings.defaultRoundQty = 4
- GSettings.showIntro = 1
- GSettings.forceCGA = 0
- lastErrCode = 0
- ON ERROR GOTO FuckOff
- OPEN "Gorillas.ini" FOR INPUT AS #1
- IF lastErrCode > 0 THEN EXIT SUB
- WHILE NOT EOF(1)
- LINE INPUT #1, currLine$
- IF lastErrCode > 0 THEN CLOSE #1: EXIT SUB
- GOSUB processLine
- WEND
- CLOSE #1
- ON ERROR GOTO 0
- EXIT SUB
- processLine:
- eqPos = INSTR(currLine$, "=")
- IF eqPos = 0 THEN
- RETURN
- END IF
- KEY$ = RTRIM$(LTRIM$(MID$(currLine$, 1, eqPos - 1)))
- value$ = RTRIM$(LTRIM$(RIGHT$(currLine$, LEN(currLine$) - eqPos)))
- SELECT CASE UCASE$(KEY$)
- CASE "USESOUND"
- GOSUB getBool
- IF nBool > -1 THEN GSettings.useSound = nBool
- CASE "USEOLDEXPLOSIONS"
- GOSUB getBool
- IF nBool > -1 THEN GSettings.useOldExplosions = nBool
- CASE "NEWEXPLOSIONRADIUS"
- GSettings.newExplosionRadius = VAL(value$)
- CASE "USESLIDINGTEXT"
- GOSUB getBool
- IF nBool > -1 THEN GSettings.useSlidingText = nBool
- CASE "DEFAULTGRAVITY"
- tVal = VAL(value$)
- IF tVal > 0 AND tVal < 100 THEN GSettings.defaultGravity = tVal
- CASE "DEFAULTROUNDQTY"
- tVal = VAL(value$)
- IF tVal > 0 AND tVal < 100 THEN GSettings.defaultRoundQty = tVal
- CASE "SHOWINTRO"
- GOSUB getBool
- IF nBool > -1 THEN GSettings.showIntro = nBool
- CASE "FORCECGA"
- GOSUB getBool
- IF nBool > -1 THEN GSettings.forceCGA = nBool
- END SELECT
- RETURN
- getBool:
- IF UCASE$(value$) = "YES" OR value$ = "1" OR UCASE$(value$) = "TRUE" THEN
- nBool = 1
- ELSEIF UCASE$(value$) = "NO" OR value$ = "0" OR UCASE$(value$) = "FALSE" THEN
- nBool = 0
- ELSE
- nBool = -1
- END IF
- RETURN
- leave:
- 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:
- ' Player$() - player names
- ' NumGames - number of games to play
- FUNCTION PlayGame (Player$(), NumGames, P)
- DIM BCoor(0 TO 30) AS XYPoint
- DIM minRounds
- DIM totalWins(1 TO 2)
- DIM avBan!(1 TO 2) ' mean accuracy
- DIM Throw(1 TO 2) ' throw counter
- DIM numHits(1 TO 2, 1 TO NumGames) ' number of throws needed to kill
- ' opponent per win for each player
- J = 1
- abortYN = FALSE
- minRounds = FIX(NumGames / 2) + 1
- i = 1
- DO
- CLS
- RANDOMIZE (TIMER)
- CALL MakeCityScape(BCoor())
- CALL PlaceGorillas(BCoor())
- DoSun SUNHAPPY
- GLeftAngle# = 0: GRightAngle# = 0
- GLeftVeloc = 0: GRightVeloc = 0
- Hit = FALSE: IF GSettings.useSound THEN PLAY "MBT160O1L8<G>CDEDCDL4ECC"
- go = 1
- DO WHILE Hit = FALSE
- J = 1 - J
- LOCATE 1, 2
- IF Mode = 9 THEN COLOR 12
- PRINT Player$(1);
- LOCATE 1, (MaxCol - LEN(Player$(2)))
- PRINT Player$(2);
- IF Mode = 9 THEN COLOR 9
- Center 23, STR$(totalWins(1)) + " > Score < " + LTRIM$(STR$(totalWins(2)) + " ")
- Tosser = J + 1: Tossee = 2 - J
- 'Plot the shot. Hit is true if Gorilla gets hit.
- Hit = DoShot(Player$(), Tosser, GorillaX(Tosser), GorillaY(Tosser), go, GorillaX(Tossee), GorillaY(Tossee))
- IF Hit = 1 THEN abortYN = TRUE: EXIT DO
- 'If the throw was fatal, Tosser now contains the player who WON
- 'If not hit self then increase number of hits
- IF (J + 1) = Tosser THEN Throw(Tosser) = Throw(Tosser) + 1
- IF Hit = TRUE THEN
- 'Update scores
- totalWins(Tosser) = totalWins(Tosser) + 1
- IF (J + 1) = Tosser THEN numHits(Tosser, totalWins(Tosser)) = Throw(Tosser)
- END IF
- go = go + 1
- LOOP
- IF abortYN THEN EXIT DO
- Throw(1) = 0: Throw(2) = 0
- SLEEP 1
- i = i + 1
- LOOP UNTIL i > NumGames OR totalWins(1) >= minRounds OR totalWins(2) >= minRounds
- 'þ If game played out then go through end game sequence
- IF NOT abortYN THEN
- GamePlayedYN = 1
- FOR l = 1 TO 2: Kills = 0
- IF totalWins(l) > 0 THEN
- FOR m = 1 TO totalWins(l)
- IF numHits(l, m) > 0 THEN
- avBan!(l) = avBan!(l) + numHits(l, m): Kills = Kills + 1
- END IF
- NEXT
- IF avBan!(l) > 0 THEN avBan!(l) = avBan!(l) / Kills
- END IF
- NEXT
- END IF
- SCREEN 0
- WIDTH 80, 25
- COLOR 7, 0
- MaxCol = 80
- CLS
- Stats totalWins(), Player$(), avBan!(), P, abortYN
- CLS : RESTORE NowWhat: Slidy
- LOCATE 2, 1: COLOR 2: PRINT STRING$(80, "Í")
- LOCATE 4, 4: PRINT "Another game? [Y/N]";
- DO
- in$ = UCASE$(INKEY$)
- LOOP UNTIL in$ = "Y" OR in$ = "N"
- IF in$ = "Y" THEN PlayGame = 1 ELSE PlayGame = 0
- END FUNCTION
- 'PlayGame:
- ' 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, othX, othY)
- angleChk = angle#: IF PlayerNum = 2 THEN angleChk = 180 - angleChk
- angle# = angle# / 180 * pi# 'Convert degree angle to radians
- 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
- IF GSettings.useSound THEN 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
- SunHit = FALSE
- ShotInSun = FALSE
- OnScreen = TRUE 'þ FALSE if the banana is off side
- PlayerHit = 0
- NeedErase = FALSE
- Bounced = FALSE
- 'þ Set up banana sound effect
- DoooMinVeloc = 40
- pitch! = 9800
- pitchDec! = 100
- pitchDecDec! = (((InitYVel# - DoooMinVeloc) / (200 - DoooMinVeloc)) * 1.2) - .5
- t2b# = 9999 'þ Used to store the time when the banana is to stop moving
- ' when continuing off screen. 9999 means unused.
- 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
- 'þ Obtain predicted x-coordinate when banana reaches bottom of screen
- GOSUB PredictBottomOfScreen
- 'þ See if banana will overshoot (direction is +ve for left & -ve for right)
- 'þ MissedDist# is -ve for miss, and +ve for hit
- IF Direction > 0 THEN
- MissedDist# = XPredicted#
- ELSE
- MissedDist# = ScrWidth - XPredicted#
- END IF
- 'þ If shot is going backwards, then turns it into a miss
- IF SGN(Direction) = SGN(InitXVel#) THEN MissedDist# = 0 - MissedDist#
- 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 y# > oldy# AND InitYVel# > DoooMinVeloc AND NOT Bounced AND MissedDist# > -175 THEN
- 'þ Play banana sound effect
- IF GSettings.useSound THEN SOUND pitch!, 1
- 'þ Decrement banana sound effect pitch
- IF (pitch! - pitchDec! >= 37) THEN
- pitch! = pitch! - pitchDec!: pitchDec! = pitchDec! - pitchDecDec!
- END IF
- END IF
- IF y# >= ScrHeight - 7 THEN
- 'þ If velocity is still high enough to bounce, and banana is on screen
- IF InitYVel# > 2 AND t2b# = 9999 THEN
- Bounced = TRUE
- IF GSettings.useSound THEN PLAY "O4A64"
- InitYVel# = SQR(InitYVel# ^ 2 - (2 * Gravity * (StartYPos - (ScrHeight - 7)))) * .4
- StartXPos = x#
- y# = ScrHeight - 7: StartYPos = y#
- t# = 0
- ELSE
- 'þ Terminate banana motion
- OnScreen = FALSE
- DoSun SUNHAPPY
- IF t2b# = 9999 THEN 'þ Because its velocity ran out
- IF GSettings.useSound THEN PLAY "O0A4"
- ELSE 'þ Or because it bounced when off screen
- IF SGN(Direction) <> SGN(InitXVel#) THEN GOSUB FailureMessage
- END IF
- END IF
- END IF
- 'þ If banana leaves the screen
- IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) THEN
- 'þ And banana will not return to the screen
- IF (XPredicted# >= ScrWidth - Scl(10)) OR (XPredicted# <= 3) THEN
- IF t# > t2b# THEN
- OnScreen = FALSE
- 'þ Redraw sun as soon as poss
- ' Ignore SunHit: bananas can still take pieces out of the sun unnoticed
- DoSun SUNHAPPY
- IF SGN(Direction) <> SGN(InitXVel#) THEN
- GOSUB FailureMessage
- END IF
- ELSEIF t2b# = 9999 THEN
- IF y# <= 0 THEN t2b# = t# + 1.5 ELSE t2b# = t# + 4
- END IF
- END IF
- END IF
- IF OnScreen AND y# > 0 AND (x# > 3 AND x# < (ScrWidth - Scl(10))) 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
- DoSun SUNHAPPY
- 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
- oldrot = rot
- END IF
- oldx# = x#
- oldy# = y#
- t# = t# + .1
- LOOP
- IF pointval = OBJECTCOLOR THEN
- IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2
- IF PlayerHit = PlayerNum THEN
- IF Mode = 9 THEN COLOR 2
- DoSun SUNSHOCK ' hehehe
- Center 1, "Now that was pretty dumb."
- END IF
- ExplodeGorilla x#, y#, PlayerHit
- IF PlayerHit = PlayerNum THEN
- tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .75
- ' Center 1, SPACE$(25): DoSun SUNHAPPY
- END IF
- ELSEIF pointval <> OBJECTCOLOR AND Impact THEN
- CALL DoExplosion(x# + adjust, y# + adjust)
- 'þ Reset values for shot's initial stage (before any bouncing)
- InitXVel# = COS(angle#) * velocity
- InitYVel# = SIN(angle#) * velocity
- StartXPos = StartX: IF PlayerNum = 2 THEN StartXPos = StartXPos + Scl(25)
- StartYPos = StartY - adjust - 3
- GOSUB PredictReturnToHeight
- 'þ If shot went the right direction...
- IF SGN(Direction) <> SGN(InitXVel#) THEN
- 'þ ...and if shot was too low powered:
- IF (ABS(XPredicted# - StartX) < ABS((othX - StartX) / 3) AND angleChk > 60) OR ABS(XPredicted# - StartX) < ABS((othX - StartX) / 6) THEN
- SELECT CASE FNRan(3)
- CASE 1:
- IF Mode = 9 THEN
- Message$ = "Aren't your little muscles strong enough?"
- ELSE
- Message$ = "Your little muscles not strong enough?"
- END IF
- CASE 2: Message$ = "Now that was feeble."
- CASE 3: Message$ = "You can do better than that!"
- END SELECT
- IF GSettings.useSound THEN PLAY "MBO2L24BAGFEDCO1C2"
- GOSUB DoMessage
- GOSUB RestoreSun
- END IF
- END IF
- END IF
- 'redraw gorillas
- IF PlayerHit = 0 THEN
- PUT (StartX, StartY), GorD&, PSET
- PUT (othX, othY), GorD&, PSET
- END IF
- 'þ Message for backwards-tossed shot
- IF SGN(Direction) = SGN(InitXVel#) AND PlayerHit <> PlayerNum THEN
- IF GSettings.useSound THEN PLAY "MBO1L24BAGFEDCO0C2"
- IF Mode = 9 THEN
- Message$ = "You're not supposed to throw it that way."
- ELSE
- Message$ = "Don't throw it that way!"
- END IF
- GOSUB DoMessage
- GOSUB RestoreSun
- END IF
- PlotShot = PlayerHit
- EXIT FUNCTION
- ' When doing position calculation, don't forget -Gravity and Wind/5
- PredictReturnToHeight:
- ' Prediction of the banana's x-coordinate when it has come down to a level
- ' horizontally equal with the gorilla that fired it.
- t2# = (2 * InitYVel#) / Gravity
- XPredicted# = (InitXVel# * t2#) + (.5 * (Wind / 5) * t2# ^ 2) + StartXPos
- IF PlayerNum = 2 THEN XPredictedRet# = XPredictedRet# + Scl(25)
- RETURN
- PredictBottomOfScreen:
- ' Prediction of the x-coordinate of the shot when it reaches the bottom of
- ' the screen
- fallDist = StartYPos - (ScrHeight - 7)
- t2# = (-InitYVel# - SQR((InitYVel# ^ 2) + (2 * (-Gravity) * fallDist))) / (-Gravity)
- XPredicted# = (InitXVel# * t2#) + ((t2# ^ 2 * Wind) / 10) + StartXPos
- IF PlayerNum = 2 THEN XPredicted# = XPredicted# + Scl(25)
- RETURN
- FailureMessage:
- 'þ Select message based on distance beyond screen edge
- 'þ NOT calibrated for CGA
- GiveDist = 0 'þ Flag to indicate whether to show distance travelled
- 'þ If the player saw the banana leave the screen
- MissedDist# = ABS(MissedDist#)
- IF y# > 0 THEN
- SELECT CASE MissedDist#
- CASE 1 TO 155
- SELECT CASE FNRan(2)
- CASE 1: Message$ = "That went a wee bit far, didn't it?"
- CASE 2: Message$ = "It seems you overdid that a little."
- END SELECT
- CASE 156 TO 640
- SELECT CASE FNRan(4)
- CASE 1: Message$ = "I think you need glasses."
- CASE 2 TO 4: Message$ = "Hmmm...that wasn't good."
- END SELECT
- CASE 641 TO 1500: Message$ = "WHAT? That went MILES OFF!"
- CASE IS > 1500
- SELECT CASE FNRan(2)
- CASE 1: Message$ = "WHAT ARE YOU PLAYING AT?"
- CASE 2: Message$ = "Temper temper"
- END SELECT
- END SELECT
- ELSE
- SELECT CASE MissedDist#
- CASE 1 TO 155:
- IF Mode = 9 THEN
- Message$ = "A little nearer and you might stand a chance"
- ELSE
- Message$ = "A little nearer and you might make it."
- END IF
- CASE 156 TO 640:
- SELECT CASE FNRan(2)
- CASE 1: Message$ = "Nope. That was too far off."
- CASE 2: Message$ = CHR$(34) + "Hello? I'm over here!" + CHR$(34)
- END SELECT
- CASE 640 TO 1500
- SELECT CASE FNRan(2)
- CASE 1: Message$ = "Whoa! Go easy with it!"
- CASE 2: Message$ = "You must be JOKING!"
- END SELECT
- CASE IS > 1500:
- IF Mode = 9 THEN
- Message$ = "You weren't supposed to put it into orbit."
- ELSE
- Message$ = "Don't put it into orbit!"
- END IF
- END SELECT
- END IF
- IF GSettings.useSound THEN PLAY "MBO1L24BAGFEDCO0C2"
- GOSUB DoMessage
- GOSUB RestoreSun
- RETURN
- DoMessage:
- IF Mode = 9 THEN COLOR 2
- Center 1, Message$
- tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + 2
- Center 1, SPACE$(LEN(Message$))
- RETURN
- RestoreSun:
- sunX = ScrWidth \ 2: sunY = Scl(25)
- LINE (sunX, sunY - Scl(15))-(sunX, sunY), SUNATTR
- LINE (sunX - Scl(8), sunY - Scl(13))-(sunX, sunY), SUNATTR
- LINE (sunX, sunY)-(sunX + Scl(8), sunY - Scl(13)), SUNATTR
- RETURN
- END FUNCTION
- 'Rest:
- ' pauses the program
- SUB Rest (t#)
- s# = TIMER
- t2# = 0
- ' t2# = MachSpeed * t#' / SPEEDCONST
- 'þ Speed calibration disabled
- DO
- LOOP UNTIL TIMER - s# > t2#
- END SUB
- SUB RestReal (t#)
- s# = TIMER
- DO
- LOOP UNTIL TIMER - s# > t#
- 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
- PALETTE 10, 24
- PALETTE 14, 55
- ELSE
- ExplosionColor = 2
- BackColor = 0
- COLOR BackColor, 2
- END IF
- END SUB
- SUB ShowPrompts (fieldNum)
- SELECT CASE fieldNum
- CASE 1 TO 2
- GOSUB pPlayers ' player list manipulation
- CASE 11
- GOSUB pDeletePlayer
- CASE 12, -12
- GOSUB pCreatePlayer
- CASE 13
- GOSUB pRenamePlayer
- CASE 3
- GOSUB pRounds
- CASE 4
- GOSUB pGravity
- END SELECT
- EXIT SUB
- pPlayers:
- COLOR , 0
- FOR l = 3 TO 6: LOCATE l, 1: PRINT STRING$(80, " "); : NEXT
- noOfDiams = 4: GOSUB Diamonds
- IF fieldNum = 1 THEN LOR$ = "LEFT" ELSE IF fieldNum = 2 THEN LOR$ = "RIGHT"
- COLOR 9: LOCATE 3, 5
- PRINT "Use arrow keys to choose " + LOR$ + " HAND player and press [ENTER] to confirm."
- LOCATE 4, 5: PRINT "Type [N] to create a new player (up to 20 players)."
- LOCATE 5, 5: PRINT "Type [R] to rename a player."
- LOCATE 6, 5: PRINT "Type [DELETE] to delete a player."
- RETURN
- pDeletePlayer:
- noOfDiams = 3: GOSUB Diamonds
- LOCATE 4, 5: COLOR 9: PRINT "Press [Y] to delete the player, OR"
- LOCATE 5, 5: PRINT "Press [N] to cancel"
- RETURN
- pCreatePlayer:
- COLOR , 0
- FOR l = 3 TO 6: LOCATE l, 1: PRINT STRING$(80, " "): NEXT
- noOfDiams = 1: GOSUB Diamonds
- 'þ Used if the ESCAPE prompt is to be given
- IF fieldNum = 12 THEN LOCATE 6, 3: PRINT ""
- COLOR 9
- LOCATE 3, 5: PRINT "Enter name of new player and press [ENTER] when done. You may as well"
- LOCATE 4, 5: PRINT "specify the player's full name as you only ever have to enter it"
- LOCATE 5, 5: PRINT "once."
- 'þ Signals whether ESCAPE can be pressed
- IF fieldNum = 12 THEN LOCATE 6, 5: PRINT "Or press [ESC] to cancel."
- RETURN
- pRenamePlayer:
- COLOR , 0
- FOR l = 3 TO 6
- LOCATE l, 1: PRINT STRING$(80, " ")
- NEXT
- noOfDiams = 3: GOSUB Diamonds: COLOR 9
- LOCATE 3, 5: PRINT "Edit name of player and press [ENTER] when done."
- LOCATE 4, 5: PRINT "Pressing [DELETE] will clear the name field."
- LOCATE 5, 5: PRINT "Press [ESC] if you want to undo the changes."
- RETURN
- '
- pRounds:
- COLOR , 0
- FOR l = 3 TO 6: LOCATE l, 1: PRINT STRING$(80, " "); : NEXT
- noOfDiams = 1: GOSUB Diamonds
- COLOR 9
- LOCATE 3, 5: PRINT "Enter input and press [ENTER] for the next field."
- RETURN
- pGravity:
- noOfDiams = 2: GOSUB Diamonds
- COLOR 9
- LOCATE 3, 5: PRINT "Enter input and press [ENTER] to finish and play the game."
- LOCATE 4, 5: PRINT "Or press [TAB] to return to the first entry."
- LOCATE 6, 5: PRINT "Competition gravity is 17 m/sý."
- RETURN
- '
- Diamonds:
- COLOR 2
- FOR l = 3 TO (3 + (noOfDiams - 1))
- LOCATE l, 3: PRINT ""
- NEXT
- RETURN
- END SUB
- SUB Slidy
- DIM q AS LONG
- READ N
- DIM t$(1 TO N): DIM i(1 TO N, 1 TO 3)
- FOR l = 1 TO N
- READ P$: x = 40 - LEN(P$) / 2
- P$ = STRING$(x, " ") + P$ + STRING$(x, " ")
- READ i(l, 1), i(l, 2), i(l, 3)
- t$(l) = P$
- NEXT
- IF GSettings.useSlidingText THEN
- FOR la = 1 TO 80
- FOR lb = 1 TO N
- IF i(lb, 2) < 0 THEN
- P$ = LEFT$(t$(lb), la): x = 81 - la
- ELSE
- P$ = RIGHT$(t$(lb), la): x = 1
- END IF
- LOCATE i(lb, 3), x: COLOR i(lb, 1): PRINT P$;
- NEXT
- FOR q = 1 TO SLIDECONST: NEXT
- NEXT
- ELSE
- FOR lb = 1 TO N
- LOCATE i(lb, 3), 1: COLOR i(lb, 1): PRINT t$(lb)
- NEXT
- END IF
- END SUB
- 'SparklePause:
- ' Creates flashing border for intro and statistics screens
- SUB SparklePause (opt AS INTEGER)
- DO: LOOP UNTIL INKEY$ = "" 'þ Clear keyboard buffer
- COLOR 12, 0
- a$ = "* * * * * * * * * * * * * * * * * "
- t! = TIMER
- DO
- FOR a = 1 TO 5
- t1! = TIMER: DO: LOOP UNTIL TIMER > t1! + .001
- 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
- LOOP UNTIL INKEY$ <> "" OR (opt > 0 AND TIMER > t! + opt)
- END SUB
- SUB Stats (Wins(), nam$(), Ban!(), P, abortYN)
- IF abortYN THEN
- RESTORE Aborted: Slidy
- LOCATE 4, 3: COLOR 2: PRINT STRING$(76, "Í")
- ELSE
- 'þ Update and sort the league table
- RESTORE GameOver: Slidy
- LOCATE 4, 3: COLOR 2: PRINT STRING$(76, "Í")
- FOR l = 1 TO 2
- PDat(PDefs(l)).Rounds = PDat(PDefs(l)).Rounds + Wins(1) + Wins(2)
- PDat(PDefs(l)).Won = PDat(PDefs(l)).Won + Wins(l)
- IF Ban!(l) > 0 THEN
- IF PDat(PDefs(l)).Accu > 0 THEN
- PDat(PDefs(l)).Accu = CINT(((PDat(PDefs(l)).Accu + Ban!(l)) / 2) * 10) / 10
- ELSE
- PDat(PDefs(l)).Accu = CINT(Ban!(l) * 10) / 10
- END IF
- END IF
- NEXT
- 'þ routine to sort the player list
- DO
- complete = 1: tempW1 = 0: tempW2 = 0
- FOR l = 1 TO P - 1
- IF PDat(l).Rounds > 0 THEN tempW1 = (PDat(l).Won / PDat(l).Rounds * 100)
- IF PDat(l + 1).Rounds > 0 THEN tempW2 = (PDat(l + 1).Won / PDat(l + 1).Rounds * 100)
- IF (tempW1 < tempW2) OR (tempW1 = tempW2 AND PDat(l).Accu > PDat(l + 1).Accu) THEN
- SWAP PDat(l).PNam, PDat(l + 1).PNam
- SWAP PDat(l).Rounds, PDat(l + 1).Rounds
- SWAP PDat(l).Won, PDat(l + 1).Won
- SWAP PDat(l).Accu, PDat(l + 1).Accu
- FOR PDl = 1 TO 2
- IF PDefs(PDl) = l THEN
- PDefs(PDl) = PDefs(PDl) + 1
- ELSEIF PDefs(PDl) = l + 1 THEN
- PDefs(PDl) = PDefs(PDl) - 1
- END IF
- NEXT
- complete = 0
- END IF
- NEXT
- LOOP UNTIL complete
- FOR l = 1 TO 2
- IF Wins(1) <> Wins(2) THEN
- D = (Wins(l) >= Wins(2 / l))
- COLOR (D + 2) * 2: LOCATE 6 + D, 7
- ELSE
- COLOR 9: LOCATE 4 + l, 7
- END IF
- PRINT nam$(l); " "; STRING$(20 - LEN(nam$(l)), "Ä"); ""; Wins(l);
- IF (Wins(1) <> Wins(2)) THEN
- IF D = -1 THEN PRINT CHR$(27); "ÄÄÄÄ Winnar!";
- ELSEIF l = 1 THEN
- PRINT " (The game was a draw)";
- END IF
- posn = 0: DO: posn = posn + 1: LOOP UNTIL nam$(l) = RTRIM$(PDat(posn).PNam)
- IF posn > 10 THEN PRINT TAB(54); "(position"; RTRIM$(STR$(posn)); "th)"
- NEXT
- END IF
- 'þ Show league table no matter what
- LOCATE 8, 20: COLOR 9: PRINT "STATISTICS";
- LOCATE 9, 3: COLOR 2: PRINT "Ú"; STRING$(74, "Ä"); "¿";
- FOR l = 10 TO 20: LOCATE l, 3: PRINT "³"; TAB(78); "³"; : NEXT
- LOCATE 21, 3: PRINT "À"; STRING$(74, "Ä"); "Ù";
- COLOR 3
- LOCATE 9, 5: PRINT "Place";
- LOCATE 9, 12: PRINT "Player";
- LOCATE 9, 32: PRINT "Rounds";
- LOCATE 9, 54: PRINT "Mean Accuracy";
- LOCATE 9, 40: PRINT "Won";
- COLOR 5: IF P > 9 THEN lim = 10 ELSE lim = P
- FOR l = 1 TO lim
- LOCATE l + 10, 6:
- IF (PDefs(1) = l OR PDefs(2) = l) AND NOT abortYN THEN COLOR 11 ELSE COLOR 5
- IF l < 10 THEN PRINT "0";
- PRINT LTRIM$(STR$(l)); " ÄÄ "; TAB(12); PDat(l).PNam
- COLOR 5: LOCATE l + 10, 31: PRINT PDat(l).Rounds; TAB(39); PDat(l).Won; TAB(45);
- IF PDat(l).Rounds = 0 THEN
- PRINT "-"; TAB(53);
- ELSE
- IF (PDefs(1) = l OR PDefs(2) = l) AND NOT abortYN THEN COLOR 11 ELSE COLOR 13
- PRINT ; "("; LTRIM$(RTRIM$(STR$(CINT(PDat(l).Won / PDat(l).Rounds * 100)))); "%)"; TAB(53);
- END IF
- COLOR 5
- IF PDat(l).Accu = 0 THEN
- PRINT ; " -"
- ELSE
- PRINT ; PDat(l).Accu;
- IF PDat(l).Accu > 1! THEN PRINT "bananas" ELSE PRINT "banana"
- END IF
- NEXT
- 'þ Only save stats if they have changed or if file absent
- IF NOT abortYN OR DoesFileExist = 0 THEN
- COLOR 5: LOCATE 24, 3: PRINT "Saving stats...";
- ON ERROR GOTO NoSaveStats
- IF DoesFileExist = 1 THEN KILL "Gorillas.lge"
- OPEN "Gorillas.lge" FOR OUTPUT AS #1
- PRINT #1, P
- FOR l = 1 TO P
- PRINT #1, PDat(l).PNam
- PRINT #1, PDat(l).Rounds, PDat(l).Won, PDat(l).Accu
- NEXT
- CLOSE #1
- DoesFileExist = 1
- ON ERROR GOTO 0
- END IF
- COLOR 15: LOCATE 24, 3: PRINT "Press a key... ";
- SparklePause (0)
- 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
- IF GSettings.useSound THEN PLAY "MFO0L32EFGEFDC" ELSE RestReal .2
- Rest .2
- PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET
- IF GSettings.useSound THEN PLAY "MFO0L32EFGEFDC" ELSE RestReal .2
- Rest .2
- NEXT
- END SUB
- FUNCTION WhereX (num)
- WhereX = ((num - 1) MOD 4) * 19 + 3
- END FUNCTION
- FUNCTION WhereY (num)
- WhereY = INT((num - 1) / 4) + 13
- END FUNCTION
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement