--- /dev/null
+' Q B a s i c G o r i l l a s\r
+'\r
+' Copyright (C) Microsoft Corporation 1990\r
+'\r
+' Your mission is to hit your opponent with the exploding banana\r
+' by varying the angle and power of your throw, taking into account\r
+' wind speed, gravity, and the city skyline.\r
+'\r
+' Speed of this game is determined by the constant SPEEDCONST. If the\r
+' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line\r
+' below. The larger the number the faster the game will go.\r
+'\r
+' To run this game, press Shift+F5.\r
+'\r
+' To exit QBasic, press Alt, F, X.\r
+'\r
+' To get help on a BASIC keyword, move the cursor to the keyword and press\r
+' F1 or click the right mouse button.\r
+'\r
+\r
+'Set default data type to integer for faster game play\r
+DEFINT A-Z\r
+\r
+'Sub Declarations\r
+DECLARE SUB DoSun (Mouth)\r
+DECLARE SUB SetScreen ()\r
+DECLARE SUB EndGame ()\r
+DECLARE SUB Center (Row, Text$)\r
+DECLARE SUB Intro ()\r
+DECLARE SUB SparklePause ()\r
+DECLARE SUB GetInputs (Player1$, Player2$, NumGames)\r
+DECLARE SUB PlayGame (Player1$, Player2$, NumGames)\r
+DECLARE SUB DoExplosion (x#, y#)\r
+DECLARE SUB MakeCityScape (BCoor() AS ANY)\r
+DECLARE SUB PlaceGorillas (BCoor() AS ANY)\r
+DECLARE SUB UpdateScores (Record(), PlayerNum, Results)\r
+DECLARE SUB DrawGorilla (x, y, arms)\r
+DECLARE SUB GorillaIntro (Player1$, Player2$)\r
+DECLARE SUB Rest (t#)\r
+DECLARE SUB VictoryDance (Player)\r
+DECLARE SUB ClearGorillas ()\r
+DECLARE SUB DrawBan (xc#, yc#, r, bc)\r
+DECLARE FUNCTION Scl (n!)\r
+DECLARE FUNCTION GetNum# (Row, Col)\r
+DECLARE FUNCTION DoShot (PlayerNum, x, y)\r
+DECLARE FUNCTION ExplodeGorilla (x#, y#)\r
+DECLARE FUNCTION Getn# (Row, Col)\r
+DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
+DECLARE FUNCTION CalcDelay! ()\r
+\r
+'Make all arrays Dynamic\r
+'$DYNAMIC\r
+\r
+'User-Defined TYPEs\r
+TYPE XYPoint\r
+ XCoor AS INTEGER\r
+ YCoor AS INTEGER\r
+END TYPE\r
+\r
+'Constants\r
+CONST SPEEDCONST = 500\r
+CONST TRUE = -1\r
+CONST FALSE = NOT TRUE\r
+CONST HITSELF = 1\r
+CONST BACKATTR = 0\r
+CONST OBJECTCOLOR = 1\r
+CONST WINDOWCOLOR = 14\r
+CONST SUNATTR = 3\r
+CONST SUNHAPPY = FALSE\r
+CONST SUNSHOCK = TRUE\r
+CONST RIGHTUP = 1\r
+CONST LEFTUP = 2\r
+CONST ARMSDOWN = 3\r
+STOP\r
+END\r
+\r
+\r
+\r
+\r
+ Player1$, Player2$ - player names\r
+' NumGames - number of games to play\r
+SUB PlayGame (Player1$, Player2$, NumGames)\r
+ DIM BCoor(0 TO 30) AS XYPoint\r
+ DIM TotalWins(1 TO 2)\r
+\r
+ J = 1\r
+\r
+ FOR i = 1 TO NumGames\r
+\r
+ CLS\r
+ RANDOMIZE (TIMER)\r
+ CALL MakeCityScape(BCoor())\r
+ CALL PlaceGorillas(BCoor())\r
+ DoSun SUNHAPPY\r
+ Hit = FALSE\r
+ DO WHILE Hit = FALSE\r
+ J = 1 - J\r
+ LOCATE 1, 1\r
+ PRINT Player1$\r
+ LOCATE 1, (MaxCol - 1 - LEN(Player2$))\r
+ PRINT Player2$\r
+ Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2)))\r
+ Tosser = J + 1: Tossee = 3 - J\r
+\r
+ 'Plot the shot. Hit is true if Gorilla gets hit.\r
+ Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser))\r
+\r
+ 'Reset the sun, if it got hit\r
+ IF SunHit THEN DoSun SUNHAPPY\r
+\r
+ IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit)\r
+ LOOP\r
+ SLEEP 1\r
+ NEXT i\r
+\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ COLOR 7, 0\r
+ MaxCol = 80\r
+ CLS\r
+\r
+ Center 8, "GAME OVER!"\r
+ Center 10, "Score:"\r
+ LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1)\r
+ LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2)\r
+ Center 24, "Press any key to continue"\r
+ SparklePause\r
+ COLOR 7, 0\r
+ CLS\r
+END SUB\r
+\r
+'PlayGame:\r
+' Plots banana shot across the screen\r
+'Parameters:\r
+' StartX, StartY - starting shot location\r
+' Angle - shot angle\r
+' Velocity - shot velocity\r
+' PlayerNum - the banana thrower\r
+FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
+\r
+ Angle# = Angle# / 180 * pi# 'Convert degree angle to radians\r
+ Radius = Mode MOD 7\r
+\r
+ InitXVel# = COS(Angle#) * Velocity\r
+ InitYVel# = SIN(Angle#) * Velocity\r
+\r
+ oldx# = StartX\r
+ oldy# = StartY\r
+\r
+ 'draw gorilla toss\r
+ IF PlayerNum = 1 THEN\r
+ PUT (StartX, StartY), GorL&, PSET\r
+ ELSE\r
+ PUT (StartX, StartY), GorR&, PSET\r
+ END IF\r
+\r
+ 'throw sound\r
+ PLAY "MBo0L32A-L64CL16BL64A+"\r
+ Rest .1\r
+\r
+ 'redraw gorilla\r
+ PUT (StartX, StartY), GorD&, PSET\r
+\r
+ adjust = Scl(4) 'For scaling CGA\r
+\r
+ xedge = Scl(9) * (2 - PlayerNum) 'Find leading edge of banana for check\r
+\r
+ Impact = FALSE\r
+ ShotInSun = FALSE\r
+ OnScreen = TRUE\r
+ PlayerHit = 0\r
+ NeedErase = FALSE\r
+\r
+ StartXPos = StartX\r
+ StartYPos = StartY - adjust - 3\r
+\r
+ IF PlayerNum = 2 THEN\r
+ StartXPos = StartXPos + Scl(25)\r
+ direction = Scl(4)\r
+ ELSE\r
+ direction = Scl(-4)\r
+ END IF\r
+\r
+ IF Velocity < 2 THEN 'Shot too slow - hit self\r
+ x# = StartX\r
+ y# = StartY\r
+ pointval = OBJECTCOLOR\r
+ END IF\r
+\r
+ DO WHILE (NOT Impact) AND OnScreen\r
+\r
+ Rest .02\r
+\r
+ 'Erase old banana, if necessary\r
+ IF NeedErase THEN\r
+ NeedErase = FALSE\r
+ CALL DrawBan(oldx#, oldy#, oldrot, FALSE)\r
+ END IF\r
+\r
+ x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)\r
+ y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350)\r
+\r
+ IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN\r
+ OnScreen = FALSE\r
+ END IF\r
+\r
+\r
+ IF OnScreen AND y# > 0 THEN\r
+\r
+ 'check it\r
+ LookY = 0\r
+ LookX = Scl(8 * (2 - PlayerNum))\r
+ DO\r
+ pointval = POINT(x# + LookX, y# + LookY)\r
+ IF pointval = 0 THEN\r
+ Impact = FALSE\r
+ IF ShotInSun = TRUE THEN\r
+ IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE\r
+ END IF\r
+ ELSEIF pointval = SUNATTR AND y# < SunHt THEN\r
+ IF NOT SunHit THEN DoSun SUNSHOCK\r
+ SunHit = TRUE\r
+ ShotInSun = TRUE\r
+ ELSE\r
+ Impact = TRUE\r
+ END IF\r
+ LookX = LookX + direction\r
+ LookY = LookY + Scl(6)\r
+ LOOP UNTIL Impact OR LookX <> Scl(4)\r
+\r
+ IF NOT ShotInSun AND NOT Impact THEN\r
+ 'plot it\r
+ rot = (t# * 10) MOD 4\r
+ CALL DrawBan(x#, y#, rot, TRUE)\r
+ NeedErase = TRUE\r
+ END IF\r
+\r
+ oldx# = x#\r
+ oldy# = y#\r
+ oldrot = rot\r
+\r
+ END IF\r
+\r
+\r
+ t# = t# + .1\r
+\r
+ LOOP\r
+\r
+ IF pointval <> OBJECTCOLOR AND Impact THEN\r
+ CALL DoExplosion(x# + adjust, y# + adjust)\r
+ ELSEIF pointval = OBJECTCOLOR THEN\r
+ PlayerHit = ExplodeGorilla(x#, y#)\r
+ END IF\r
+\r
+ PlotShot = PlayerHit\r
+\r
+END FUNCTION\r
+\r
+'Rest:\r
+' pauses the program\r
+SUB Rest (t#)\r
+ s# = TIMER\r
+ t2# = MachSpeed * t# / SPEEDCONST\r
+ DO\r
+ LOOP UNTIL TIMER - s# > t2#\r
+END SUB\r
+\r
+'Scl:\r
+' Pass the number in to scaling for cga. If the number is a decimal, then we\r
+' want to scale down for cga or scale up for ega. This allows a full range\r
+' of numbers to be generated for scaling.\r
+' (i.e. for 3 to get scaled to 1, pass in 2.9)\r
+FUNCTION Scl (n!)\r
+\r
+ IF n! <> INT(n!) THEN\r
+ IF Mode = 1 THEN n! = n! - 1\r
+ END IF\r
+ IF Mode = 1 THEN\r
+ Scl = CINT(n! / 2 + .1)\r
+ ELSE\r
+ Scl = CINT(n!)\r
+ END IF\r
+\r
+END FUNCTION\r
+\r
+'SetScreen:\r
+' Sets the appropriate color statements\r
+SUB SetScreen\r
+\r
+ IF Mode = 9 THEN\r
+ ExplosionColor = 2\r
+ BackColor = 1\r
+ PALETTE 0, 1\r
+ PALETTE 1, 46\r
+ PALETTE 2, 44\r
+ PALETTE 3, 54\r
+ PALETTE 5, 7\r
+ PALETTE 6, 4\r
+ PALETTE 7, 3\r
+ PALETTE 9, 63 'Display Color\r
+ ELSE\r
+ ExplosionColor = 2\r
+ BackColor = 0\r
+ COLOR BackColor, 2\r
+\r
+ END IF\r
+\r
+END SUB\r
+\r
+'SparklePause:\r
+' Creates flashing border for intro and game over screens\r
+SUB SparklePause\r
+\r
+ COLOR 4, 0\r
+ A$ = "* * * * * * * * * * * * * * * * * "\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ WHILE INKEY$ = ""\r
+ FOR A = 1 TO 5\r
+ LOCATE 1, 1 'print horizontal sparkles\r
+ PRINT MID$(A$, A, 80);\r
+ LOCATE 22, 1\r
+ PRINT MID$(A$, 6 - A, 80);\r
+\r
+ FOR b = 2 TO 21 'Print Vertical sparkles\r
+ c = (A + b) MOD 5\r
+ IF c = 1 THEN\r
+ LOCATE b, 80\r
+ PRINT "*";\r
+ LOCATE 23 - b, 1\r
+ PRINT "*";\r
+ ELSE\r
+ LOCATE b, 80\r
+ PRINT " ";\r
+ LOCATE 23 - b, 1\r
+ PRINT " ";\r
+ END IF\r
+ NEXT b\r
+ NEXT A\r
+ WEND\r
+END SUB\r
+\r
+'UpdateScores:\r
+' Updates players' scores\r
+'Parameters:\r
+' Record - players' scores\r
+' PlayerNum - player\r
+' Results - results of player's shot\r
+SUB UpdateScores (Record(), PlayerNum, Results)\r
+ IF Results = HITSELF THEN\r
+ Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1\r
+ ELSE\r
+ Record(PlayerNum) = Record(PlayerNum) + 1\r
+ END IF\r
+END SUB\r
+\r
+'VictoryDance:\r
+' gorilla dances after he has eliminated his opponent\r
+'Parameters:\r
+' Player - which gorilla is dancing\r
+SUB VictoryDance (Player)\r
+\r
+ FOR i# = 1 TO 4\r
+ PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET\r
+ PLAY "MFO0L32EFGEFDC"\r
+ Rest .2\r
+ PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET\r
+ PLAY "MFO0L32EFGEFDC"\r
+ Rest .2\r
+ NEXT\r
+END SUB\r
+\r
+\1a
\ No newline at end of file
GIT.Harvie.CZ / mirrors / Programs.git / blobdiff