'QBASIC GORILLAS 2.1b3'Version 1.0 (c)1990 Microsoft Corp and/or IBM Corp'Version 2.* (c)1997-2005 Daniel Beardsmore'See http://telcontar.net/Misc/Gorillas/ for more information'Set default data type to integer for faster game playDEFINT A-Z'Sub DeclarationsDECLARE 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 (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 TYPEsTYPE settings  useSound AS INTEGER  useOldExplosions AS INTEGER  newExplosionRadius AS INTEGER  useSlidingText AS INTEGER  defaultGravity AS INTEGER  defaultRoundQty AS INTEGER  showIntro AS INTEGEREND TYPETYPE XYPoint  XCoor AS INTEGER  YCoor AS INTEGEREND TYPETYPE PlayerData  PNam AS STRING * 17  Rounds AS INTEGER  Won AS INTEGER  Accu AS SINGLEEND TYPE' ConstantsCONST NPLAYERS = 20CONST TRUE = -1CONST FALSE = NOT TRUECONST HITSELF = 1CONST BACKATTR = 0CONST OBJECTCOLOR = 1CONST WINDOWCOLOR = 14CONST SUNHAPPY = FALSECONST SUNSHOCK = TRUECONST RIGHTUP = 1CONST LEFTUP = 2CONST ARMSDOWN = 3' Global VariablesDIM SHARED GSettings AS settingsDIM SHARED lastErrCodeDIM SHARED SLIDECONST AS LONGDIM SHARED GorillaX(1 TO 2)  'Location of the two gorillasDIM SHARED GorillaY(1 TO 2)DIM SHARED LastBuildingDIM SHARED pi#DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of bananaDIM SHARED GorD&(120)        'Graphical picture of Gorilla arms downDIM SHARED GorL&(120)        'Gorilla left arm raisedDIM SHARED GorR&(120)        'Gorilla right arm raisedDIM SHARED GravityDIM SHARED WindDIM SHARED GLeftAngle#DIM SHARED GRightAngle#DIM SHARED GLeftVelocDIM SHARED GRightVeloc'Screen Mode VariablesDIM SHARED ScrHeightDIM SHARED ScrWidthDIM SHARED ModeDIM SHARED MaxCol' Screen Color VariablesDIM SHARED ExplosionColorDIM SHARED SUNATTRDIM SHARED BackColorDIM SHARED SunHtDIM SHARED GHeightDIM SHARED MachSpeed AS DOUBLEDIM SHARED PDefs(1 TO 2)DIM player$(1 TO 2)DIM SHARED PDat(1 TO NPLAYERS) AS PlayerDataDIM SHARED GamePlayedYNDIM SHARED DoesFileExistDIM NumGames ' 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 LoadSettings Gravity = GSettings.defaultGravity NumGames = GSettings.defaultRoundQty ' 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 DEF SEG = 0                         ' Restore NumLock state POKE 1047, KeyFlags DEF SEG SYSTEM' Banana sprite definitionsCGABanana: 'BananaLeft DATA 327686, -252645316, 60 'BananaDown DATA 196618, -1057030081, 49344 'BananaUp DATA 196618, -1056980800, 63 'BananaRight DATA 327686,  1010580720, 240EGABanana: '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 spritesInitVars: 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 IF Mode = 1 THEN  PRINT "Sorry, but CGA is not currently supported. If you want to run Gorillas"  PRINT "in CGA then let me know, and I'll fix the program to support it."  PRINT : SYSTEM 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 IFRETURNFuckOff: lastErrCode = ERR RESUME NEXTScreenModeError:  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 IFPaletteError:  Mode = 1            '64K EGA cards will run in CGA mode.  RESUME NEXT' Message displayed when league table absentIsThereNoFile: 'CLS 'BEEP 'PRINT "League table (GORILLAS.LGE) not found. A new league table file will" 'PRINT "be created after the first match. DON'T PANIC!" 'SLEEP 3 DoesFileExist = 0RESUME NEXTNoSaveStats: 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 CLOSESYSTEMCorruptFile: 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: PRINTSYSTEM' Sliding text data storeSlidyText:DATA 6DATA "        Q B a s i c  G O R I L L A S  v2.1b3",15,1,4DATA "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ",7,-1,5DATA "DELUXE EDITION",15,1,6DATA "Original program (c)1990 Microsoft Corporation",4,1,10DATA "Gorillas Deluxe (c)1997-2005 Daniel Beardsmore",12,-1,12DATA "Dedicated to all the Gorillas and Gorillas Deluxe fans",2,1,16DATA 10DATA "INSTRUCTIONS",9,1,8DATA "Your mission is to hit your opponent with an exploding",11,1,10DATA "banana by varying the angle and power of your throw, taking",11,-1,11DATA "into account wind speed, gravity, and the city skyline.",11,1,12DATA "The wind speed is shown by a directional arrow at the bottom",11,-1,14DATA "of the playing field, its length relative to its strength.",11,1,15DATA "Zero degrees is horizontal, towards your opponent, with 90 degrees",11,-1,16DATA "being vertically upwards, and so on. Angles can be from 0 to",11,1,17DATA "360 degrees and velocity can range from 1 to 200.",11,-1,18DATA "Press any key to continue...",15,1,20PartingMessage:DATA 1DATA "Thank you for playing Gorillas!",11,1,8'Next number is the number of final phrasesDATA 5DATA 1,"May the Schwarz be with you!",14,-1,14DATA 1,"Live long and prosper.",14,-1,14DATA 1,"Goodbye!",14,-1,14DATA 1,"So long!",14,-1,14DATA 1,"Adios!",14,-1,14Ready:DATA 1,"Prepare for battle!",12,1,1Setup:DATA 1,"Game Setup",14,-1,1GameOver:DATA 1,"Game Over!",14,-1,3Aborted:DATA 1,"Game aborted",12,-1,3NowWhat:DATA 1,"Now What?",14,1,1VectorData:DATA 39DATA 0.582,0.988, 0.608,0.850, 0.663,0.788, 0.738,0.800DATA 0.863,0.838, 0.813,0.713, 0.819,0.650, 0.875,0.588DATA 1.000,0.563, 0.850,0.450, 0.825,0.400, 0.830,0.340DATA 0.925,0.238, 0.775,0.243, 0.694,0.225, 0.650,0.188, 0.630,0.105DATA 0.625,0.025, 0.535,0.150, 0.475,0.175, 0.425,0.150DATA 0.325,0.044, 0.325,0.150, 0.315,0.208, 0.288,0.250, 0.225,0.275DATA 0.053,0.288, 0.150,0.392, 0.175,0.463, 0.144,0.525DATA 0.025,0.638, 0.163,0.650, 0.225,0.693, 0.250,0.775DATA 0.225,0.905, 0.360,0.825, 0.450,0.823, 0.525,0.863DATA 0.582,0.988REM $STATICSUB 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 SUBSUB 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    'þ Draw grey smoke  IF GSettings.useSound THEN PLAY "MBO0L32EFGEFDC"  CIRCLE (x#, y#), 1.175 * radii(1, 1), 10  PAINT (x#, y#), 10, 10  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 '.08  CIRCLE (x#, y#), 1.175 * radii(1, 1), 0  PAINT (x#, y#), 0, 0 END IFEXIT SUBDrawShape: 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, imageColRETURNEND 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 (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$)      'LOCATE 3, LocateCol   'PRINT "Velocity:";   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 4   LOCATE i, 1   PRINT SPACE$(30 \ (80 \ MaxCol));   LOCATE i, (50 \ (80 \ MaxCol))   PRINT SPACE$(30 \ (80 \ MaxCol));  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 IFEXIT FUNCTIONAbortGame: cont = FALSE: cval = 1: tpause! = TIMER - 2 DO  IF TIMER > tpause! + .5 THEN   tpause! = TIMER   cval = 15 / cval: COLOR cval - 1: Center 1, " Abort game? [Y/N]"   IF cval = 1 THEN GOSUB DSRestoreSun  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 = 15 THEN COLOR 1: Center 1, SPACE$(18)  DoSun SUNHAPPY: COLOR 15: RETURN END IFEXIT FUNCTIONDSRestoreSun: 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)), SUNATTRRETURNEND 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), 0END 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 bananaSUB 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&, XOREND SELECTEND 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 downSUB 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 iEND SUB'ExplodeGorilla:'  Causes gorilla explosion when a direct hit occurs'Parameters:'  X#, Y# - shot locationSUB 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 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'  DO: LOOP UNTIL INKEY$ <> ""  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 SUBSUB Extro 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$ <> "" COLOR 7: CLSEND SUBFUNCTION 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 = 1GET$ = 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 playersSUB 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 completeplayer$(1) = RTRIM$(PDat(PDefs(1)).PNam)player$(2) = RTRIM$(PDat(PDefs(2)).PNam)NumGames = VAL(numG$)Gravity = VAL(grav$)'þ Clear most of the screenCOLOR , 0: FOR l = 3 TO 24: LOCATE l, 1: PRINT STRING$(80, " "); : NEXTEXIT SUB'þþþþþþþþþþþþþþþþþþþþ'þ FIELDS SUBROUTINESManagePlayers: 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 finishedRETURN       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 IFRETURNRenamePlayer: 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 IFRETURNDeletePlayer: 'þ 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 IFRETURNRounds: 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$));RETURNGravity: 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 displaySetupFields: 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 SELECTRETURNDrawBox: 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 IFRETURN' cursor displayMove: 'þ 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 SELECTRETURNCurs: 'þ 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)));RETURNEND 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   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 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 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    COLOR 11: Center 2, " QBasic G O R I L L A S "    COLOR 9: Center 4, "STARRING:"    P$ = player$(1) + " AND " + player$(2)    COLOR 3: Center 5, STRING$(LEN(P$), "Ä")    COLOR 2: Center 6, P$: 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 IFGetThisOverWith: ' Finally, the intro can be abortedEND SUB'Intro:'  Displays game introductionSUB Intro  IF GSettings.useSound THEN PLAY "MBT160O2" ' Initialise sound  WHILE INKEY$ <> "": WEND 'Clear keyboard buffer  RESTORE SlidyText  Slidy  SparklePause (3)  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)   IF Mode = 1 THEN MaxCol = 40  END SUBSUB LoadSettingsDIM 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 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 0EXIT SUBprocessLine: 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 END SELECT RETURNgetBool: 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 RETURNleave: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 IFEND 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 iEND SUB'PlayGame:'  Main game play routine'Parameters:'  Player$() - player names'  NumGames - number of games to playFUNCTION 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(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 = 0END FUNCTION'PlayGame:'  Plots banana shot across the screen'Parameters:'  StartX, StartY - starting shot location'  Angle - shot angle'  Velocity - shot velocity'  PlayerNum - the banana throwerFUNCTION 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 COLOR 2: Center 1, "Now that was pretty dumb."  ExplodeGorilla x#, y#, PlayerHit  IF PlayerHit = PlayerNum THEN   tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .75   Center 1, SPACE$(25): GOSUB RestoreSun  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: Message$ = "Aren't your little muscles strong enough?"     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"  Message$ = "You're not supposed to throw it that way."  GOSUB DoMessage  GOSUB RestoreSun END IF PlotShot = PlayerHitEXIT FUNCTION' When doing position calculation, don't forget -Gravity and Wind/5PredictReturnToHeight: ' 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)RETURNPredictBottomOfScreen: ' 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)RETURNFailureMessage: 'þ 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: Message$ = "A little nearer and you might stand a chance"   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: Message$ = "You weren't supposed to put it into orbit."  END SELECT END IF IF GSettings.useSound THEN PLAY "MBO1L24BAGFEDCO0C2" COLOR 13 GOSUB DoMessage GOSUB RestoreSunRETURNDoMessage: COLOR 2 Center 1, Message$ tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + 2 Center 1, SPACE$(LEN(Message$))RETURNRestoreSun: 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)), SUNATTRRETURNEND FUNCTION'Rest:'  pauses the programSUB rest (t#)  s# = TIMER  t2# = 0  ' t2# = MachSpeed * t#' / SPEEDCONST  'þ Speed calibration disabled  DO  LOOP UNTIL TIMER - s# > t2#END SUBSUB 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 IFEND FUNCTION'SetScreen:'  Sets the appropriate color statementsSUB 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 IFEND SUBSUB 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 SELECTEXIT SUBpPlayers: 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."RETURNpDeletePlayer: 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"RETURNpCreatePlayer: 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."RETURNpRenamePlayer: 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."RETURNpGravity: 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 "" NEXTRETURNEND SUBSUB 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 IFEND SUB'SparklePause:'  Creates flashing border for intro and statistics screensSUB 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 SUBSUB 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); "ÄÄÄÄ Winner!";   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 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 dancingSUB 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  NEXTEND SUBFUNCTION WHEREX (num) WHEREX = ((num - 1) MOD 4) * 19 + 3END FUNCTIONFUNCTION WHEREY (num) WHEREY = INT((num - 1) / 4) + 13END FUNCTION