Advertisement
Transigence

Gorillas

Jan 6th, 2020
2,120
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
QBasic 70.00 KB | None | 0 0
  1. 'QBASIC GORILLAS 2.2
  2. 'Version 1.0 (c)1990 Microsoft Corp and/or IBM Corp
  3. 'Version 2.2 (c)1997-2007 Daniel Beardsmore
  4. 'See http://telcontar.net/Misc/Gorillas/ for more information
  5.  
  6. 'Set default data type to integer for faster game play
  7. DEFINT A-Z
  8.  
  9. 'Sub Declarations
  10. DECLARE SUB RestReal (t#)
  11. DECLARE SUB AlertSnd ()
  12. DECLARE SUB LoadSettings ()
  13. DECLARE SUB Center (Row, Text$)
  14. DECLARE SUB DoBeep ()
  15. DECLARE SUB DoExplosion (x#, y#)
  16. DECLARE SUB DoSun (Mouth)
  17. DECLARE SUB DrawBan (xc#, yc#, r, bc)
  18. DECLARE SUB DrawGorilla (x, y, arms)
  19. DECLARE SUB ExplodeGorilla (x#, y#, PlayerHit)
  20. DECLARE SUB Extro ()
  21. DECLARE SUB GetInputs (Player$(), NumGames, P)
  22. DECLARE SUB GorillaIntro (Player$(), cIntro)
  23. DECLARE SUB Intro ()
  24. DECLARE SUB MakeCityScape (BCoor() AS ANY)
  25. DECLARE SUB PlaceGorillas (BCoor() AS ANY)
  26. DECLARE SUB Rest (t#)
  27. DECLARE SUB SetScreen ()
  28. DECLARE SUB ShowPrompts (fieldNum AS INTEGER)
  29. DECLARE SUB Slidy ()
  30. DECLARE SUB SparklePause (opt AS INTEGER)
  31. DECLARE SUB Stats (Wins(), NAME$(), Ban!(), P, abortYN)
  32. DECLARE SUB VictoryDance (Player)
  33.  
  34. DECLARE FUNCTION CalcDelay# ()
  35. DECLARE FUNCTION DoShot (Player$(), PlayerNum, x, y, turn, othX, othY)
  36. DECLARE FUNCTION GET$ (Row, Col, Prev$, Typ, Max, Esc)
  37. DECLARE FUNCTION PlayGame (Player$(), NumGames, P)
  38. DECLARE FUNCTION PlotShot (StartX, StartY, angle#, velocity, PlayerNum, othX, othY)
  39. DECLARE FUNCTION Scl (N!)
  40. DECLARE FUNCTION WhereX (num)
  41. DECLARE FUNCTION WhereY (num)
  42.  
  43. 'Make all arrays Dynamic
  44. '$DYNAMIC
  45.  
  46. ' User-Defined TYPEs
  47.  
  48. TYPE settings
  49.   useSound AS INTEGER
  50.   useOldExplosions AS INTEGER
  51.   newExplosionRadius AS INTEGER
  52.   useSlidingText AS INTEGER
  53.   defaultGravity AS INTEGER
  54.   defaultRoundQty AS INTEGER
  55.   showIntro AS INTEGER
  56.   forceCGA AS INTEGER
  57. END TYPE
  58.  
  59. TYPE XYPoint
  60.   XCoor AS INTEGER
  61.   YCoor AS INTEGER
  62. END TYPE
  63.  
  64. TYPE PlayerData
  65.   PNam AS STRING * 17
  66.   Rounds AS INTEGER
  67.   Won AS INTEGER
  68.   Accu AS SINGLE
  69. END TYPE
  70.  
  71. ' Constants
  72. CONST NPLAYERS = 20
  73. CONST TRUE = -1
  74. CONST FALSE = NOT TRUE
  75. CONST HITSELF = 1
  76. CONST BACKATTR = 0
  77. CONST OBJECTCOLOR = 1
  78. CONST WINDOWCOLOR = 14
  79. CONST SUNHAPPY = FALSE
  80. CONST SUNSHOCK = TRUE
  81. CONST RIGHTUP = 1
  82. CONST LEFTUP = 2
  83. CONST ARMSDOWN = 3
  84.  
  85. ' Global Variables
  86. DIM SHARED GSettings AS settings
  87.  
  88. DIM SHARED lastErrCode
  89.  
  90. DIM SHARED SLIDECONST AS LONG
  91.  
  92. DIM SHARED GorillaX(1 TO 2)  'Location of the two gorillas
  93. DIM SHARED GorillaY(1 TO 2)
  94. DIM SHARED LastBuilding
  95.  
  96. DIM SHARED pi#
  97. DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of banana
  98. DIM SHARED GorD&(120)        'Graphical picture of Gorilla arms down
  99. DIM SHARED GorL&(120)        'Gorilla left arm raised
  100. DIM SHARED GorR&(120)        'Gorilla right arm raised
  101.  
  102. DIM SHARED Gravity
  103. DIM SHARED Wind
  104. DIM SHARED GLeftAngle#
  105. DIM SHARED GRightAngle#
  106. DIM SHARED GLeftVeloc
  107. DIM SHARED GRightVeloc
  108.  
  109. 'Screen Mode Variables
  110. DIM SHARED ScrHeight
  111. DIM SHARED ScrWidth
  112. DIM SHARED Mode
  113. DIM SHARED MaxCol
  114.  
  115. ' Screen Color Variables
  116. DIM SHARED ExplosionColor
  117. DIM SHARED SUNATTR
  118. DIM SHARED BackColor
  119.  
  120. DIM SHARED SunHt
  121. DIM SHARED GHeight
  122. DIM SHARED MachSpeed AS DOUBLE
  123.  
  124. DIM SHARED PDefs(1 TO 2)
  125. DIM Player$(1 TO 2)
  126. DIM SHARED PDat(1 TO NPLAYERS) AS PlayerData
  127. DIM SHARED GamePlayedYN
  128.  
  129. DIM SHARED DoesFileExist
  130.  
  131. DIM NumGames
  132.  
  133.  ' Load settings before initVars so we can look for forceCGA
  134.  LoadSettings
  135.  
  136.  ' Check for league table file, and load table entries
  137.  
  138.  DoesFileExist = 1
  139.  ON ERROR GOTO IsThereNoFile
  140.  OPEN "Gorillas.lge" FOR INPUT AS #1
  141.  ON ERROR GOTO CorruptFile
  142.  IF DoesFileExist = 1 THEN
  143.   INPUT #1, count
  144.   FOR l = 1 TO count
  145.    INPUT #1, PDat(l).PNam, PDat(l).Rounds, PDat(l).Won, PDat(l).Accu
  146.   NEXT
  147.   CLOSE #1
  148.   ON ERROR GOTO 0
  149.  ELSE
  150.   count = 0
  151.  END IF
  152.  
  153.  DEF FNRan (x) = INT(RND(1) * x) + 1
  154.  DEF SEG = 0                         ' Set NumLock to ON
  155.  KeyFlags = PEEK(1047)
  156.  IF (KeyFlags AND 32) = 0 THEN
  157.   POKE 1047, KeyFlags OR 32
  158.  END IF
  159.  DEF SEG
  160.  
  161.  ' Initialisation and sliding text speed calculation
  162.  
  163.  GOSUB InitVars
  164.  MachSpeed = CalcDelay
  165.  IF MachSpeed < 1000 THEN
  166.   SLIDECONST = (4 * MachSpeed) - 1250
  167.   IF SLIDECONST < 0 THEN SLIDECONST = 0
  168.  ELSE
  169.   SLIDECONST = 2.929 * MachSpeed
  170.  END IF
  171.  
  172.  ' Program outline
  173.  Gravity = GSettings.defaultGravity
  174.  NumGames = GSettings.defaultRoundQty
  175.  IF Mode = 1 THEN
  176.   REM CGA needs a half-size explosion radius
  177.   GSettings.newExplosionRadius = GSettings.newExplosionRadius \ 2
  178.  END IF
  179.  
  180.  ' Init screen
  181.  SCREEN 0
  182.  WIDTH 80, 25
  183.  MaxCol = 80
  184.  COLOR 15, 0
  185.  CLS
  186.  
  187.  GamePlayed = 0
  188.  IF GSettings.showIntro THEN Intro
  189.  more = 1: DO
  190.   GetInputs Player$(), NumGames, count
  191.   GorillaIntro Player$(), DoesFileExist
  192.   more = PlayGame(Player$(), NumGames, count)
  193.  LOOP UNTIL more = 0
  194.  Extro
  195.  
  196.  COLOR 7: CLS ' Else QBasic crashes here! lol
  197.  
  198.  DEF SEG = 0                         ' Restore NumLock state
  199.  POKE 1047, KeyFlags
  200.  DEF SEG
  201.  SYSTEM
  202.  
  203. ' Banana sprite definitions
  204.  
  205. CGABanana:
  206.  'BananaLeft
  207.  DATA 327686, -252645316, 60
  208.  'BananaDown
  209.  DATA 196618, -1057030081, 49344
  210.  'BananaUp
  211.  DATA 196618, -1056980800, 63
  212.  'BananaRight
  213.  DATA 327686,  1010580720, 240
  214.  
  215. EGABanana:
  216.  'BananaLeft
  217.  DATA 458758,202116096,471604224,943208448,943208448,943208448,471604224,202116096,0
  218.  'BananaDown
  219.  DATA 262153, -2134835200, -2134802239, -2130771968, -2130738945,8323072, 8323199, 4063232, 4063294
  220.  'BananaUp
  221.  DATA 262153, 4063232, 4063294, 8323072, 8323199, -2130771968, -2130738945, -2134835200,-2134802239
  222.  'BananaRight
  223.  DATA 458758, -1061109760, -522133504, 1886416896, 1886416896, 1886416896,-522133504,-1061109760,0
  224.  
  225. ' Initialise graphics mode and sprites
  226.  
  227. InitVars:
  228.  pi# = 4 * ATN(1#)
  229.  
  230.  IF GSettings.forceCGA THEN
  231.   Mode = 1
  232.  ELSE
  233.   ' Select best graphics mode
  234.   ON ERROR GOTO ScreenModeError
  235.   Mode = 9
  236.   SCREEN Mode
  237.   ON ERROR GOTO PaletteError
  238.   IF Mode = 9 THEN PALETTE 4, 0   'Check for 64K EGA
  239.  END IF
  240.  
  241.  IF Mode = 9 THEN
  242.   ScrWidth = 640
  243.   ScrHeight = 350
  244.   GHeight = 25
  245.   SUNATTR = 3
  246.   RESTORE EGABanana
  247.   REDIM LBan&(8), RBan&(8), UBan&(8), DBan&(8)
  248.  
  249.   FOR i = 0 TO 8
  250.    READ LBan&(i)
  251.   NEXT i
  252.   FOR i = 0 TO 8
  253.    READ DBan&(i)
  254.   NEXT i
  255.   FOR i = 0 TO 8
  256.    READ UBan&(i)
  257.   NEXT i
  258.   FOR i = 0 TO 8
  259.    READ RBan&(i)
  260.   NEXT i
  261.  
  262.   SunHt = 43
  263.  ELSE
  264.   ScrWidth = 320
  265.   ScrHeight = 200
  266.   GHeight = 12
  267.   SUNATTR = 3
  268.   RESTORE CGABanana
  269.   REDIM LBan&(2), RBan&(2), UBan&(2), DBan&(2)
  270.   REDIM GorL&(20), GorD&(20), GorR&(20)
  271.  
  272.   FOR i = 0 TO 2
  273.    READ LBan&(i)
  274.   NEXT i
  275.   FOR i = 0 TO 2
  276.    READ DBan&(i)
  277.   NEXT i
  278.   FOR i = 0 TO 2
  279.    READ UBan&(i)
  280.   NEXT i
  281.   FOR i = 0 TO 2
  282.    READ RBan&(i)
  283.   NEXT i
  284.  
  285.   MachSpeed = MachSpeed * 1.3
  286.   SunHt = 20
  287.  END IF
  288. RETURN
  289.  
  290. FuckOff:
  291.  lastErrCode = ERR
  292.  RESUME NEXT
  293.  
  294. ScreenModeError:
  295.   IF Mode = 1 THEN
  296.     CLS
  297.     LOCATE 10, 5
  298.     PRINT "Sorry, you must have CGA, EGA color or VGA graphics to play Gorillas"
  299.     PRINT
  300.     SYSTEM
  301.   ELSE
  302.     Mode = 1
  303.     RESUME
  304.   END IF
  305.  
  306. PaletteError:
  307.   Mode = 1            '64K EGA cards will run in CGA mode.
  308.   RESUME NEXT
  309.  
  310. IsThereNoFile:
  311.  DoesFileExist = 0
  312. RESUME NEXT
  313.  
  314. NoSaveStats:
  315.  COLOR 7: CLS
  316.  COLOR 12: PRINT "An error occurred trying to save the stats file GORILLAS.LGE"
  317.  PRINT "The statistics have not been saved.": COLOR 7: PRINT
  318.  CLOSE
  319. SYSTEM
  320.  
  321. CorruptFile:
  322.  PRINT
  323.  BEEP
  324.  COLOR 12: PRINT "An error occurred while attempting to read data from the league"
  325.  PRINT "table file, GORILLAS.LGE. Fix it, get it fixed, or delete it. Simple."
  326.  COLOR 7: PRINT
  327. SYSTEM
  328.  
  329. ' Sliding text data store
  330.  
  331. SlidyText:
  332. DATA 5
  333. DATA "      Q B a s i c  G O R I L L A S  v2.2",15,1,4
  334. DATA "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ",7,-1,5
  335. DATA "DELUXE EDITION",15,1,6
  336. DATA "Original program (c)1990 Microsoft Corporation",3,1,10
  337. DATA "Gorillas Deluxe (c)1997-2007 Daniel Beardsmore",2,-1,12
  338. DATA 10
  339. DATA "INSTRUCTIONS",9,1,8
  340. DATA "Your mission is to hit your opponent with an exploding",11,1,10
  341. DATA "banana by varying the angle and power of your throw, taking",11,-1,11
  342. DATA "into account wind speed, gravity, and the city skyline.",11,1,12
  343. DATA "The wind speed is shown by a directional arrow at the bottom",11,-1,14
  344. DATA "of the playing field, its length relative to its strength.",11,1,15
  345. DATA "Zero degrees is horizontal, towards your opponent, with 90 degrees",11,-1,16
  346. DATA "being vertically upwards, and so on. Angles can be from 0 to",11,1,17
  347. DATA "360 degrees and velocity can range from 1 to 200.",11,-1,18
  348. DATA "Press any key to continue...",15,1,20
  349. PartingMessage:
  350. DATA 1
  351. DATA "Thank you for playing Gorillas!",11,1,8
  352. 'Next number is the number of final phrases
  353. DATA 5
  354. DATA 1,"May the Schwarz be with you!",14,-1,14
  355. DATA 1,"Live long and prosper.",14,-1,14
  356. DATA 1,"Goodbye!",14,-1,14
  357. DATA 1,"So long!",14,-1,14
  358. DATA 1,"Adios!",14,-1,14
  359. Ready:
  360. DATA 1,"Prepare for battle!",12,1,1
  361. Setup:
  362. DATA 1,"Game Setup",14,-1,1
  363. GameOver:
  364. DATA 1,"Game Over!",14,-1,3
  365. Aborted:
  366. DATA 1,"Game aborted",12,-1,3
  367. NowWhat:
  368. DATA 1,"Now What?",14,1,1
  369.  
  370. VectorData:
  371. DATA 39
  372. DATA 0.582,0.988, 0.608,0.850, 0.663,0.788, 0.738,0.800
  373. DATA 0.863,0.838, 0.813,0.713, 0.819,0.650, 0.875,0.588
  374. DATA 1.000,0.563, 0.850,0.450, 0.825,0.400, 0.830,0.340
  375. DATA 0.925,0.238, 0.775,0.243, 0.694,0.225, 0.650,0.188, 0.630,0.105
  376. DATA 0.625,0.025, 0.535,0.150, 0.475,0.175, 0.425,0.150
  377. DATA 0.325,0.044, 0.325,0.150, 0.315,0.208, 0.288,0.250, 0.225,0.275
  378. DATA 0.053,0.288, 0.150,0.392, 0.175,0.463, 0.144,0.525
  379. DATA 0.025,0.638, 0.163,0.650, 0.225,0.693, 0.250,0.775
  380. DATA 0.225,0.905, 0.360,0.825, 0.450,0.823, 0.525,0.863
  381. DATA 0.582,0.988
  382.  
  383. REM $STATIC
  384. SUB AlertSnd
  385.  IF GSettings.useSound THEN PLAY ">>B10<<"
  386. END SUB
  387.  
  388. 'CalcDelay:
  389. '  Checks speed of the machine.
  390. FUNCTION CalcDelay#
  391.  
  392.   s# = TIMER
  393.   DO
  394.     i# = i# + 1
  395.   LOOP UNTIL TIMER - s# >= .5
  396.   CalcDelay# = i#
  397.  
  398. END FUNCTION
  399.  
  400. ' Center:
  401. '   Centers and prints a text string on a given row
  402. ' Parameters:
  403. '   Row - screen row number
  404. '   Text$ - text to be printed
  405. '
  406. SUB Center (Row, Text$)
  407.  
  408.  Col = MaxCol \ 2
  409.  LOCATE Row, Col - (LEN(Text$) / 2) + 1
  410.  PRINT Text$;
  411.  
  412. END SUB
  413.  
  414. SUB DoBeep
  415.   IF GSettings.useSound THEN PLAY "O2A24"
  416. END SUB
  417.  
  418. ' DoExplosion:
  419. '   Produces explosion when a shot is fired
  420. ' Parameters:
  421. '   x#, y# - location of explosion
  422. '
  423. SUB DoExplosion (x#, y#)
  424.  DIM radii(1 TO 4, 1 TO 2), colors(1 TO 4)
  425.  
  426.  IF GSettings.useOldExplosions THEN
  427.   IF GSettings.useSound THEN PLAY "MBO0L32EFGEFDC"
  428.   Radius = ScrHeight / 50
  429.   IF Mode = 9 THEN Inc# = .5 ELSE Inc# = .41
  430.   FOR c# = 0 TO Radius STEP Inc#
  431.     CIRCLE (x#, y#), c#, ExplosionColor
  432.   NEXT c#
  433.   FOR c# = Radius TO 0 STEP (-1 * Inc#)
  434.     CIRCLE (x#, y#), c#, BACKATTR
  435.     FOR i = 1 TO 100
  436.     NEXT i
  437.     Rest .005
  438.   NEXT c#
  439.  
  440.  ELSE
  441.   radii(1, 1) = GSettings.newExplosionRadius
  442.   radii(2, 1) = .9 * radii(1, 1)
  443.   radii(3, 1) = .6 * radii(1, 1)
  444.   radii(4, 1) = .45 * radii(1, 1)
  445.   FOR i = 1 TO 4
  446.    radii(i, 2) = .825 * radii(i, 1)
  447.   NEXT
  448.   colors(1) = 4: colors(2) = 2
  449.   colors(3) = 3: colors(4) = 9
  450.  
  451.   IF GSettings.useSound THEN PLAY "MBO0L32EFGEFDC"
  452.  
  453.   'þ Draw grey smoke, EGA/VGA only
  454.   IF Mode = 9 THEN
  455.    CIRCLE (x#, y#), 1.175 * radii(1, 1), 10
  456.    PAINT (x#, y#), 10, 10
  457.   ELSE
  458.    CIRCLE (x#, y#), 1.175 * radii(1, 1), 1
  459.    PAINT (x#, y#), 0, 1
  460.    CIRCLE (x#, y#), 1.175 * radii(1, 1), 0
  461.   END IF
  462.  
  463.   '? Draw vector explosion graphics
  464.   FOR i = 1 TO 4
  465.    Iwidth = 2 * radii(i, 1): Iheight = 2 * radii(i, 2)
  466.    locX = x# - radii(i, 1): locY = y# - radii(i, 2)
  467.    imageCol = colors(i)
  468.  
  469.    IF MachSpeed > 700 THEN
  470.     GOSUB DrawShape
  471.     Delay = .5
  472.    ELSE
  473.     CIRCLE (x#, y#), radii(i, 1), imageCol: PAINT (x#, y#), imageCol, imageCol
  474.     Delay = .9
  475.    END IF
  476.   NEXT
  477.  
  478.   timeStay! = TIMER: DO: LOOP UNTIL TIMER > timeStay! + .1
  479.  
  480.   CIRCLE (x#, y#), 1.175 * radii(1, 1), 0
  481.   PAINT (x#, y#), 0, 0
  482.  END IF
  483.  
  484. EXIT SUB
  485.  
  486. DrawShape:
  487.  RESTORE VectorData
  488.  READ noOfPoints, initX!, initY!
  489.  initX! = (initX! * Iwidth) + locX
  490.  initY! = (initY! * Iheight) + locY
  491.  FOR lVar = 1 TO noOfPoints - 1
  492.   READ toX!, toY!
  493.   toX! = (toX! * Iwidth) + locX
  494.   toY! = (toY! * Iheight) + locY
  495.   IF lVar = 1 THEN
  496.    LINE (initX!, initY!)-(toX!, toY!), imageCol
  497.   ELSE
  498.    LINE -(toX!, toY!), imageCol
  499.   END IF
  500.  NEXT
  501.  PAINT (locX + (Iwidth / 2), locY + (Iwidth / 2)), imageCol, imageCol
  502. RETURN
  503.  
  504. END SUB
  505.  
  506. ' DoShot:
  507. '   Controls banana shots by accepting player input and plotting
  508. '   shot angle
  509. ' Parameters:
  510. '   PlayerNum - Player
  511. '   x, y - Player's gorilla position
  512. '   turn - do not show zeroes at input prompts on first turn
  513. '
  514. FUNCTION DoShot (Player$(), PlayerNum, x, y, turn, othX, othY)
  515.  
  516.   'Input shot
  517.   IF PlayerNum = 1 THEN
  518.     LocateCol = 2
  519.   ELSE
  520.     IF Mode = 9 THEN
  521.       LocateCol = 67
  522.     ELSE
  523.       LocateCol = 26
  524.     END IF
  525.   END IF
  526.  
  527.   IF PlayerNum = 1 THEN
  528.     PrevA# = GLeftAngle#: PrevV# = GLeftVeloc
  529.   ELSE
  530.     IF PlayerNum = 2 THEN
  531.       PrevA# = GRightAngle#: PrevV# = GRightVeloc
  532.     END IF
  533.   END IF
  534.  
  535.   GAng$ = "": Velo$ = ""
  536.  
  537.   LOCATE 2, LocateCol + 3: PRINT "Angle:";
  538.   LOCATE 3, LocateCol: PRINT "Velocity:";
  539.   IF turn > 2 THEN
  540.     PRINT PrevV#
  541.     Pa$ = LTRIM$(STR$(PrevA#))
  542.     Pv$ = LTRIM$(STR$(PrevV#))
  543.   ELSE
  544.     Pa$ = "": Pv$ = ""
  545.   END IF
  546.  
  547.   WHILE INKEY$ <> "": WEND
  548.   DO: pass = 1
  549.    DO
  550.     GAng$ = GET$(2, LocateCol + 10, Pa$, 0, 360, 1)
  551.     IF GAng$ = "" THEN GOSUB AbortGame
  552.    LOOP UNTIL GAng$ <> ""
  553.    IF LEFT$(GAng$, 1) = "*" THEN GAng$ = RIGHT$(GAng$, LEN(GAng$) - 1)
  554.    angle# = VAL(GAng$)
  555.    
  556.    DO
  557.     Velo$ = GET$(3, LocateCol + 10, Pv$, 1, -200, 1)
  558.     IF Velo$ = "" THEN GOSUB AbortGame
  559.    LOOP UNTIL Velo$ <> ""
  560.    IF LEFT$(Velo$, 1) = "*" THEN
  561.     pass = 0: Velo$ = RIGHT$(Velo$, LEN(Velo$) - 1)
  562.     PrevA# = angle#
  563.     PrevV# = CINT(VAL(Velo$))
  564.     Pa$ = GAng$
  565.     Pv$ = Velo$
  566.    END IF
  567.    velocity = CINT(VAL(Velo$))
  568.   LOOP UNTIL pass = 1
  569.  
  570.   IF PlayerNum = 1 THEN
  571.    GLeftAngle# = angle#: GLeftVeloc = velocity
  572.   ELSE
  573.    IF PlayerNum = 2 THEN
  574.     GRightAngle# = angle#: GRightVeloc = velocity
  575.    END IF
  576.   END IF
  577.  
  578.   IF PlayerNum = 2 THEN
  579.    angle# = 180 - angle#
  580.   END IF
  581.  
  582.   'Erase input
  583.   FOR i = 1 TO 3 ' Was 4
  584.    'LOCATE i, 1
  585.    'PRINT SPACE$(30 \ (80 \ MaxCol));
  586.    'LOCATE i, (50 \ (80 \ MaxCol))
  587.    'PRINT SPACE$(30 \ (80 \ MaxCol));
  588.  
  589.    LOCATE i, 2: PRINT SPACE$(17)
  590.    LOCATE i, MaxCol - 17: PRINT SPACE$(17)
  591.   NEXT
  592.  
  593.   PlayerHit = PlotShot(x, y, angle#, velocity, PlayerNum, othX, othY)
  594.   IF PlayerHit = 0 THEN
  595.    DoShot = FALSE
  596.   ELSE
  597.    DoShot = TRUE
  598.    IF PlayerHit <> PlayerNum AND turn < 3 THEN
  599.     'þ Killed opponent in one shot message
  600.     tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .8
  601.     IF GSettings.useSound THEN PLAY "MFO2L24A+>DFA+FD<A+>DFA+FD<A+>DFA+FD<A+4MB"
  602.     COLOR 12
  603.     FOR msg = 1 TO 3
  604.      Center 1, "IN ONE THROW!": tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .25
  605.      Center 1, SPACE$(14): GOSUB DSRestoreSun: tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .25
  606.     NEXT
  607.    ELSE tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .9
  608.    END IF
  609.    IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum
  610.    VictoryDance PlayerNum
  611.   END IF
  612.  
  613. EXIT FUNCTION
  614.  
  615. AbortGame:
  616.  cont = FALSE: cval = 1: tpause! = TIMER - 2
  617.  IF Mode = 9 THEN COLOR 14
  618.  DO
  619.   IF TIMER > tpause! + .5 THEN
  620.    IF cval = 1 THEN
  621.     Center 1, " Abort game? [Y/N] "
  622.    ELSE
  623.     Center 1, SPACE$(19)
  624.     GOSUB DSRestoreSun
  625.    END IF
  626.  
  627.    cval = 2 / cval
  628.    tpause! = TIMER
  629.   END IF
  630.   resp$ = UCASE$(INKEY$)
  631.   IF resp$ = "Y" THEN cont = 1
  632.   IF resp$ = "N" THEN cont = 2
  633.  LOOP UNTIL NOT (cont = FALSE)
  634.  IF cont = 1 THEN
  635.   DoShot = 1: EXIT FUNCTION
  636.  ELSE
  637.   IF cval = 2 THEN Center 1, SPACE$(19): DoSun SUNHAPPY
  638.   IF Mode = 1 THEN GOSUB CGARestNames
  639.   IF Mode = 9 THEN COLOR 15
  640.   RETURN
  641.  END IF
  642. EXIT FUNCTION
  643.  
  644. DSRestoreSun:
  645.  sunX = ScrWidth \ 2: sunY = Scl(25)
  646.  LINE (sunX, sunY - Scl(15))-(sunX, sunY), SUNATTR
  647.  LINE (sunX - Scl(8), sunY - Scl(13))-(sunX, sunY), SUNATTR
  648.  LINE (sunX, sunY)-(sunX + Scl(8), sunY - Scl(13)), SUNATTR
  649. RETURN
  650.  
  651. CGARestNames:
  652.  REM Under CGA, the Abort Game prompt can overwrite player names
  653.  LOCATE 1, 2: PRINT Player$(1)
  654.  LOCATE 1, MaxCol - LEN(Player$(2)): PRINT Player$(2)
  655. RETURN
  656.  
  657. END FUNCTION
  658.  
  659. ' DoSun:
  660. '   Draws the sun at the top of the screen.
  661. ' Parameters:
  662. '   Mouth - If TRUE draws "O" mouth else draws a smile mouth.
  663. '
  664. SUB DoSun (Mouth)
  665.  
  666.   'set position of sun
  667.   x = ScrWidth \ 2: y = Scl(25)
  668.  
  669.   'clear old sun
  670.   LINE (x - Scl(22), y - Scl(18))-(x + Scl(22), y + Scl(18)), BACKATTR, BF
  671.  
  672.   'draw new sun:
  673.   'body
  674.   CIRCLE (x, y), Scl(12), SUNATTR
  675.   PAINT (x, y), SUNATTR
  676.  
  677.   'rays
  678.   LINE (x - Scl(20), y)-(x + Scl(20), y), SUNATTR
  679.   LINE (x, y - Scl(15))-(x, y + Scl(15)), SUNATTR
  680.  
  681.   LINE (x - Scl(15), y - Scl(10))-(x + Scl(15), y + Scl(10)), SUNATTR
  682.   LINE (x - Scl(15), y + Scl(10))-(x + Scl(15), y - Scl(10)), SUNATTR
  683.  
  684.   LINE (x - Scl(8), y - Scl(13))-(x + Scl(8), y + Scl(13)), SUNATTR
  685.   LINE (x - Scl(8), y + Scl(13))-(x + Scl(8), y - Scl(13)), SUNATTR
  686.  
  687.   LINE (x - Scl(18), y - Scl(5))-(x + Scl(18), y + Scl(5)), SUNATTR
  688.   LINE (x - Scl(18), y + Scl(5))-(x + Scl(18), y - Scl(5)), SUNATTR
  689.  
  690.   'mouth
  691.   IF Mouth THEN  'draw "o" mouth
  692.     CIRCLE (x, y + Scl(5)), Scl(2.9), 0
  693.     PAINT (x, y + Scl(5)), 0, 0
  694.   ELSE           'draw smile
  695.     CIRCLE (x, y), Scl(8), 0, (210 * pi# / 180), (330 * pi# / 180)
  696.   END IF
  697.  
  698.   'eyes
  699.   CIRCLE (x - 3, y - 2), 1, 0
  700.   CIRCLE (x + 3, y - 2), 1, 0
  701.   PSET (x - 3, y - 2), 0
  702.   PSET (x + 3, y - 2), 0
  703.  
  704. END SUB
  705.  
  706. 'DrawBan:
  707. '  Draws the banana
  708. 'Parameters:
  709. '  xc# - Horizontal Coordinate
  710. '  yc# - Vertical Coordinate
  711. '  r - rotation position (0-3). (  \_/  ) /-\
  712. '  bc - if TRUE then DrawBan draws the banana ELSE it erases the banana
  713. SUB DrawBan (xc#, yc#, r, bc)
  714.  
  715. SELECT CASE r
  716.   CASE 0
  717.     IF bc THEN PUT (xc#, yc#), LBan&, PSET ELSE PUT (xc#, yc#), LBan&, XOR
  718.   CASE 1
  719.     IF bc THEN PUT (xc#, yc#), UBan&, PSET ELSE PUT (xc#, yc#), UBan&, XOR
  720.   CASE 2
  721.     IF bc THEN PUT (xc#, yc#), DBan&, PSET ELSE PUT (xc#, yc#), DBan&, XOR
  722.   CASE 3
  723.     IF bc THEN PUT (xc#, yc#), RBan&, PSET ELSE PUT (xc#, yc#), RBan&, XOR
  724. END SELECT
  725.  
  726. END SUB
  727.  
  728. 'DrawGorilla:
  729. '  Draws the Gorilla in either CGA or EGA mode
  730. '  and saves the graphics data in an array.
  731. 'Parameters:
  732. '  x - x coordinate of gorilla
  733. '  y - y coordinate of the gorilla
  734. '  arms - either Left up, Right up, or both down
  735. SUB DrawGorilla (x, y, arms)
  736.   DIM i AS SINGLE   ' Local index must be single precision
  737.  
  738.   'draw head
  739.   LINE (x - Scl(4), y)-(x + Scl(2.9), y + Scl(6)), OBJECTCOLOR, BF
  740.   LINE (x - Scl(5), y + Scl(2))-(x + Scl(4), y + Scl(4)), OBJECTCOLOR, BF
  741.  
  742.   'draw eyes/brow
  743.   LINE (x - Scl(3), y + Scl(2))-(x + Scl(2), y + Scl(2)), 0
  744.  
  745.   'draw nose if ega
  746.   IF Mode = 9 THEN
  747.     FOR i = -2 TO -1
  748.       PSET (x + i, y + 4), 0
  749.       PSET (x + i + 3, y + 4), 0
  750.     NEXT i
  751.   END IF
  752.  
  753.   'neck
  754.   LINE (x - Scl(3), y + Scl(7))-(x + Scl(2), y + Scl(7)), OBJECTCOLOR
  755.  
  756.   'body
  757.   LINE (x - Scl(8), y + Scl(8))-(x + Scl(6.9), y + Scl(14)), OBJECTCOLOR, BF
  758.   LINE (x - Scl(6), y + Scl(15))-(x + Scl(4.9), y + Scl(20)), OBJECTCOLOR, BF
  759.  
  760.   'legs
  761.   FOR i = 0 TO 4
  762.     CIRCLE (x + Scl(i), y + Scl(25)), Scl(10), OBJECTCOLOR, 3 * pi# / 4, 9 * pi# / 8
  763.     CIRCLE (x + Scl(-6) + Scl(i - .1), y + Scl(25)), Scl(10), OBJECTCOLOR, 15 * pi# / 8, pi# / 4
  764.   NEXT
  765.  
  766.   'chest
  767.   CIRCLE (x - Scl(4.9), y + Scl(10)), Scl(4.9), 0, 3 * pi# / 2, 0
  768.   CIRCLE (x + Scl(4.9), y + Scl(10)), Scl(4.9), 0, pi#, 3 * pi# / 2
  769.  
  770.   FOR i = -5 TO -1
  771.     SELECT CASE arms
  772.       CASE 1
  773.         'Right arm up
  774.         CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
  775.         CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(4)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
  776.         GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorR&
  777.       CASE 2
  778.         'Left arm up
  779.         CIRCLE (x + Scl(i - .1), y + Scl(4)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
  780.         CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
  781.         GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorL&
  782.       CASE 3
  783.         'Both arms down
  784.         CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
  785.         CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
  786.         GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorD&
  787.     END SELECT
  788.   NEXT i
  789. END SUB
  790.  
  791. 'ExplodeGorilla:
  792. '  Causes gorilla explosion when a direct hit occurs
  793. 'Parameters:
  794. '  X#, Y# - shot location
  795. SUB ExplodeGorilla (x#, y#, PlayerHit)
  796.   YAdj = Scl(12)
  797.   XAdj = Scl(5)
  798.   SclX# = ScrWidth / 320
  799.   SclY# = ScrHeight / 200
  800.  
  801.   IF GSettings.useSound THEN PLAY "MBO0L16EFGEFDC"
  802.  
  803.   FOR i = 1 TO 16 * SclX#
  804.    CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57
  805.   NEXT i
  806.  
  807.   timeStay! = TIMER: DO: LOOP UNTIL TIMER > timeStay! + .05
  808.  
  809.   FOR i = 24 * SclX# TO 1 STEP -1
  810.     CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, BACKATTR, , , -1.57
  811.     FOR count = 1 TO 200
  812.     NEXT
  813.   NEXT i
  814.  
  815. END SUB
  816.  
  817. SUB Extro
  818.  
  819.  COLOR 7: CLS
  820.  
  821.  RESTORE PartingMessage
  822.  Slidy
  823.  READ num
  824.  num = CINT(RND * (num - 1))
  825.  IF num > 0 THEN FOR l = 1 TO num: READ pnum, pmsg$, pnum, pnum, pnum: NEXT
  826.  Slidy
  827.  
  828.  t! = TIMER: DO: LOOP UNTIL TIMER > t! + 3.8 OR INKEY$ <> ""
  829.  
  830. END SUB
  831.  
  832. FUNCTION GET$ (Row, Col, Prev$, Typ, Max, Esc)
  833.  
  834.  ' Row,Col : position
  835.  ' Prev$ : the previous value of the number or string.
  836.  ' Typ : the type of input required: TRUE for string, FALSE for numeric
  837.  '       and 1 for numerical, tabbable while empty
  838.  ' Max : the maximum number of characters for string or the maximum
  839.  ' value for numeric. For numeric, a negative maximum means that the minimum
  840.  ' value is to be one not zero and the maximum value is the absolute value
  841.  ' of Max.
  842.  ' Esc : TRUE if Escape key permitted, FALSE if not permitted, 1 if Escape
  843.  ' clears input rather then undoes
  844.  
  845.  SpecTab = 0: IF Typ = 1 THEN Typ = FALSE: SpecTab = 1
  846.  IF NOT Typ THEN
  847.    IF Max < 0 THEN Zero = 0 ELSE Zero = -1
  848.    Max = ABS(Max)
  849.  END IF
  850.  
  851.  Hold$ = Prev$
  852.  cont = 0: Lett$ = "": Curs = 0: Timo! = 0
  853.  Valid$ = "1234567890" + CHR$(8) + CHR$(9) + CHR$(13) + CHR$(27)
  854.  IF Typ THEN Valid$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ- .'!" + Valid$
  855.  LOCATE Row, Col:
  856.  IF Typ THEN
  857.    Bck = Max - LEN(Hold$) + 1
  858.  ELSE
  859.    Bck = LEN(STR$(Max)) - LEN(Hold$)
  860.  END IF
  861.  PRINT Hold$; SPC(Bck);
  862.  
  863.  DO
  864.    DO
  865.      Timo! = TIMER: Curs = 0: LOCATE Row, Col + LEN(Hold$): IF LEN(Hold$) = Max THEN PRINT "Û" ELSE PRINT "_"
  866.      DO: LOOP UNTIL INKEY$ = ""
  867.      DO
  868.        IF TIMER > Timo! + .5 THEN
  869.          LOCATE Row, Col + LEN(Hold$)
  870.          IF Curs <> 1 THEN
  871.           PRINT " "
  872.          ELSE
  873.           IF Typ AND LEN(Hold$) = Max THEN PRINT "Û" ELSE PRINT "_"
  874.          END IF
  875.          Curs = 1 - Curs
  876.          Timo! = TIMER
  877.        END IF
  878.        Lett$ = INKEY$
  879.      LOOP UNTIL Lett$ <> ""
  880.      LOCATE Row, Col + LEN(Hold$): PRINT " "
  881.      Intra = INSTR(Valid$, UCASE$(Lett$))
  882.      IF Lett$ = CHR$(0) + CHR$(83) THEN Intra = 50 ' DEL key
  883.      IF Intra = 0 THEN DoBeep: DO: LOOP UNTIL INKEY$ = ""
  884.    LOOP UNTIL Intra > 0
  885.  
  886.    SELECT CASE Intra
  887.  
  888.      CASE 50
  889.      'þ DELETE key
  890.        LOCATE Row, Col: PRINT STRING$(LEN(Hold$), " ");
  891.        Hold$ = ""
  892.  
  893.      CASE 1 TO LEN(Valid$) - 4 'þ Letter, number or symbol
  894.      'þ Numeric field
  895.       IF NOT Typ THEN 'þ Number
  896.        IF NOT ((Lett$ = "0" AND (NOT Zero AND Hold$ = "")) OR Hold$ = "0") THEN
  897.         IF VAL(Hold$ + Lett$) <= Max THEN
  898.          Hold$ = Hold$ + Lett$
  899.          LOCATE Row, Col: PRINT Hold$
  900.         ELSE DoBeep
  901.         END IF
  902.        ELSE DoBeep
  903.        END IF
  904.       ELSE 'þ Text field
  905.        IF LEN(Hold$) < Max THEN
  906.         Hold$ = Hold$ + Lett$
  907.         LOCATE Row, Col: PRINT Hold$
  908.        ELSE DoBeep
  909.        END IF
  910.       END IF
  911.  
  912.      CASE LEN(Valid$) - 3
  913.      'þ BACKSPACE key
  914.       IF LEN(Hold$) > 0 THEN
  915.        Hold$ = LEFT$(Hold$, LEN(Hold$) - 1)
  916.        LOCATE Row, Col: PRINT Hold$; " ";
  917.       ELSE DoBeep
  918.       END IF
  919.                        
  920.      CASE LEN(Valid$) - 2
  921.      'þ TAB key
  922.        IF (LEN(Hold$) > 0 AND NOT Typ) OR SpecTab = 1 THEN Hold$ = "*" + Hold$: cont = 1 ELSE DoBeep
  923.  
  924.      CASE LEN(Valid$) - 1
  925.      'þ RETURN key
  926.        IF LEN(Hold$) > 0 THEN cont = 1 ELSE DoBeep
  927.  
  928.      CASE LEN(Valid$)
  929.      'þ ESCAPE key
  930.        IF Esc = TRUE THEN Hold$ = Prev$: cont = 1
  931.        IF Esc = 1 THEN Hold$ = "": cont = 1
  932.  
  933.    END SELECT
  934.    DO: LOOP UNTIL INKEY$ = ""
  935.  
  936.  LOOP UNTIL cont = 1
  937.  
  938. GET$ = Hold$
  939. END FUNCTION
  940.  
  941. 'GetInputs:
  942. '  Gets competing players and game configuration play at beginning of game
  943. '  and manages players list
  944. 'Parameters:
  945. '  Player$() - player names
  946. '  NumGames - number of games to play
  947. '  P - number of stored players
  948. SUB GetInputs (Player$(), NumGames, P)
  949.  
  950. ' Lay out screen
  951.  
  952.  CLS : RESTORE Setup: Slidy: COLOR 2: LOCATE 2, 1: PRINT STRING$(80, "Í") 'þ Show screen title
  953.  active = 0: FOR fld = 1 TO 4: GOSUB SetupFields: NEXT 'þ Display fields
  954.  fld = 0: GOSUB SetupFields 'þ Display player names
  955.  
  956. ' Fill in players box
  957.  
  958.  cStat = 0: FOR N = 1 TO P: GOSUB Curs: NEXT
  959.  'þ Must highlight opponent player (normally done after [ENTER] or [TAB]
  960.  IF PDefs(2) > 0 THEN N = PDefs(2): cStat = 2: GOSUB Curs
  961.  
  962. ' Process fields loop
  963.   ' complete: ready to start the game
  964.   ' fld: which field is being processed
  965.   ' numG$: text field to hold number of games
  966.   ' grav$: text field to hold gravity
  967.  
  968.  complete = 0: fld = 1: numG$ = LTRIM$(STR$(NumGames)): grav$ = LTRIM$(STR$(Gravity))
  969.  DO
  970.   'þ Highlight current field if there are enough players. Player field not
  971.   '  highlighted until there is a player which can be assigned to it, and the
  972.   '  last two fields are unselectable unless there are enough players
  973.   active = 1: IF P >= 2 THEN GOSUB SetupFields
  974.  
  975.   SELECT CASE fld
  976.    CASE 1 TO 2
  977.     GOSUB ManagePlayers
  978.    CASE IS = 3
  979.     GOSUB Rounds
  980.    CASE IS = 4
  981.     GOSUB Gravity
  982.   END SELECT
  983.   active = 0: GOSUB SetupFields 'þ Unhighlight current field
  984.   IF NOT complete THEN fld = fld + 1: IF fld = 5 THEN fld = 1
  985.   IF complete AND (PDefs(1) = 0 OR PDefs(2) = 0) THEN fld = 1: complete = 0
  986.  LOOP UNTIL complete
  987.  
  988. Player$(1) = RTRIM$(PDat(PDefs(1)).PNam)
  989. Player$(2) = RTRIM$(PDat(PDefs(2)).PNam)
  990. NumGames = VAL(numG$)
  991. Gravity = VAL(grav$)
  992.  
  993. 'þ Clear most of the screen
  994. COLOR , 0: FOR l = 3 TO 24: LOCATE l, 1: PRINT STRING$(80, " "); : NEXT
  995.  
  996. EXIT SUB
  997.  
  998. 'þþþþþþþþþþþþþþþþþþþþ
  999. 'þ FIELDS SUBROUTINES
  1000.  
  1001. ManagePlayers:
  1002.  cre = 0
  1003.  WHILE P < 2 'þ Ensure enough players for the game (only used before league table created)
  1004.   cre = 1: GOSUB CreatePlayer
  1005.   IF P = 2 THEN GOSUB SetupFields 'þ Finally ready to highlight Player field
  1006.  WEND
  1007.  cre = 0
  1008.  
  1009.  'þ OK. Assuming that there are enough players to select.
  1010.  opp = 2 / fld 'þ PDefs array number of opposite player
  1011.  ShowPrompts fld
  1012.  IF PDefs(fld) > 0 THEN 'þ Put cursor bar on currently selected player
  1013.   x = ((PDefs(fld) - 1) MOD 4) + 1: y = INT((PDefs(fld) - 1) / 4) + 1
  1014.  ELSE                   'þ Otherwise choose free player
  1015.   IF PDefs(opp) <> 1 THEN
  1016.    x = 1: y = 1
  1017.   ELSE
  1018.    'IF PDefs(opp) = 1 AND P > 1 THEN
  1019.    x = 2: y = 1
  1020.   END IF
  1021.  END IF
  1022.  
  1023.  finished = 0: mov = 0: IF P > 1 THEN mov = 1
  1024.  DO
  1025.  defSwap = 0 'þ Flag for player definition swapping
  1026.   N = (y - 1) * 4 + x 'þ Convert cursor bar position into player number
  1027.   LOCATE 8 + (fld * 2 - 2), 22
  1028.   'þ Do not display player name if it is taken and swap is not permitted
  1029.   IF NOT ((PDefs(fld) = 0 OR PDefs(opp) = 0) AND PDefs(opp) = N) THEN
  1030.    COLOR 2, 0: PRINT PDat(N).PNam;
  1031.   ELSE
  1032.    COLOR 12, 0: PRINT "Can't have.      "
  1033.   END IF
  1034.   IF (PDefs(opp)) = N AND PDefs(fld) > 0 THEN
  1035.    LOCATE 8 + (opp * 2 - 2), 23 + LEN(RTRIM$(PDat(PDefs(opp)).PNam))
  1036.    COLOR 2, 0: PRINT "("; CHR$(26); " "; RTRIM$(PDat(PDefs(fld)).PNam); ")";
  1037.   COLOR 2: LOCATE 7, 3: PRINT "": COLOR 9: LOCATE 7, 5
  1038.    PRINT "Pressing [ENTER] now will switch the players over."
  1039.    defSwap = 1
  1040.   END IF
  1041.   IF mov = 1 THEN cur = 1: GOSUB Move
  1042.   DO
  1043.    KEY$ = INKEY$
  1044.   LOOP UNTIL KEY$ <> ""
  1045.   COLOR 1, 0
  1046.   IF defSwap = 1 THEN
  1047.    LOCATE 8 + (opp * 2 - 2), 23 + LEN(RTRIM$(PDat(PDefs(opp)).PNam))
  1048.    PRINT STRING$(21, " ")
  1049.    LOCATE 7, 3: PRINT STRING$(52, " ")
  1050.   END IF
  1051.  
  1052.   'þ Move cursor bar, manipulate players, and select a player to compete
  1053.   SELECT CASE UCASE$(KEY$)
  1054.    CASE CHR$(0) + CHR$(72)
  1055.     IF y > 1 THEN cur = 0: GOSUB Move: y = y - 1: mov = 1 ELSE AlertSnd
  1056.    CASE CHR$(0) + CHR$(80)
  1057.     IF (y * 4 + x) <= P THEN cur = 0: GOSUB Move: y = y + 1: mov = 1 ELSE AlertSnd
  1058.    CASE CHR$(0) + CHR$(75)
  1059.     IF x > 1 THEN
  1060.      cur = 0: GOSUB Move: x = x - 1: mov = 1
  1061.     ELSE
  1062.      IF y > 1 THEN
  1063.       cur = 0: GOSUB Move: mov = 1: x = 4: y = y - 1
  1064.      ELSE
  1065.       AlertSnd
  1066.      END IF
  1067.     END IF
  1068.    CASE CHR$(0) + CHR$(77)
  1069.     IF x < 4 AND ((y - 1) * 4 + (x + 1)) <= P THEN
  1070.      cur = 0: GOSUB Move: x = x + 1: mov = 1
  1071.     ELSE
  1072.      IF (y * 4 + 1) <= P THEN
  1073.       cur = 0: GOSUB Move: mov = 1: x = 1: y = y + 1
  1074.      ELSE
  1075.       AlertSnd
  1076.      END IF
  1077.     END IF
  1078.    CASE CHR$(9), CHR$(13)
  1079.     IF KEY$ = CHR$(13) THEN 'þ Only update player defs if ENTER pressed
  1080.      IF PDefs(opp) = N AND PDefs(fld) > 0 THEN
  1081.       'þ Swap player definitions
  1082.       SWAP PDefs(1), PDefs(2): COLOR , 0: finished = 1
  1083.       cStat = 2: GOSUB Curs
  1084.       IF fld = 2 THEN N = PDefs(opp): GOSUB Curs
  1085.      ELSEIF PDefs(opp) <> N THEN
  1086.       'þ Define player
  1087.       IF PDefs(fld) <> N THEN 'þ Remove green highlight and define PDefs
  1088.        IF PDefs(fld) > 0 THEN Nt = N: N = PDefs(fld): cStat = 0: GOSUB Curs: N = Nt
  1089.        PDefs(fld) = N
  1090.       END IF
  1091.       finished = 1
  1092.       cStat = 2: GOSUB Curs
  1093.      ELSE
  1094.       AlertSnd
  1095.      END IF
  1096.     ELSE
  1097.      IF PDefs(fld) > 0 THEN
  1098.       'þ Abort change to definition, and move to next field
  1099.       finished = 1
  1100.       cur = 0: GOSUB Move 'þ Remove cursor bar
  1101.       N = PDefs(fld): cStat = 2: GOSUB Curs 'þ Red highlight
  1102.      ELSEIF PDefs(fld) = 0 AND PDefs(opp) <> N THEN
  1103.       'þ Player undefined, so define it
  1104.       PDefs(fld) = N: finished = 1
  1105.       cStat = 2: GOSUB Curs
  1106.      ELSE
  1107.       AlertSnd
  1108.      END IF
  1109.     END IF
  1110.     IF finished = 1 THEN
  1111.      LOCATE 8 + (fld * 2 - 2), 22: COLOR 10, 0: PRINT PDat(PDefs(fld)).PNam;
  1112.      IF defSwap = 1 THEN LOCATE 8 + (opp * 2 - 2), 22: PRINT PDat(PDefs(opp)).PNam;
  1113.     END IF
  1114.    CASE "N"
  1115.     GOSUB CreatePlayer
  1116.    CASE "R"
  1117.     GOSUB RenamePlayer
  1118.    CASE CHR$(0) + CHR$(83)
  1119.     GOSUB DeletePlayer
  1120.    CASE ELSE
  1121.     'þ Incorrect key pressed
  1122.     AlertSnd
  1123.   END SELECT
  1124.  
  1125.  'Player chosen
  1126.  LOOP UNTIL finished
  1127.  
  1128. RETURN
  1129.        
  1130. CreatePlayer:
  1131.  IF P < NPLAYERS THEN
  1132.   IF cre = 1 THEN ShowPrompts -12 ELSE ShowPrompts 12
  1133.   nx = WhereX(P + 1): ny = WhereY(P + 1)
  1134.   cStat = 0: GOSUB Curs: COLOR 10, 1
  1135.   PDat(P + 1).PNam = " "
  1136.   DO: cont = 1
  1137.    IF P < 2 THEN Esc = FALSE ELSE Esc = TRUE 'þ Prevent ESCAPE key when players not yet created
  1138.    PDat(P + 1).PNam = RTRIM$(GET$(ny, nx, RTRIM$(PDat(P + 1).PNam), -1, 17, Esc))
  1139.  
  1140.    IF LTRIM$(PDat(P + 1).PNam) = "" THEN
  1141.     cont = 2
  1142.    ELSE
  1143.     FOR inl = 1 TO P
  1144.      IF PDat(inl).PNam = PDat(P + 1).PNam THEN AlertSnd: cont = 0
  1145.     NEXT
  1146.    END IF
  1147.   LOOP UNTIL cont > 0
  1148.   IF cont = 1 THEN
  1149.    P = P + 1: DoBeep: x = ((P - 1) MOD 4) + 1: y = INT((P - 1) / 4) + 1
  1150.    IF P > 1 THEN N = P - 1: cur = 0: GOSUB Move
  1151.    N = (y - 1) * 4 + x: cStat = 0: GOSUB Curs
  1152.   ELSEIF cont = 2 THEN
  1153.    Nt = N: N = P + 1: cStat = 0: GOSUB Curs
  1154.    N = Nt: GOSUB Move
  1155.   END IF
  1156.   ShowPrompts fld
  1157.  ELSE
  1158.   AlertSnd
  1159.  END IF
  1160. RETURN
  1161.  
  1162. RenamePlayer:
  1163.  ShowPrompts 13
  1164.  nx = WhereX(P + 1): ny = WhereY(P + 1)
  1165.  cStat = 0: GOSUB Curs: COLOR 10, 1
  1166.  DO: cont = 1: count = 0
  1167.   PDat(N).PNam = GET$(WhereY(N), WhereX(N), RTRIM$(PDat(N).PNam), -1, 17, TRUE)
  1168.   IF LEFT$(PDat(N).PNam, 1) = "*" THEN PDat(N).PNam = RIGHT$(PDat(N).PNam, LEN(PDat(N).PNam) - 1)
  1169.   FOR inl = 1 TO P
  1170.    IF PDat(inl).PNam = PDat(N).PNam THEN count = count + 1
  1171.   NEXT: IF count > 1 THEN AlertSnd: cont = 0
  1172.  LOOP UNTIL cont = 1: DoBeep
  1173.  cStat = 1: GOSUB Curs: ShowPrompts fld: upd = 0
  1174.  IF PDefs(1) = N THEN
  1175.   upd = 1
  1176.  ELSEIF PDefs(2) = N THEN
  1177.   upd = 2
  1178.  END IF
  1179.  IF upd > 0 THEN
  1180.   COLOR 10, 0: LOCATE 8 + (upd * 2 - 2), 22
  1181.   PRINT PDat(PDefs(upd)).PNam;
  1182.  END IF
  1183. RETURN
  1184.  
  1185. DeletePlayer:
  1186.  'þ What to do after the delete
  1187.  nextAction = 0
  1188.  IF N = PDefs(opp) THEN 'þ Opposite player redefined
  1189.   IF NOT (fld = 1 AND P > 2) THEN 'þ But not in this situation
  1190.    nextAction = 1
  1191.   END IF
  1192.  END IF
  1193.  
  1194.  IF PDefs(fld) > 0 THEN COLOR 10, 0: LOCATE 8 + (fld * 2 - 2), 22: PRINT PDat(PDefs(fld)).PNam;
  1195.  COLOR 0, 0
  1196.  FOR l = 3 TO 7: LOCATE l, 1: PRINT STRING$(80, " "); : NEXT
  1197.  ShowPrompts 11
  1198.  LOCATE 3, 3: COLOR 4
  1199.  PRINT "Do you want to delete the player `" + RTRIM$(PDat(N).PNam) + "'?"
  1200.  BEEP: DO: DO
  1201.   i$ = INKEY$
  1202.  LOOP UNTIL i$ <> "": i$ = UCASE$(i$): LOOP UNTIL i$ = "Y" OR i$ = "N"
  1203.  COLOR 0, 0: LOCATE 3: PRINT STRING$(80, " ")
  1204.  IF i$ = "Y" THEN
  1205.   'þ Corrects PDefs (selected players) values and display
  1206.   IF fld = 2 AND PDefs(fld) = 0 AND N = PDefs(opp) THEN
  1207.    COLOR 8, 0: LOCATE 10, 22
  1208.    PRINT "<undefined>      ";
  1209.   END IF
  1210.  
  1211.   FOR upd = 1 TO 2
  1212.    IF PDefs(upd) = N THEN
  1213.     COLOR 8, 0: LOCATE 8 + (upd * 2 - 2), 22
  1214.     PRINT "<undefined>      ";
  1215.     PDefs(upd) = 0
  1216.    ELSEIF PDefs(upd) > N THEN
  1217.     PDefs(upd) = PDefs(upd) - 1
  1218.    END IF
  1219.   NEXT
  1220.  
  1221.   IF P = 2 AND PDefs(fld) = 0 AND PDefs(opp) > 0 THEN
  1222.    COLOR 8, 0: LOCATE 8 + (fld * 2 - 2), 22
  1223.    PRINT "<undefined>      ";
  1224.   END IF
  1225.  
  1226.  
  1227.   'þ Tidies up PDat (array of players)
  1228.   Pt = P: P = P - 1: Nt = N
  1229.   IF N < Pt THEN
  1230.    FOR N = N TO P
  1231.     PDat(N).PNam = PDat(N + 1).PNam
  1232.     PDat(N).Rounds = PDat(N + 1).Rounds
  1233.     PDat(N).Won = PDat(N + 1).Won
  1234.     PDat(N).Accu = PDat(N + 1).Accu
  1235.     IF PDefs(2 * (1 / fld)) = N THEN cStat = 2 ELSE cStat = 0
  1236.     GOSUB Curs
  1237.    NEXT
  1238.   END IF
  1239.  
  1240.   'þ This wipes all trace of the deleted player
  1241.   PDat(Pt).Won = 0
  1242.   PDat(Pt).PNam = "": PDat(Pt).Accu = 0: PDat(Pt).Rounds = 0
  1243.      
  1244.   N = Pt: cStat = 0: GOSUB Curs
  1245.   N = Nt
  1246.   IF N > P THEN
  1247.    N = N - 1: x = x - 1: IF x = 0 THEN x = 1: y = y - 1: IF y = 0 THEN y = 1
  1248.   END IF
  1249.   IF P > 0 THEN ShowPrompts fld
  1250.  
  1251.   IF nextAction > 0 THEN
  1252.    cStat = 0: GOSUB Curs 'þ Remove cursor bar
  1253.   END IF
  1254.  
  1255.   IF PDefs(fld) > 0 THEN
  1256.    x = ((PDefs(fld) - 1) MOD 4) + 1: y = INT((PDefs(fld) - 1) / 4) + 1
  1257.   ELSEIF N = PDefs(opp) THEN
  1258.    IF N > 1 THEN
  1259.     x = x - 1: IF x = 0 THEN y = y - 1: x = 4 'þ Back one player
  1260.    ELSEIF N < P THEN
  1261.     x = x + 1: IF x = 5 THEN y = y + 1: x = 1 'þ Fwd one player
  1262.    END IF
  1263.   END IF
  1264.  
  1265.   IF nextAction = 1 THEN
  1266.    active = 0: GOSUB SetupFields
  1267.    SWAP fld, opp: active = 1: GOSUB SetupFields
  1268.   END IF
  1269.  
  1270.   'þ Ensure always 2 players minimum
  1271.   IF P = 1 THEN cre = 1: GOSUB CreatePlayer: cre = 0
  1272.  
  1273.  ELSE
  1274.   ShowPrompts fld
  1275.  END IF
  1276.  
  1277. RETURN
  1278.  
  1279. Rounds:
  1280.  ShowPrompts 3
  1281.  COLOR 15, 9: numG$ = GET$(20, 51, numG$, 0, -99, FALSE): COLOR 15, 0
  1282.  IF LEFT$(numG$, 1) = "*" THEN numG$ = RIGHT$(numG$, LEN(numG$) - 1)
  1283.  LOCATE 20, 51: PRINT numG$; SPC(3 - LEN(numG$));
  1284. RETURN
  1285.  
  1286. Gravity:
  1287.  ShowPrompts 4
  1288.  COLOR 15, 9: grav$ = GET$(22, 51, grav$, 0, -99, FALSE): COLOR 15, 0
  1289.  IF LEFT$(grav$, 1) = "*" THEN grav$ = RIGHT$(grav$, LEN(grav$) - 1) ELSE complete = 1
  1290.  LOCATE 22, 51: PRINT grav$; SPC(4 - LEN(grav$));
  1291. RETURN
  1292.  
  1293. 'þþþþþþþþþþþþþþþþþþþþþ
  1294. 'þ SUPPORT SUBROUTINES
  1295.  
  1296. ' field display
  1297.  
  1298. SetupFields:
  1299.  IF fld = 1 AND active THEN GOSUB DrawBox
  1300.  IF fld = 2 AND NOT active THEN GOSUB DrawBox
  1301.  IF active THEN COLOR 15 ELSE COLOR 8
  1302.  SELECT CASE fld
  1303.   CASE IS = 0
  1304.    FOR upd = 1 TO 2
  1305.     LOCATE 8 + (upd * 2 - 2), 22
  1306.     IF PDefs(upd) > 0 THEN
  1307.      COLOR 10, 0: PRINT PDat(PDefs(upd)).PNam;
  1308.     ELSE
  1309.      COLOR 8, 0: PRINT "<undefined>"
  1310.     END IF
  1311.    NEXT
  1312.   CASE IS = 1
  1313.    LOCATE 8, 11: PRINT "Player 1 ="
  1314.   CASE IS = 2
  1315.    LOCATE 10, 11: PRINT "Player 2 ="
  1316.   CASE IS = 3
  1317.    tStr$ = "Maximum rounds? (1 - 99, Default =" + STR$(GSettings.defaultRoundQty) + "):"
  1318.    LOCATE 20, 50 - LEN(tStr$): PRINT tStr$
  1319.   CASE IS = 4
  1320.    LOCATE 22, 13: PRINT "Gravity in m/sý (1 - 99, Earth = 10):"
  1321.  END SELECT
  1322. RETURN
  1323.  
  1324. DrawBox:
  1325.  COLOR 2, 0
  1326.  IF active THEN
  1327.   LOCATE 12, 1: PRINT "É"; STRING$(78, "Í"); "»";
  1328.   LOCATE 18, 1: PRINT "È"; STRING$(78, "Í"); "¼";
  1329.   FOR l = 13 TO 17: LOCATE l, 1: PRINT "º"; : LOCATE l, 80: PRINT "º"; : NEXT
  1330.  ELSE
  1331.   LOCATE 12, 1: PRINT "Ú"; STRING$(78, "Ä"); "¿";
  1332.   LOCATE 18, 1: PRINT "À"; STRING$(78, "Ä"); "Ù";
  1333.   FOR l = 13 TO 17: LOCATE l, 1: PRINT "³"; : LOCATE l, 80: PRINT "³"; : NEXT
  1334.  END IF
  1335. RETURN
  1336.  
  1337. ' cursor display
  1338.  
  1339. Move: 'þ Displays or removes cursor bar, calculating highlight colour
  1340.  which = 1
  1341.  IF PDefs(2 / fld) = N THEN which = 0
  1342.  IF PDefs(fld) = N THEN which = 2
  1343.  SELECT CASE cur 'þ Blue (1) or black (0) background
  1344.   CASE 1
  1345.    IF which = 1 THEN
  1346.     cStat = 1: GOSUB Curs
  1347.    ELSEIF which = 0 THEN
  1348.     cStat = 3: GOSUB Curs
  1349.    ELSE
  1350.     cStat = 5: GOSUB Curs
  1351.    END IF
  1352.   CASE 0
  1353.    IF which = 1 THEN
  1354.     cStat = 0: GOSUB Curs
  1355.    ELSEIF which = 0 THEN
  1356.     cStat = 2: GOSUB Curs
  1357.    ELSE
  1358.     cStat = 4: GOSUB Curs
  1359.    END IF
  1360.  END SELECT
  1361. RETURN
  1362.  
  1363. Curs: 'þ Displays or removes cursor bar, being told the highlight colour
  1364.  SELECT CASE cStat
  1365.   CASE 0
  1366.    COLOR 15, 0
  1367.   CASE 1
  1368.    COLOR 11, 1
  1369.   CASE 2
  1370.    COLOR 4, 0
  1371.   CASE 3
  1372.    COLOR 4, 1
  1373.   CASE 4
  1374.    COLOR 2, 0
  1375.   CASE 5
  1376.    COLOR 2, 1
  1377.  END SELECT
  1378.  LOCATE WhereY(N), WhereX(N): PRINT RTRIM$(PDat(N).PNam);
  1379.  IF N < P THEN
  1380.   PRINT ",";
  1381.  ELSEIF N = P THEN
  1382.   PRINT ".";
  1383.  ELSE
  1384.   PRINT " ";
  1385.  END IF
  1386.  PRINT SPC(17 - LEN(RTRIM$(PDat(N).PNam)));
  1387. RETURN
  1388.  
  1389. END SUB
  1390.  
  1391. 'GorillaIntro:
  1392. '  Displays gorillas on screen for the first time
  1393. '  allows the graphical data to be put into an array
  1394. 'Parameters:
  1395. '  Player$() - The names of the players
  1396. '  cIntro - Is introduction compulsory? (Yes for first ever game)
  1397. '
  1398. SUB GorillaIntro (Player$(), cIntro)
  1399.   IF cIntro = 1 THEN 'þ cIntro = 0 means introduction compulsory
  1400.    CLS
  1401.    LOCATE 1, 36: PRINT STRING$(10, " ")
  1402.    RESTORE Ready: Slidy
  1403.    COLOR 2: LOCATE 15, 31: PRINT "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
  1404.    COLOR 9: LOCATE 17, 34: PRINT "= View Intro"
  1405.    LOCATE 18, 34: PRINT "= Play Game"
  1406.    LOCATE 19, 34: PRINT "= Quit Gorillas"
  1407.    LOCATE 21, 34: PRINT "Your Choice?"
  1408.    COLOR 12: LOCATE 17, 32: PRINT "V": LOCATE 18, 32: PRINT "P"
  1409.    LOCATE 19, 32: PRINT "Q"
  1410.    DO
  1411.     Char$ = UCASE$(INKEY$)
  1412.    LOOP UNTIL Char$ <> "" AND INSTR("QVP", Char$)
  1413.    IF Char$ = "V" THEN cIntro = 0
  1414.    IF Char$ = "Q" THEN
  1415.     IF GamePlayedYN = 1 THEN Extro
  1416.     COLOR 7: CLS : SYSTEM
  1417.    END IF
  1418.   END IF
  1419.  
  1420.   IF Mode = 1 THEN
  1421.     x = 125
  1422.     y = 100
  1423.   ELSE
  1424.     x = 286
  1425.     y = 175
  1426.   END IF
  1427.  
  1428.   SCREEN Mode
  1429.   SetScreen
  1430.   IF Mode = 1 THEN
  1431.    MaxCol = 40
  1432.    Center 5, "Please wait while gorillas are drawn."
  1433.   END IF
  1434.  
  1435.   VIEW PRINT 9 TO 24
  1436.  
  1437.   IF Mode = 9 THEN PALETTE OBJECTCOLOR, BackColor
  1438.  
  1439.   DrawGorilla x, y, ARMSDOWN
  1440.   CLS 2
  1441.   DrawGorilla x, y, LEFTUP
  1442.   CLS 2
  1443.   DrawGorilla x, y, RIGHTUP
  1444.   CLS 2
  1445.  
  1446.   IF Mode = 1 THEN CLS ' For some reason, the above CLS 2s don't work in CGA
  1447.  
  1448.   VIEW PRINT 1 TO 25
  1449.   IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46
  1450.  
  1451.   IF cIntro = 0 THEN
  1452.     IF Mode = 9 THEN
  1453.       Rad! = 100: yStep! = 1: DO
  1454.         CIRCLE (319, 190), Rad!, 8, , , .5
  1455.         CIRCLE (319, 187), Rad!, 11, , , .5
  1456.         Rad! = Rad! + yStep!: yStep! = yStep! * 1.1
  1457.       LOOP UNTIL 320 + Rad! >= 640
  1458.       PAINT (0, 0), 8, 11
  1459.       LINE (142, 20)-(491, 20), 3
  1460.       LINE (491, 20)-(491, 95), 3
  1461.       LINE (491, 95)-(317, 156), 3
  1462.       LINE (317, 156)-(142, 95), 3
  1463.       LINE (142, 95)-(142, 20), 3
  1464.       PAINT (317, 40), 0, 3
  1465.     END IF
  1466.  
  1467.     IF Mode = 9 THEN COLOR 11
  1468.     Center 2, " QBasic G O R I L L A S "
  1469.     IF Mode = 9 THEN COLOR 9
  1470.     Center 4, "STARRING:"
  1471.     P$ = player$(1) + " AND " + player$(2)
  1472.     IF Mode = 9 THEN COLOR 3
  1473.     Center 5, STRING$(LEN(P$), "Ä")
  1474.     IF Mode = 9 THEN COLOR 2
  1475.     Center 6, P$
  1476.     IF Mode = 9 THEN COLOR 9
  1477.  
  1478.     PUT (x - 13, y), GorD&, PSET
  1479.     PUT (x + 47, y), GorD&, PSET
  1480.     Rest 1
  1481.  
  1482.     IF INKEY$ <> "" GOTO GetThisOverWith
  1483.  
  1484.     PUT (x - 13, y), GorL&, PSET
  1485.     PUT (x + 47, y), GorR&, PSET
  1486.     IF GSettings.useSound THEN PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b" ELSE RestReal .18
  1487.     Rest .3
  1488.  
  1489.     IF INKEY$ <> "" GOTO GetThisOverWith
  1490.  
  1491.     PUT (x - 13, y), GorR&, PSET
  1492.     PUT (x + 47, y), GorL&, PSET
  1493.     IF GSettings.useSound THEN PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-" ELSE RestReal .18
  1494.     Rest .3
  1495.  
  1496.     IF INKEY$ <> "" GOTO GetThisOverWith
  1497.  
  1498.     PUT (x - 13, y), GorL&, PSET
  1499.     PUT (x + 47, y), GorR&, PSET
  1500.     IF GSettings.useSound THEN PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-" ELSE RestReal .18
  1501.     Rest .3
  1502.  
  1503.     IF INKEY$ <> "" GOTO GetThisOverWith
  1504.  
  1505.     PUT (x - 13, y), GorR&, PSET
  1506.     PUT (x + 47, y), GorL&, PSET
  1507.     IF GSettings.useSound THEN PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b" ELSE RestReal .18
  1508.     Rest .3
  1509.  
  1510.     IF INKEY$ <> "" GOTO GetThisOverWith
  1511.  
  1512.     FOR i = 1 TO 4
  1513.       PUT (x - 13, y), GorL&, PSET
  1514.       PUT (x + 47, y), GorR&, PSET
  1515.       IF GSettings.useSound THEN PLAY "T160O0L32EFGEFDC" ELSE RestReal .18
  1516.       Rest .1
  1517.       PUT (x - 13, y), GorR&, PSET
  1518.       PUT (x + 47, y), GorL&, PSET
  1519.       IF GSettings.useSound THEN PLAY "T160O0L32EFGEFDC" ELSE RestReal .18
  1520.       Rest .1
  1521.  
  1522.       IF INKEY$ <> "" GOTO GetThisOverWith
  1523.     NEXT
  1524.  
  1525.     Rest 1
  1526.   END IF
  1527.  
  1528. GetThisOverWith:
  1529.  ' Finally, the intro can be aborted
  1530. END SUB
  1531.  
  1532. 'Intro:
  1533. '  Displays game introduction
  1534. SUB Intro
  1535.  
  1536.   IF GSettings.useSound THEN PLAY "MBT160O2" ' Initialise sound
  1537.   WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
  1538.   RESTORE SlidyText
  1539.   Slidy
  1540.   SparklePause (5)
  1541.   t$ = STRING$(80, " ")
  1542.   FOR s = 5 TO 8: LOCATE s * 2, 1: PRINT t$; : NEXT
  1543.   LOCATE 1, 1: PRINT t$: LOCATE 22, 1: PRINT t$
  1544.   FOR s = 1 TO 22: LOCATE s, 1: PRINT " "; : LOCATE s, 80: PRINT " "; : NEXT
  1545.   Slidy
  1546.   SparklePause (0)
  1547. END SUB
  1548.  
  1549. SUB LoadSettings
  1550. DIM currLine$, eqPos, KEY$, value$, nBool
  1551.  
  1552.  'þ set default settings
  1553.  GSettings.useSound = 1
  1554.  GSettings.useOldExplosions = 0
  1555.  GSettings.newExplosionRadius = 40
  1556.  GSettings.useSlidingText = 0 '1
  1557.  GSettings.defaultGravity = 17
  1558.  GSettings.defaultRoundQty = 4
  1559.  GSettings.showIntro = 1
  1560.  GSettings.forceCGA = 0
  1561.  
  1562.  
  1563.  lastErrCode = 0
  1564.  ON ERROR GOTO FuckOff
  1565.  OPEN "Gorillas.ini" FOR INPUT AS #1
  1566.  IF lastErrCode > 0 THEN EXIT SUB
  1567.  WHILE NOT EOF(1)
  1568.   LINE INPUT #1, currLine$
  1569.   IF lastErrCode > 0 THEN CLOSE #1: EXIT SUB
  1570.   GOSUB processLine
  1571.  WEND
  1572.  CLOSE #1
  1573.  ON ERROR GOTO 0
  1574.  
  1575. EXIT SUB
  1576.  
  1577. processLine:
  1578.  eqPos = INSTR(currLine$, "=")
  1579.  IF eqPos = 0 THEN
  1580.   RETURN
  1581.  END IF
  1582.  KEY$ = RTRIM$(LTRIM$(MID$(currLine$, 1, eqPos - 1)))
  1583.  value$ = RTRIM$(LTRIM$(RIGHT$(currLine$, LEN(currLine$) - eqPos)))
  1584.  
  1585.  SELECT CASE UCASE$(KEY$)
  1586.  CASE "USESOUND"
  1587.   GOSUB getBool
  1588.   IF nBool > -1 THEN GSettings.useSound = nBool
  1589.  CASE "USEOLDEXPLOSIONS"
  1590.   GOSUB getBool
  1591.   IF nBool > -1 THEN GSettings.useOldExplosions = nBool
  1592.  CASE "NEWEXPLOSIONRADIUS"
  1593.   GSettings.newExplosionRadius = VAL(value$)
  1594.  CASE "USESLIDINGTEXT"
  1595.   GOSUB getBool
  1596.   IF nBool > -1 THEN GSettings.useSlidingText = nBool
  1597.  CASE "DEFAULTGRAVITY"
  1598.   tVal = VAL(value$)
  1599.   IF tVal > 0 AND tVal < 100 THEN GSettings.defaultGravity = tVal
  1600.  CASE "DEFAULTROUNDQTY"
  1601.   tVal = VAL(value$)
  1602.   IF tVal > 0 AND tVal < 100 THEN GSettings.defaultRoundQty = tVal
  1603.  CASE "SHOWINTRO"
  1604.   GOSUB getBool
  1605.   IF nBool > -1 THEN GSettings.showIntro = nBool
  1606.  CASE "FORCECGA"
  1607.   GOSUB getBool
  1608.   IF nBool > -1 THEN GSettings.forceCGA = nBool
  1609.  END SELECT
  1610.  RETURN
  1611.  
  1612. getBool:
  1613.  IF UCASE$(value$) = "YES" OR value$ = "1" OR UCASE$(value$) = "TRUE" THEN
  1614.   nBool = 1
  1615.  ELSEIF UCASE$(value$) = "NO" OR value$ = "0" OR UCASE$(value$) = "FALSE" THEN
  1616.   nBool = 0
  1617.  ELSE
  1618.   nBool = -1
  1619.  END IF
  1620.  RETURN
  1621.  
  1622. leave:
  1623.  
  1624. END SUB
  1625.  
  1626. 'MakeCityScape:
  1627. '  Creates random skyline for game
  1628. 'Parameters:
  1629. '  BCoor() - a user-defined type array which stores the coordinates of
  1630. '  the upper left corner of each building.
  1631. SUB MakeCityScape (BCoor() AS XYPoint)
  1632.  
  1633.   x = 2
  1634.  
  1635.   'Set the sloping trend of the city scape. NewHt is new building height
  1636.   Slope = FNRan(6)
  1637.   SELECT CASE Slope
  1638.     CASE 1: NewHt = 15                 'Upward slope
  1639.     CASE 2: NewHt = 130                'Downward slope
  1640.     CASE 3 TO 5: NewHt = 15            '"V" slope - most common
  1641.     CASE 6: NewHt = 130                'Inverted "V" slope
  1642.   END SELECT
  1643.  
  1644.   IF Mode = 9 THEN
  1645.     BottomLine = 335                   'Bottom of building
  1646.     HtInc = 10                         'Increase value for new height
  1647.     DefBWidth = 37                     'Default building height
  1648.     RandomHeight = 120                 'Random height difference
  1649.     WWidth = 3                         'Window width
  1650.     WHeight = 6                        'Window height
  1651.     WDifV = 15                         'Counter for window spacing - vertical
  1652.     WDifh = 10                         'Counter for window spacing - horizontal
  1653.   ELSE
  1654.     BottomLine = 190
  1655.     HtInc = 6
  1656.     NewHt = NewHt * 20 \ 35            'Adjust for CGA
  1657.     DefBWidth = 18
  1658.     RandomHeight = 54
  1659.     WWidth = 1
  1660.     WHeight = 2
  1661.     WDifV = 5
  1662.     WDifh = 4
  1663.   END IF
  1664.  
  1665.   CurBuilding = 1
  1666.   DO
  1667.  
  1668.     SELECT CASE Slope
  1669.       CASE 1
  1670.         NewHt = NewHt + HtInc
  1671.       CASE 2
  1672.         NewHt = NewHt - HtInc
  1673.       CASE 3 TO 5
  1674.         IF x > ScrWidth \ 2 THEN
  1675.           NewHt = NewHt - 2 * HtInc
  1676.         ELSE
  1677.           NewHt = NewHt + 2 * HtInc
  1678.         END IF
  1679.       CASE 4
  1680.         IF x > ScrWidth \ 2 THEN
  1681.           NewHt = NewHt + 2 * HtInc
  1682.         ELSE
  1683.           NewHt = NewHt - 2 * HtInc
  1684.         END IF
  1685.     END SELECT
  1686.  
  1687.     'Set width of building and check to see if it would go off the screen
  1688.     BWidth = FNRan(DefBWidth) + DefBWidth
  1689.     IF x + BWidth > ScrWidth THEN BWidth = ScrWidth - x - 2
  1690.  
  1691.     'Set height of building and check to see if it goes below screen
  1692.     BHeight = FNRan(RandomHeight) + NewHt
  1693.     IF BHeight < HtInc THEN BHeight = HtInc
  1694.  
  1695.     'Check to see if Building is too high
  1696.     IF BottomLine - BHeight <= MaxHeight + GHeight THEN BHeight = MaxHeight + GHeight - 5
  1697.  
  1698.     'Set the coordinates of the building into the array
  1699.     BCoor(CurBuilding).XCoor = x
  1700.     BCoor(CurBuilding).YCoor = BottomLine - BHeight
  1701.  
  1702.     IF Mode = 9 THEN BuildingColor = FNRan(3) + 4 ELSE BuildingColor = 2
  1703.  
  1704.     'Draw the building, outline first, then filled
  1705.     LINE (x - 1, BottomLine + 1)-(x + BWidth + 1, BottomLine - BHeight - 1), BACKGROUND, B
  1706.     LINE (x, BottomLine)-(x + BWidth, BottomLine - BHeight), BuildingColor, BF
  1707.  
  1708.     'Draw the windows
  1709.     c = x + 3
  1710.     DO
  1711.       FOR i = BHeight - 3 TO 7 STEP -WDifV
  1712.         IF Mode <> 9 THEN
  1713.           WinColr = (FNRan(2) - 2) * -3
  1714.         ELSEIF FNRan(4) = 1 THEN
  1715.           WinColr = 8
  1716.         ELSE
  1717.           WinColr = WINDOWCOLOR
  1718.         END IF
  1719.         LINE (c, BottomLine - i)-(c + WWidth, BottomLine - i + WHeight), WinColr, BF
  1720.       NEXT
  1721.       c = c + WDifh
  1722.     LOOP UNTIL c >= x + BWidth - 3
  1723.  
  1724.     x = x + BWidth + 2
  1725.  
  1726.     CurBuilding = CurBuilding + 1
  1727.  
  1728.   LOOP UNTIL x > ScrWidth - HtInc
  1729.  
  1730.   LastBuilding = CurBuilding - 1
  1731.  
  1732.   'Set Wind speed
  1733.   Wind = FNRan(10) - 5
  1734.   IF FNRan(3) = 1 THEN
  1735.     IF Wind > 0 THEN
  1736.       Wind = Wind + FNRan(10)
  1737.     ELSE
  1738.       Wind = Wind - FNRan(10)
  1739.     END IF
  1740.   END IF
  1741.  
  1742.   'Draw Wind speed arrow
  1743.   IF Wind <> 0 THEN
  1744.     WindLine = Wind * 3 * (ScrWidth \ 320)
  1745.     LINE (ScrWidth \ 2, ScrHeight - 5)-(ScrWidth \ 2 + WindLine, ScrHeight - 5), ExplosionColor
  1746.     IF Wind > 0 THEN ArrowDir = -2 ELSE ArrowDir = 2
  1747.     LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 - 2), ExplosionColor
  1748.     LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 + 2), ExplosionColor
  1749.   END IF
  1750. END SUB
  1751.  
  1752. 'PlaceGorillas:
  1753. '  PUTs the Gorillas on top of the buildings.  Must have drawn
  1754. '  Gorillas first.
  1755. 'Parameters:
  1756. '  BCoor() - user-defined TYPE array which stores upper left coordinates
  1757. '  of each building.
  1758. SUB PlaceGorillas (BCoor() AS XYPoint)
  1759.    
  1760.   IF Mode = 9 THEN
  1761.     XAdj = 14
  1762.     YAdj = 30
  1763.   ELSE
  1764.     XAdj = 7
  1765.     YAdj = 16
  1766.   END IF
  1767.   SclX# = ScrWidth / 320
  1768.   SclY# = ScrHeight / 200
  1769.    
  1770.   'Place gorillas on second or third building from edge
  1771.   FOR i = 1 TO 2
  1772.     IF i = 1 THEN BNum = FNRan(2) + 1 ELSE BNum = LastBuilding - FNRan(2)
  1773.  
  1774.     BWidth = BCoor(BNum + 1).XCoor - BCoor(BNum).XCoor
  1775.     GorillaX(i) = BCoor(BNum).XCoor + BWidth / 2 - XAdj
  1776.     GorillaY(i) = BCoor(BNum).YCoor - YAdj
  1777.     PUT (GorillaX(i), GorillaY(i)), GorD&, PSET
  1778.   NEXT i
  1779.  
  1780. END SUB
  1781.  
  1782. 'PlayGame:
  1783. '  Main game play routine
  1784. 'Parameters:
  1785. '  Player$() - player names
  1786. '  NumGames - number of games to play
  1787. FUNCTION PlayGame (Player$(), NumGames, P)
  1788.  
  1789.  DIM BCoor(0 TO 30) AS XYPoint
  1790.  DIM minRounds
  1791.  DIM totalWins(1 TO 2)
  1792.  DIM avBan!(1 TO 2)                 ' mean accuracy
  1793.  DIM Throw(1 TO 2)                  ' throw counter
  1794.  DIM numHits(1 TO 2, 1 TO NumGames) ' number of throws needed to kill
  1795.                                      '  opponent per win for each player
  1796.  J = 1
  1797.  abortYN = FALSE
  1798.  minRounds = FIX(NumGames / 2) + 1
  1799.  
  1800.  i = 1
  1801.  DO
  1802.   CLS
  1803.   RANDOMIZE (TIMER)
  1804.   CALL MakeCityScape(BCoor())
  1805.   CALL PlaceGorillas(BCoor())
  1806.   DoSun SUNHAPPY
  1807.   GLeftAngle# = 0: GRightAngle# = 0
  1808.   GLeftVeloc = 0: GRightVeloc = 0
  1809.   Hit = FALSE: IF GSettings.useSound THEN PLAY "MBT160O1L8<G>CDEDCDL4ECC"
  1810.   go = 1
  1811.   DO WHILE Hit = FALSE
  1812.    J = 1 - J
  1813.    LOCATE 1, 2
  1814.    IF Mode = 9 THEN COLOR 12
  1815.    PRINT Player$(1);
  1816.    LOCATE 1, (MaxCol - LEN(Player$(2)))
  1817.    PRINT Player$(2);
  1818.    IF Mode = 9 THEN COLOR 9
  1819.    Center 23, STR$(totalWins(1)) + " > Score < " + LTRIM$(STR$(totalWins(2)) + " ")
  1820.    Tosser = J + 1: Tossee = 2 - J
  1821.  
  1822.    'Plot the shot.  Hit is true if Gorilla gets hit.
  1823.    Hit = DoShot(Player$(), Tosser, GorillaX(Tosser), GorillaY(Tosser), go, GorillaX(Tossee), GorillaY(Tossee))
  1824.    IF Hit = 1 THEN abortYN = TRUE: EXIT DO
  1825.    'If the throw was fatal, Tosser now contains the player who WON
  1826.  
  1827.    'If not hit self then increase number of hits
  1828.    IF (J + 1) = Tosser THEN Throw(Tosser) = Throw(Tosser) + 1
  1829.  
  1830.    IF Hit = TRUE THEN
  1831.     'Update scores
  1832.     totalWins(Tosser) = totalWins(Tosser) + 1
  1833.     IF (J + 1) = Tosser THEN numHits(Tosser, totalWins(Tosser)) = Throw(Tosser)
  1834.    END IF
  1835.  
  1836.    go = go + 1
  1837.  
  1838.   LOOP
  1839.  
  1840.   IF abortYN THEN EXIT DO
  1841.  
  1842.   Throw(1) = 0: Throw(2) = 0
  1843.   SLEEP 1
  1844.  
  1845.  i = i + 1
  1846.  LOOP UNTIL i > NumGames OR totalWins(1) >= minRounds OR totalWins(2) >= minRounds
  1847.  
  1848.  'þ If game played out then go through end game sequence
  1849.  IF NOT abortYN THEN
  1850.   GamePlayedYN = 1
  1851.   FOR l = 1 TO 2: Kills = 0
  1852.   IF totalWins(l) > 0 THEN
  1853.     FOR m = 1 TO totalWins(l)
  1854.      IF numHits(l, m) > 0 THEN
  1855.       avBan!(l) = avBan!(l) + numHits(l, m): Kills = Kills + 1
  1856.      END IF
  1857.     NEXT
  1858.     IF avBan!(l) > 0 THEN avBan!(l) = avBan!(l) / Kills
  1859.    END IF
  1860.   NEXT
  1861.  END IF
  1862.  
  1863.  SCREEN 0
  1864.  WIDTH 80, 25
  1865.  COLOR 7, 0
  1866.  MaxCol = 80
  1867.  CLS
  1868.  Stats totalWins(), Player$(), avBan!(), P, abortYN
  1869.  CLS : RESTORE NowWhat: Slidy
  1870.  LOCATE 2, 1: COLOR 2: PRINT STRING$(80, "Í")
  1871.  LOCATE 4, 4: PRINT "Another game? [Y/N]";
  1872.  DO
  1873.   in$ = UCASE$(INKEY$)
  1874.  LOOP UNTIL in$ = "Y" OR in$ = "N"
  1875.  IF in$ = "Y" THEN PlayGame = 1 ELSE PlayGame = 0
  1876.  
  1877. END FUNCTION
  1878.  
  1879. 'PlayGame:
  1880. '  Plots banana shot across the screen
  1881. 'Parameters:
  1882. '  StartX, StartY - starting shot location
  1883. '  Angle - shot angle
  1884. '  Velocity - shot velocity
  1885. '  PlayerNum - the banana thrower
  1886. FUNCTION PlotShot (StartX, StartY, angle#, velocity, PlayerNum, othX, othY)
  1887.  
  1888.  angleChk = angle#: IF PlayerNum = 2 THEN angleChk = 180 - angleChk
  1889.  
  1890.  angle# = angle# / 180 * pi#  'Convert degree angle to radians
  1891.  InitXVel# = COS(angle#) * velocity
  1892.  InitYVel# = SIN(angle#) * velocity
  1893.  oldx# = StartX
  1894.  oldy# = StartY
  1895.  
  1896.  ' draw gorilla toss
  1897.  IF PlayerNum = 1 THEN
  1898.   PUT (StartX, StartY), GorL&, PSET
  1899.  ELSE
  1900.   PUT (StartX, StartY), GorR&, PSET
  1901.  END IF
  1902.  ' throw sound
  1903.  IF GSettings.useSound THEN PLAY "MBO0L32A-L64CL16BL64A+"
  1904.  Rest .1
  1905.  ' redraw gorilla
  1906.  PUT (StartX, StartY), GorD&, PSET
  1907.  
  1908.  adjust = Scl(4)                   'For scaling CGA
  1909.  
  1910.  xedge = Scl(9) * (2 - PlayerNum)  'Find leading edge of banana for check
  1911.  
  1912.  Impact = FALSE
  1913.  SunHit = FALSE
  1914.  ShotInSun = FALSE
  1915.  OnScreen = TRUE 'þ FALSE if the banana is off side
  1916.  PlayerHit = 0
  1917.  NeedErase = FALSE
  1918.  Bounced = FALSE
  1919.  'þ Set up banana sound effect
  1920.  DoooMinVeloc = 40
  1921.  pitch! = 9800
  1922.  pitchDec! = 100
  1923.  pitchDecDec! = (((InitYVel# - DoooMinVeloc) / (200 - DoooMinVeloc)) * 1.2) - .5
  1924.  
  1925.  t2b# = 9999 'þ Used to store the time when the banana is to stop moving
  1926.              '  when continuing off screen. 9999 means unused.
  1927.  
  1928.  StartXPos = StartX
  1929.  StartYPos = StartY - adjust - 3
  1930.  
  1931.  IF PlayerNum = 2 THEN
  1932.   StartXPos = StartXPos + Scl(25)
  1933.   Direction = Scl(4)
  1934.  ELSE
  1935.   Direction = Scl(-4)
  1936.  END IF
  1937.  
  1938.  IF velocity < 2 THEN              'Shot too slow - hit self
  1939.   x# = StartX
  1940.   y# = StartY
  1941.   pointval = OBJECTCOLOR
  1942.  END IF
  1943.  
  1944.  'þ Obtain predicted x-coordinate when banana reaches bottom of screen
  1945.  GOSUB PredictBottomOfScreen
  1946.  'þ See if banana will overshoot (direction is +ve for left & -ve for right)
  1947.  'þ MissedDist# is -ve for miss, and +ve for hit
  1948.  IF Direction > 0 THEN
  1949.   MissedDist# = XPredicted#
  1950.  ELSE
  1951.   MissedDist# = ScrWidth - XPredicted#
  1952.  END IF
  1953.  'þ If shot is going backwards, then turns it into a miss
  1954.  IF SGN(Direction) = SGN(InitXVel#) THEN MissedDist# = 0 - MissedDist#
  1955.  
  1956.  DO WHILE (NOT Impact) AND OnScreen
  1957.   Rest .02
  1958.  
  1959.   'Erase old banana, if necessary
  1960.   IF NeedErase THEN
  1961.     NeedErase = FALSE
  1962.     CALL DrawBan(oldx#, oldy#, oldrot, FALSE)
  1963.   END IF
  1964.  
  1965.   x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)
  1966.   y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * Gravity * t# ^ 2)) * (ScrHeight / 350)
  1967.  
  1968.   IF y# > oldy# AND InitYVel# > DoooMinVeloc AND NOT Bounced AND MissedDist# > -175 THEN
  1969.    'þ Play banana sound effect
  1970.    IF GSettings.useSound THEN SOUND pitch!, 1
  1971.    'þ Decrement banana sound effect pitch
  1972.    IF (pitch! - pitchDec! >= 37) THEN
  1973.     pitch! = pitch! - pitchDec!: pitchDec! = pitchDec! - pitchDecDec!
  1974.    END IF
  1975.   END IF
  1976.  
  1977.   IF y# >= ScrHeight - 7 THEN
  1978.    'þ If velocity is still high enough to bounce, and banana is on screen
  1979.    IF InitYVel# > 2 AND t2b# = 9999 THEN
  1980.     Bounced = TRUE
  1981.     IF GSettings.useSound THEN PLAY "O4A64"
  1982.     InitYVel# = SQR(InitYVel# ^ 2 - (2 * Gravity * (StartYPos - (ScrHeight - 7)))) * .4
  1983.     StartXPos = x#
  1984.     y# = ScrHeight - 7: StartYPos = y#
  1985.     t# = 0
  1986.    ELSE
  1987.     'þ Terminate banana motion
  1988.     OnScreen = FALSE
  1989.     DoSun SUNHAPPY
  1990.     IF t2b# = 9999 THEN 'þ Because its velocity ran out
  1991.      IF GSettings.useSound THEN PLAY "O0A4"
  1992.     ELSE 'þ Or because it bounced when off screen
  1993.      IF SGN(Direction) <> SGN(InitXVel#) THEN GOSUB FailureMessage
  1994.     END IF
  1995.    END IF
  1996.   END IF
  1997.  
  1998.   'þ If banana leaves the screen
  1999.   IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) THEN
  2000.    'þ And banana will not return to the screen
  2001.    IF (XPredicted# >= ScrWidth - Scl(10)) OR (XPredicted# <= 3) THEN
  2002.     IF t# > t2b# THEN
  2003.      OnScreen = FALSE
  2004.      'þ Redraw sun as soon as poss
  2005.      '  Ignore SunHit: bananas can still take pieces out of the sun unnoticed
  2006.      DoSun SUNHAPPY
  2007.      IF SGN(Direction) <> SGN(InitXVel#) THEN
  2008.       GOSUB FailureMessage
  2009.      END IF
  2010.     ELSEIF t2b# = 9999 THEN
  2011.      IF y# <= 0 THEN t2b# = t# + 1.5 ELSE t2b# = t# + 4
  2012.     END IF
  2013.    END IF
  2014.   END IF
  2015.  
  2016.   IF OnScreen AND y# > 0 AND (x# > 3 AND x# < (ScrWidth - Scl(10))) THEN
  2017.    'check it
  2018.    LookY = 0
  2019.    LookX = Scl(8 * (2 - PlayerNum))
  2020.    
  2021.    DO
  2022.     pointval = POINT(x# + LookX, y# + LookY)
  2023.     IF pointval = 0 THEN
  2024.      Impact = FALSE
  2025.      IF ShotInSun = TRUE THEN
  2026.       IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE
  2027.      END IF
  2028.     ELSEIF pointval = SUNATTR AND y# < SunHt THEN
  2029.      IF NOT SunHit THEN DoSun SUNSHOCK
  2030.      SunHit = TRUE
  2031.      ShotInSun = TRUE
  2032.     ELSE
  2033.      Impact = TRUE
  2034.      DoSun SUNHAPPY
  2035.     END IF
  2036.     LookX = LookX + Direction
  2037.     LookY = LookY + Scl(6)
  2038.    LOOP UNTIL Impact OR LookX <> Scl(4)
  2039.    
  2040.    IF NOT ShotInSun AND NOT Impact THEN
  2041.     'plot it
  2042.     rot = (t# * 10) MOD 4
  2043.     CALL DrawBan(x#, y#, rot, TRUE)
  2044.     NeedErase = TRUE
  2045.    END IF
  2046.            
  2047.    oldrot = rot
  2048.  
  2049.   END IF
  2050.  
  2051.   oldx# = x#
  2052.   oldy# = y#
  2053.   t# = t# + .1
  2054.  LOOP
  2055.  
  2056.  IF pointval = OBJECTCOLOR THEN
  2057.   IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2
  2058.   IF PlayerHit = PlayerNum THEN
  2059.    IF Mode = 9 THEN COLOR 2
  2060.    DoSun SUNSHOCK ' hehehe
  2061.    Center 1, "Now that was pretty dumb."
  2062.   END IF
  2063.   ExplodeGorilla x#, y#, PlayerHit
  2064.   IF PlayerHit = PlayerNum THEN
  2065.    tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + .75
  2066.    ' Center 1, SPACE$(25): DoSun SUNHAPPY
  2067.   END IF
  2068.  ELSEIF pointval <> OBJECTCOLOR AND Impact THEN
  2069.   CALL DoExplosion(x# + adjust, y# + adjust)
  2070.   'þ Reset values for shot's initial stage (before any bouncing)
  2071.   InitXVel# = COS(angle#) * velocity
  2072.   InitYVel# = SIN(angle#) * velocity
  2073.   StartXPos = StartX: IF PlayerNum = 2 THEN StartXPos = StartXPos + Scl(25)
  2074.   StartYPos = StartY - adjust - 3
  2075.   GOSUB PredictReturnToHeight
  2076.   'þ If shot went the right direction...
  2077.   IF SGN(Direction) <> SGN(InitXVel#) THEN
  2078.    'þ ...and if shot was too low powered:
  2079.    IF (ABS(XPredicted# - StartX) < ABS((othX - StartX) / 3) AND angleChk > 60) OR ABS(XPredicted# - StartX) < ABS((othX - StartX) / 6) THEN
  2080.     SELECT CASE FNRan(3)
  2081.      CASE 1:
  2082.       IF Mode = 9 THEN
  2083.        Message$ = "Aren't your little muscles strong enough?"
  2084.       ELSE
  2085.        Message$ = "Your little muscles not strong enough?"
  2086.       END IF
  2087.      CASE 2: Message$ = "Now that was feeble."
  2088.      CASE 3: Message$ = "You can do better than that!"
  2089.     END SELECT
  2090.     IF GSettings.useSound THEN PLAY "MBO2L24BAGFEDCO1C2"
  2091.     GOSUB DoMessage
  2092.     GOSUB RestoreSun
  2093.    END IF
  2094.   END IF
  2095.  END IF
  2096.  
  2097.  'redraw gorillas
  2098.  IF PlayerHit = 0 THEN
  2099.   PUT (StartX, StartY), GorD&, PSET
  2100.   PUT (othX, othY), GorD&, PSET
  2101.  END IF
  2102.  
  2103.  'þ Message for backwards-tossed shot
  2104.  IF SGN(Direction) = SGN(InitXVel#) AND PlayerHit <> PlayerNum THEN
  2105.   IF GSettings.useSound THEN PLAY "MBO1L24BAGFEDCO0C2"
  2106.   IF Mode = 9 THEN
  2107.    Message$ = "You're not supposed to throw it that way."
  2108.   ELSE
  2109.    Message$ = "Don't throw it that way!"
  2110.   END IF
  2111.   GOSUB DoMessage
  2112.   GOSUB RestoreSun
  2113.  END IF
  2114.  
  2115.  PlotShot = PlayerHit
  2116.  
  2117. EXIT FUNCTION
  2118.  
  2119. ' When doing position calculation, don't forget -Gravity and Wind/5
  2120.  
  2121. PredictReturnToHeight:
  2122.  ' Prediction of the banana's x-coordinate when it has come down to a level
  2123.  ' horizontally equal with the gorilla that fired it.
  2124.  t2# = (2 * InitYVel#) / Gravity
  2125.  XPredicted# = (InitXVel# * t2#) + (.5 * (Wind / 5) * t2# ^ 2) + StartXPos
  2126.  IF PlayerNum = 2 THEN XPredictedRet# = XPredictedRet# + Scl(25)
  2127. RETURN
  2128.  
  2129. PredictBottomOfScreen:
  2130.  ' Prediction of the x-coordinate of the shot when it reaches the bottom of
  2131.  ' the screen
  2132.  fallDist = StartYPos - (ScrHeight - 7)
  2133.  t2# = (-InitYVel# - SQR((InitYVel# ^ 2) + (2 * (-Gravity) * fallDist))) / (-Gravity)
  2134.  XPredicted# = (InitXVel# * t2#) + ((t2# ^ 2 * Wind) / 10) + StartXPos
  2135.  IF PlayerNum = 2 THEN XPredicted# = XPredicted# + Scl(25)
  2136. RETURN
  2137.  
  2138. FailureMessage:
  2139.  'þ Select message based on distance beyond screen edge
  2140.  'þ NOT calibrated for CGA
  2141.  
  2142.  GiveDist = 0 'þ Flag to indicate whether to show distance travelled
  2143.  
  2144.  'þ If the player saw the banana leave the screen
  2145.  MissedDist# = ABS(MissedDist#)
  2146.  IF y# > 0 THEN
  2147.   SELECT CASE MissedDist#
  2148.    CASE 1 TO 155
  2149.     SELECT CASE FNRan(2)
  2150.      CASE 1: Message$ = "That went a wee bit far, didn't it?"
  2151.      CASE 2: Message$ = "It seems you overdid that a little."
  2152.     END SELECT
  2153.    CASE 156 TO 640
  2154.     SELECT CASE FNRan(4)
  2155.      CASE 1: Message$ = "I think you need glasses."
  2156.      CASE 2 TO 4: Message$ = "Hmmm...that wasn't good."
  2157.     END SELECT
  2158.    CASE 641 TO 1500: Message$ = "WHAT? That went MILES OFF!"
  2159.    CASE IS > 1500
  2160.     SELECT CASE FNRan(2)
  2161.      CASE 1: Message$ = "WHAT ARE YOU PLAYING AT?"
  2162.      CASE 2: Message$ = "Temper temper"
  2163.     END SELECT
  2164.   END SELECT
  2165.  ELSE
  2166.   SELECT CASE MissedDist#
  2167.    CASE 1 TO 155:
  2168.     IF Mode = 9 THEN
  2169.      Message$ = "A little nearer and you might stand a chance"
  2170.     ELSE
  2171.      Message$ = "A little nearer and you might make it."
  2172.     END IF
  2173.    CASE 156 TO 640:
  2174.     SELECT CASE FNRan(2)
  2175.      CASE 1: Message$ = "Nope. That was too far off."
  2176.      CASE 2: Message$ = CHR$(34) + "Hello? I'm over here!" + CHR$(34)
  2177.     END SELECT
  2178.    CASE 640 TO 1500
  2179.     SELECT CASE FNRan(2)
  2180.      CASE 1: Message$ = "Whoa! Go easy with it!"
  2181.      CASE 2: Message$ = "You must be JOKING!"
  2182.     END SELECT
  2183.    CASE IS > 1500:
  2184.     IF Mode = 9 THEN
  2185.      Message$ = "You weren't supposed to put it into orbit."
  2186.     ELSE
  2187.      Message$ = "Don't put it into orbit!"
  2188.     END IF
  2189.   END SELECT
  2190.  END IF
  2191.  
  2192.  IF GSettings.useSound THEN PLAY "MBO1L24BAGFEDCO0C2"
  2193.  GOSUB DoMessage
  2194.  GOSUB RestoreSun
  2195. RETURN
  2196.  
  2197. DoMessage:
  2198.  IF Mode = 9 THEN COLOR 2
  2199.  Center 1, Message$
  2200.  tpause! = TIMER: DO: LOOP UNTIL TIMER > tpause! + 2
  2201.  Center 1, SPACE$(LEN(Message$))
  2202. RETURN
  2203.  
  2204. RestoreSun:
  2205.  sunX = ScrWidth \ 2: sunY = Scl(25)
  2206.  LINE (sunX, sunY - Scl(15))-(sunX, sunY), SUNATTR
  2207.  LINE (sunX - Scl(8), sunY - Scl(13))-(sunX, sunY), SUNATTR
  2208.  LINE (sunX, sunY)-(sunX + Scl(8), sunY - Scl(13)), SUNATTR
  2209. RETURN
  2210.  
  2211. END FUNCTION
  2212.  
  2213. 'Rest:
  2214. '  pauses the program
  2215. SUB Rest (t#)
  2216.   s# = TIMER
  2217.   t2# = 0
  2218.   ' t2# = MachSpeed * t#' / SPEEDCONST
  2219.   'þ Speed calibration disabled
  2220.   DO
  2221.   LOOP UNTIL TIMER - s# > t2#
  2222. END SUB
  2223.  
  2224. SUB RestReal (t#)
  2225.   s# = TIMER
  2226.   DO
  2227.   LOOP UNTIL TIMER - s# > t#
  2228. END SUB
  2229.  
  2230. 'Scl:
  2231. '  Pass the number in to scaling for cga.  If the number is a decimal, then we
  2232. '  want to scale down for cga or scale up for ega.  This allows a full range
  2233. '  of numbers to be generated for scaling.
  2234. '  (i.e. for 3 to get scaled to 1, pass in 2.9)
  2235. FUNCTION Scl (N!)
  2236.  
  2237.   IF N! <> INT(N!) THEN
  2238.       IF Mode = 1 THEN N! = N! - 1
  2239.   END IF
  2240.   IF Mode = 1 THEN
  2241.       Scl = CINT(N! / 2 + .1)
  2242.   ELSE
  2243.       Scl = CINT(N!)
  2244.   END IF
  2245.  
  2246. END FUNCTION
  2247.  
  2248. 'SetScreen:
  2249. '  Sets the appropriate color statements
  2250. SUB SetScreen
  2251.  
  2252.   IF Mode = 9 THEN
  2253.     ExplosionColor = 2
  2254.     BackColor = 1
  2255.     PALETTE 0, 1
  2256.     PALETTE 1, 46
  2257.     PALETTE 2, 44
  2258.     PALETTE 3, 54
  2259.     PALETTE 5, 7
  2260.     PALETTE 6, 4
  2261.     PALETTE 7, 3
  2262.     PALETTE 9, 63       'Display Color
  2263.     PALETTE 10, 24
  2264.     PALETTE 14, 55
  2265.   ELSE
  2266.     ExplosionColor = 2
  2267.     BackColor = 0
  2268.     COLOR BackColor, 2
  2269.   END IF
  2270.  
  2271. END SUB
  2272.  
  2273. SUB ShowPrompts (fieldNum)
  2274.  
  2275.  SELECT CASE fieldNum
  2276.   CASE 1 TO 2
  2277.    GOSUB pPlayers ' player list manipulation
  2278.     CASE 11
  2279.      GOSUB pDeletePlayer
  2280.     CASE 12, -12
  2281.      GOSUB pCreatePlayer
  2282.     CASE 13
  2283.      GOSUB pRenamePlayer
  2284.   CASE 3
  2285.    GOSUB pRounds
  2286.   CASE 4
  2287.    GOSUB pGravity
  2288.  END SELECT
  2289.  
  2290. EXIT SUB
  2291.  
  2292. pPlayers:
  2293.  COLOR , 0
  2294.  FOR l = 3 TO 6: LOCATE l, 1: PRINT STRING$(80, " "); : NEXT
  2295.  noOfDiams = 4: GOSUB Diamonds
  2296.  IF fieldNum = 1 THEN LOR$ = "LEFT" ELSE IF fieldNum = 2 THEN LOR$ = "RIGHT"
  2297.  COLOR 9: LOCATE 3, 5
  2298.  PRINT "Use arrow keys to choose " + LOR$ + " HAND player and press [ENTER] to confirm."
  2299.  LOCATE 4, 5: PRINT "Type [N] to create a new player (up to 20 players)."
  2300.  LOCATE 5, 5: PRINT "Type [R] to rename a player."
  2301.  LOCATE 6, 5: PRINT "Type [DELETE] to delete a player."
  2302. RETURN
  2303.  
  2304. pDeletePlayer:
  2305.  noOfDiams = 3: GOSUB Diamonds
  2306.  LOCATE 4, 5: COLOR 9: PRINT "Press [Y] to delete the player, OR"
  2307.  LOCATE 5, 5: PRINT "Press [N] to cancel"
  2308. RETURN
  2309.  
  2310. pCreatePlayer:
  2311.  COLOR , 0
  2312.  FOR l = 3 TO 6: LOCATE l, 1: PRINT STRING$(80, " "): NEXT
  2313.  noOfDiams = 1: GOSUB Diamonds
  2314.  'þ Used if the ESCAPE prompt is to be given
  2315. IF fieldNum = 12 THEN LOCATE 6, 3: PRINT ""
  2316.  COLOR 9
  2317.  LOCATE 3, 5: PRINT "Enter name of new player and press [ENTER] when done. You may as well"
  2318.  LOCATE 4, 5: PRINT "specify the player's full name as you only ever have to enter it"
  2319.  LOCATE 5, 5: PRINT "once."
  2320.  'þ Signals whether ESCAPE can be pressed
  2321.  IF fieldNum = 12 THEN LOCATE 6, 5: PRINT "Or press [ESC] to cancel."
  2322. RETURN
  2323.  
  2324. pRenamePlayer:
  2325.  COLOR , 0
  2326.  FOR l = 3 TO 6
  2327.   LOCATE l, 1: PRINT STRING$(80, " ")
  2328.  NEXT
  2329.  noOfDiams = 3: GOSUB Diamonds: COLOR 9
  2330.  LOCATE 3, 5: PRINT "Edit name of player and press [ENTER] when done."
  2331.  LOCATE 4, 5: PRINT "Pressing [DELETE] will clear the name field."
  2332.  LOCATE 5, 5: PRINT "Press [ESC] if you want to undo the changes."
  2333. RETURN
  2334.  
  2335. '
  2336.  
  2337. pRounds:
  2338.  COLOR , 0
  2339.  FOR l = 3 TO 6: LOCATE l, 1: PRINT STRING$(80, " "); : NEXT
  2340.  noOfDiams = 1: GOSUB Diamonds
  2341.  COLOR 9
  2342.  LOCATE 3, 5: PRINT "Enter input and press [ENTER] for the next field."
  2343. RETURN
  2344.  
  2345. pGravity:
  2346.  noOfDiams = 2: GOSUB Diamonds
  2347.  COLOR 9
  2348.  LOCATE 3, 5: PRINT "Enter input and press [ENTER] to finish and play the game."
  2349.  LOCATE 4, 5: PRINT "Or press [TAB] to return to the first entry."
  2350.  LOCATE 6, 5: PRINT "Competition gravity is 17 m/sý."
  2351. RETURN
  2352.  
  2353. '
  2354.  
  2355. Diamonds:
  2356.  COLOR 2
  2357.  FOR l = 3 TO (3 + (noOfDiams - 1))
  2358. LOCATE l, 3: PRINT ""
  2359.  NEXT
  2360. RETURN
  2361.  
  2362. END SUB
  2363.  
  2364. SUB Slidy
  2365.  
  2366.  DIM q AS LONG
  2367.  
  2368.  READ N
  2369.  
  2370.  DIM t$(1 TO N): DIM i(1 TO N, 1 TO 3)
  2371.  FOR l = 1 TO N
  2372.    READ P$: x = 40 - LEN(P$) / 2
  2373.    P$ = STRING$(x, " ") + P$ + STRING$(x, " ")
  2374.    READ i(l, 1), i(l, 2), i(l, 3)
  2375.    t$(l) = P$
  2376.  NEXT
  2377.  
  2378.  IF GSettings.useSlidingText THEN
  2379.   FOR la = 1 TO 80
  2380.    FOR lb = 1 TO N
  2381.     IF i(lb, 2) < 0 THEN
  2382.       P$ = LEFT$(t$(lb), la): x = 81 - la
  2383.     ELSE
  2384.       P$ = RIGHT$(t$(lb), la): x = 1
  2385.     END IF
  2386.     LOCATE i(lb, 3), x: COLOR i(lb, 1): PRINT P$;
  2387.    NEXT
  2388.    FOR q = 1 TO SLIDECONST: NEXT
  2389.   NEXT
  2390.  
  2391.  ELSE
  2392.   FOR lb = 1 TO N
  2393.    LOCATE i(lb, 3), 1: COLOR i(lb, 1): PRINT t$(lb)
  2394.   NEXT
  2395.  END IF
  2396.  
  2397. END SUB
  2398.  
  2399. 'SparklePause:
  2400. '  Creates flashing border for intro and statistics screens
  2401. SUB SparklePause (opt AS INTEGER)
  2402.      
  2403.  DO: LOOP UNTIL INKEY$ = "" 'þ Clear keyboard buffer
  2404.  COLOR 12, 0
  2405.  a$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "
  2406.  t! = TIMER
  2407.  DO
  2408.    FOR a = 1 TO 5
  2409.      t1! = TIMER: DO: LOOP UNTIL TIMER > t1! + .001
  2410.      LOCATE 1, 1                             'print horizontal sparkles
  2411.      PRINT MID$(a$, a, 80);
  2412.      LOCATE 22, 1
  2413.      PRINT MID$(a$, 6 - a, 80);
  2414.  
  2415.      FOR b = 2 TO 21                         'Print Vertical sparkles
  2416.        c = (a + b) MOD 5
  2417.        IF c = 1 THEN
  2418.          LOCATE b, 80
  2419.          PRINT "*";
  2420.          LOCATE 23 - b, 1
  2421.          PRINT "*";
  2422.        ELSE
  2423.          LOCATE b, 80
  2424.          PRINT " ";
  2425.          LOCATE 23 - b, 1
  2426.          PRINT " ";
  2427.        END IF
  2428.      NEXT b
  2429.    NEXT a
  2430.  LOOP UNTIL INKEY$ <> "" OR (opt > 0 AND TIMER > t! + opt)
  2431.  
  2432. END SUB
  2433.  
  2434. SUB Stats (Wins(), nam$(), Ban!(), P, abortYN)
  2435.  
  2436.  IF abortYN THEN
  2437.   RESTORE Aborted: Slidy
  2438.   LOCATE 4, 3: COLOR 2: PRINT STRING$(76, "Í")
  2439.  ELSE
  2440.   'þ Update and sort the league table
  2441.   RESTORE GameOver: Slidy
  2442.   LOCATE 4, 3: COLOR 2: PRINT STRING$(76, "Í")
  2443.   FOR l = 1 TO 2
  2444.    PDat(PDefs(l)).Rounds = PDat(PDefs(l)).Rounds + Wins(1) + Wins(2)
  2445.    PDat(PDefs(l)).Won = PDat(PDefs(l)).Won + Wins(l)
  2446.    IF Ban!(l) > 0 THEN
  2447.     IF PDat(PDefs(l)).Accu > 0 THEN
  2448.      PDat(PDefs(l)).Accu = CINT(((PDat(PDefs(l)).Accu + Ban!(l)) / 2) * 10) / 10
  2449.     ELSE
  2450.      PDat(PDefs(l)).Accu = CINT(Ban!(l) * 10) / 10
  2451.     END IF
  2452.    END IF
  2453.   NEXT
  2454.  
  2455.   'þ routine to sort the player list
  2456.   DO
  2457.    complete = 1: tempW1 = 0: tempW2 = 0
  2458.    FOR l = 1 TO P - 1
  2459.     IF PDat(l).Rounds > 0 THEN tempW1 = (PDat(l).Won / PDat(l).Rounds * 100)
  2460.     IF PDat(l + 1).Rounds > 0 THEN tempW2 = (PDat(l + 1).Won / PDat(l + 1).Rounds * 100)
  2461.     IF (tempW1 < tempW2) OR (tempW1 = tempW2 AND PDat(l).Accu > PDat(l + 1).Accu) THEN
  2462.      SWAP PDat(l).PNam, PDat(l + 1).PNam
  2463.      SWAP PDat(l).Rounds, PDat(l + 1).Rounds
  2464.      SWAP PDat(l).Won, PDat(l + 1).Won
  2465.      SWAP PDat(l).Accu, PDat(l + 1).Accu
  2466.      FOR PDl = 1 TO 2
  2467.       IF PDefs(PDl) = l THEN
  2468.        PDefs(PDl) = PDefs(PDl) + 1
  2469.       ELSEIF PDefs(PDl) = l + 1 THEN
  2470.        PDefs(PDl) = PDefs(PDl) - 1
  2471.       END IF
  2472.      NEXT
  2473.    
  2474.      complete = 0
  2475.     END IF
  2476.    NEXT
  2477.   LOOP UNTIL complete
  2478.  
  2479.   FOR l = 1 TO 2
  2480.    IF Wins(1) <> Wins(2) THEN
  2481.     D = (Wins(l) >= Wins(2 / l))
  2482.     COLOR (D + 2) * 2: LOCATE 6 + D, 7
  2483.    ELSE
  2484.     COLOR 9: LOCATE 4 + l, 7
  2485.    END IF
  2486.    PRINT nam$(l); " "; STRING$(20 - LEN(nam$(l)), "Ä"); ""; Wins(l);
  2487.    IF (Wins(1) <> Wins(2)) THEN
  2488.      IF D = -1 THEN PRINT CHR$(27); "ÄÄÄÄ Winnar!";
  2489.    ELSEIF l = 1 THEN
  2490.     PRINT "   (The game was a draw)";
  2491.    END IF
  2492.    posn = 0: DO: posn = posn + 1: LOOP UNTIL nam$(l) = RTRIM$(PDat(posn).PNam)
  2493.    IF posn > 10 THEN PRINT TAB(54); "(position"; RTRIM$(STR$(posn)); "th)"
  2494.   NEXT
  2495.  END IF
  2496.  
  2497.  'þ Show league table no matter what
  2498.  LOCATE 8, 20: COLOR 9: PRINT "STATISTICS";
  2499.  LOCATE 9, 3: COLOR 2: PRINT "Ú"; STRING$(74, "Ä"); "¿";
  2500.  FOR l = 10 TO 20: LOCATE l, 3: PRINT "³"; TAB(78); "³"; : NEXT
  2501.  LOCATE 21, 3: PRINT "À"; STRING$(74, "Ä"); "Ù";
  2502.  COLOR 3
  2503.  LOCATE 9, 5:  PRINT "Place";
  2504.  LOCATE 9, 12: PRINT "Player";
  2505.  LOCATE 9, 32: PRINT "Rounds";
  2506.  LOCATE 9, 54: PRINT "Mean Accuracy";
  2507.  LOCATE 9, 40: PRINT "Won";
  2508.  
  2509.  COLOR 5: IF P > 9 THEN lim = 10 ELSE lim = P
  2510.  FOR l = 1 TO lim
  2511.   LOCATE l + 10, 6:
  2512.   IF (PDefs(1) = l OR PDefs(2) = l) AND NOT abortYN THEN COLOR 11 ELSE COLOR 5
  2513.   IF l < 10 THEN PRINT "0";
  2514.   PRINT LTRIM$(STR$(l)); " ÄÄ "; TAB(12); PDat(l).PNam
  2515.   COLOR 5: LOCATE l + 10, 31: PRINT PDat(l).Rounds; TAB(39); PDat(l).Won; TAB(45);
  2516.   IF PDat(l).Rounds = 0 THEN
  2517.    PRINT "-"; TAB(53);
  2518.   ELSE
  2519.    IF (PDefs(1) = l OR PDefs(2) = l) AND NOT abortYN THEN COLOR 11 ELSE COLOR 13
  2520.    PRINT ; "("; LTRIM$(RTRIM$(STR$(CINT(PDat(l).Won / PDat(l).Rounds * 100)))); "%)"; TAB(53);
  2521.   END IF
  2522.   COLOR 5
  2523.   IF PDat(l).Accu = 0 THEN
  2524.    PRINT ; " -"
  2525.   ELSE
  2526.    PRINT ; PDat(l).Accu;
  2527.    IF PDat(l).Accu > 1! THEN PRINT "bananas" ELSE PRINT "banana"
  2528.   END IF
  2529.  NEXT
  2530.  
  2531.  'þ Only save stats if they have changed or if file absent
  2532.  IF NOT abortYN OR DoesFileExist = 0 THEN
  2533.   COLOR 5: LOCATE 24, 3: PRINT "Saving stats...";
  2534.  
  2535.   ON ERROR GOTO NoSaveStats
  2536.   IF DoesFileExist = 1 THEN KILL "Gorillas.lge"
  2537.   OPEN "Gorillas.lge" FOR OUTPUT AS #1
  2538.   PRINT #1, P
  2539.   FOR l = 1 TO P
  2540.    PRINT #1, PDat(l).PNam
  2541.    PRINT #1, PDat(l).Rounds, PDat(l).Won, PDat(l).Accu
  2542.   NEXT
  2543.   CLOSE #1
  2544.   DoesFileExist = 1
  2545.   ON ERROR GOTO 0
  2546.  END IF
  2547.  
  2548.  COLOR 15: LOCATE 24, 3: PRINT "Press a key... ";
  2549.  SparklePause (0)
  2550.  
  2551. END SUB
  2552.  
  2553. 'VictoryDance:
  2554. '  gorilla dances after he has eliminated his opponent
  2555. 'Parameters:
  2556. '  Player - which gorilla is dancing
  2557. SUB VictoryDance (Player)
  2558.   FOR i# = 1 TO 4
  2559.     PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET
  2560.     IF GSettings.useSound THEN PLAY "MFO0L32EFGEFDC" ELSE RestReal .2
  2561.     Rest .2
  2562.     PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET
  2563.     IF GSettings.useSound THEN PLAY "MFO0L32EFGEFDC" ELSE RestReal .2
  2564.     Rest .2
  2565.   NEXT
  2566. END SUB
  2567.  
  2568. FUNCTION WhereX (num)
  2569.  
  2570.  WhereX = ((num - 1) MOD 4) * 19 + 3
  2571.  
  2572. END FUNCTION
  2573.  
  2574. FUNCTION WhereY (num)
  2575.  
  2576.  WhereY = INT((num - 1) / 4) + 13
  2577.  
  2578. END FUNCTION
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement