Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1135 lines
29 KiB

  1. ' Q B a s i c G o r i l l a s
  2. '
  3. ' Copyright (C) Microsoft Corporation 1990
  4. '
  5. ' Your mission is to hit your opponent with the exploding banana
  6. ' by varying the angle and power of your throw, taking into account
  7. ' wind speed, gravity, and the city skyline.
  8. '
  9. ' Speed of this game is determined by the constant SPEEDCONST. If the
  10. ' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line
  11. ' below. The larger the number the faster the game will go.
  12. '
  13. ' To run this game, press Shift+F5.
  14. '
  15. ' To exit QBasic, press Alt, F, X.
  16. '
  17. ' To get help on a BASIC keyword, move the cursor to the keyword and press
  18. ' F1 or click the right mouse button.
  19. '
  20. 'Set default data type to integer for faster game play
  21. DEFINT A-Z
  22. 'Sub Declarations
  23. DECLARE SUB DoSun (Mouth)
  24. DECLARE SUB SetScreen ()
  25. DECLARE SUB EndGame ()
  26. DECLARE SUB Center (Row, Text$)
  27. DECLARE SUB Intro ()
  28. DECLARE SUB SparklePause ()
  29. DECLARE SUB GetInputs (Player1$, Player2$, NumGames)
  30. DECLARE SUB PlayGame (Player1$, Player2$, NumGames)
  31. DECLARE SUB DoExplosion (x#, y#)
  32. DECLARE SUB MakeCityScape (BCoor() AS ANY)
  33. DECLARE SUB PlaceGorillas (BCoor() AS ANY)
  34. DECLARE SUB UpdateScores (Record(), PlayerNum, Results)
  35. DECLARE SUB DrawGorilla (x, y, arms)
  36. DECLARE SUB GorillaIntro (Player1$, Player2$)
  37. DECLARE SUB Rest (t#)
  38. DECLARE SUB VictoryDance (Player)
  39. DECLARE SUB ClearGorillas ()
  40. DECLARE SUB DrawBan (xc#, yc#, r, bc)
  41. DECLARE FUNCTION Scl (n!)
  42. DECLARE FUNCTION GetNum# (Row, Col)
  43. DECLARE FUNCTION DoShot (PlayerNum, x, y)
  44. DECLARE FUNCTION ExplodeGorilla (x#, y#)
  45. DECLARE FUNCTION Getn# (Row, Col)
  46. DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)
  47. DECLARE FUNCTION CalcDelay! ()
  48. 'Make all arrays Dynamic
  49. '$DYNAMIC
  50. 'User-Defined TYPEs
  51. TYPE XYPoint
  52. XCoor AS INTEGER
  53. YCoor AS INTEGER
  54. END TYPE
  55. 'Constants
  56. CONST SPEEDCONST = 500
  57. CONST TRUE = -1
  58. CONST FALSE = NOT TRUE
  59. CONST HITSELF = 1
  60. CONST BACKATTR = 0
  61. CONST OBJECTCOLOR = 1
  62. CONST WINDOWCOLOR = 14
  63. CONST SUNATTR = 3
  64. CONST SUNHAPPY = FALSE
  65. CONST SUNSHOCK = TRUE
  66. CONST RIGHTUP = 1
  67. CONST LEFTUP = 2
  68. CONST ARMSDOWN = 3
  69. 'Global Variables
  70. DIM SHARED GorillaX(1 TO 2) 'Location of the two gorillas
  71. DIM SHARED GorillaY(1 TO 2)
  72. DIM SHARED LastBuilding
  73. DIM SHARED pi#
  74. DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of banana
  75. DIM SHARED GorD&(120) 'Graphical picture of Gorilla arms down
  76. DIM SHARED GorL&(120) 'Gorilla left arm raised
  77. DIM SHARED GorR&(120) 'Gorilla right arm raised
  78. DIM SHARED gravity#
  79. DIM SHARED Wind
  80. 'Screen Mode Variables
  81. DIM SHARED ScrHeight
  82. DIM SHARED ScrWidth
  83. DIM SHARED Mode
  84. DIM SHARED MaxCol
  85. 'Screen Color Variables
  86. DIM SHARED ExplosionColor
  87. DIM SHARED SunColor
  88. DIM SHARED BackColor
  89. DIM SHARED SunHit
  90. DIM SHARED SunHt
  91. DIM SHARED GHeight
  92. DIM SHARED MachSpeed AS SINGLE
  93. DEF FnRan (x) = INT(RND(1) * x) + 1
  94. DEF SEG = 0 ' Set NumLock to ON
  95. KeyFlags = PEEK(1047)
  96. IF (KeyFlags AND 32) = 0 THEN
  97. POKE 1047, KeyFlags OR 32
  98. END IF
  99. DEF SEG
  100. GOSUB InitVars
  101. Intro
  102. GetInputs Name1$, Name2$, NumGames
  103. GorillaIntro Name1$, Name2$
  104. PlayGame Name1$, Name2$, NumGames
  105. DEF SEG = 0 ' Restore NumLock state
  106. POKE 1047, KeyFlags
  107. DEF SEG
  108. END
  109. CGABanana:
  110. 'BananaLeft
  111. DATA 327686, -252645316, 60
  112. 'BananaDown
  113. DATA 196618, -1057030081, 49344
  114. 'BananaUp
  115. DATA 196618, -1056980800, 63
  116. 'BananaRight
  117. DATA 327686, 1010580720, 240
  118. EGABanana:
  119. 'BananaLeft
  120. DATA 458758,202116096,471604224,943208448,943208448,943208448,471604224,202116096,0
  121. 'BananaDown
  122. DATA 262153, -2134835200, -2134802239, -2130771968, -2130738945,8323072, 8323199, 4063232, 4063294
  123. 'BananaUp
  124. DATA 262153, 4063232, 4063294, 8323072, 8323199, -2130771968, -2130738945, -2134835200,-2134802239
  125. 'BananaRight
  126. DATA 458758, -1061109760, -522133504, 1886416896, 1886416896, 1886416896,-522133504,-1061109760,0
  127. InitVars:
  128. pi# = 4 * ATN(1#)
  129. 'This is a clever way to pick the best graphics mode available
  130. ON ERROR GOTO ScreenModeError
  131. Mode = 9
  132. SCREEN Mode
  133. ON ERROR GOTO PaletteError
  134. IF Mode = 9 THEN PALETTE 4, 0 'Check for 64K EGA
  135. ON ERROR GOTO 0
  136. MachSpeed = CalcDelay
  137. IF Mode = 9 THEN
  138. ScrWidth = 640
  139. ScrHeight = 350
  140. GHeight = 25
  141. RESTORE EGABanana
  142. REDIM LBan&(8), RBan&(8), UBan&(8), DBan&(8)
  143. FOR i = 0 TO 8
  144. READ LBan&(i)
  145. NEXT i
  146. FOR i = 0 TO 8
  147. READ DBan&(i)
  148. NEXT i
  149. FOR i = 0 TO 8
  150. READ UBan&(i)
  151. NEXT i
  152. FOR i = 0 TO 8
  153. READ RBan&(i)
  154. NEXT i
  155. SunHt = 39
  156. ELSE
  157. ScrWidth = 320
  158. ScrHeight = 200
  159. GHeight = 12
  160. RESTORE CGABanana
  161. REDIM LBan&(2), RBan&(2), UBan&(2), DBan&(2)
  162. REDIM GorL&(20), GorD&(20), GorR&(20)
  163. FOR i = 0 TO 2
  164. READ LBan&(i)
  165. NEXT i
  166. FOR i = 0 TO 2
  167. READ DBan&(i)
  168. NEXT i
  169. FOR i = 0 TO 2
  170. READ UBan&(i)
  171. NEXT i
  172. FOR i = 0 TO 2
  173. READ RBan&(i)
  174. NEXT i
  175. MachSpeed = MachSpeed * 1.3
  176. SunHt = 20
  177. END IF
  178. RETURN
  179. ScreenModeError:
  180. IF Mode = 1 THEN
  181. CLS
  182. LOCATE 10, 5
  183. PRINT "Sorry, you must have CGA, EGA color, or VGA graphics to play GORILLA.BAS"
  184. END
  185. ELSE
  186. Mode = 1
  187. RESUME
  188. END IF
  189. PaletteError:
  190. Mode = 1 '64K EGA cards will run in CGA mode.
  191. RESUME NEXT
  192. REM $STATIC
  193. 'CalcDelay:
  194. ' Checks speed of the machine.
  195. FUNCTION CalcDelay!
  196. s! = TIMER
  197. DO
  198. i! = i! + 1
  199. LOOP UNTIL TIMER - s! >= .5
  200. CalcDelay! = i!
  201. END FUNCTION
  202. ' Center:
  203. ' Centers and prints a text string on a given row
  204. ' Parameters:
  205. ' Row - screen row number
  206. ' Text$ - text to be printed
  207. '
  208. SUB Center (Row, Text$)
  209. Col = MaxCol \ 2
  210. LOCATE Row, Col - (LEN(Text$) / 2 + .5)
  211. PRINT Text$;
  212. END SUB
  213. ' DoExplosion:
  214. ' Produces explosion when a shot is fired
  215. ' Parameters:
  216. ' X#, Y# - location of explosion
  217. '
  218. SUB DoExplosion (x#, y#)
  219. PLAY "MBO0L32EFGEFDC"
  220. Radius = ScrHeight / 50
  221. IF Mode = 9 THEN Inc# = .5 ELSE Inc# = .41
  222. FOR c# = 0 TO Radius STEP Inc#
  223. CIRCLE (x#, y#), c#, ExplosionColor
  224. NEXT c#
  225. FOR c# = Radius TO 0 STEP (-1 * Inc#)
  226. CIRCLE (x#, y#), c#, BACKATTR
  227. FOR i = 1 TO 100
  228. NEXT i
  229. Rest .005
  230. NEXT c#
  231. END SUB
  232. ' DoShot:
  233. ' Controls banana shots by accepting player input and plotting
  234. ' shot angle
  235. ' Parameters:
  236. ' PlayerNum - Player
  237. ' x, y - Player's gorilla position
  238. '
  239. FUNCTION DoShot (PlayerNum, x, y)
  240. 'Input shot
  241. IF PlayerNum = 1 THEN
  242. LocateCol = 1
  243. ELSE
  244. IF Mode = 9 THEN
  245. LocateCol = 66
  246. ELSE
  247. LocateCol = 26
  248. END IF
  249. END IF
  250. LOCATE 2, LocateCol
  251. PRINT "Angle:";
  252. Angle# = GetNum#(2, LocateCol + 7)
  253. LOCATE 3, LocateCol
  254. PRINT "Velocity:";
  255. Velocity = GetNum#(3, LocateCol + 10)
  256. IF PlayerNum = 2 THEN
  257. Angle# = 180 - Angle#
  258. END IF
  259. 'Erase input
  260. FOR i = 1 TO 4
  261. LOCATE i, 1
  262. PRINT SPACE$(30 \ (80 \ MaxCol));
  263. LOCATE i, (50 \ (80 \ MaxCol))
  264. PRINT SPACE$(30 \ (80 \ MaxCol));
  265. NEXT
  266. SunHit = FALSE
  267. PlayerHit = PlotShot(x, y, Angle#, Velocity, PlayerNum)
  268. IF PlayerHit = 0 THEN
  269. DoShot = FALSE
  270. ELSE
  271. DoShot = TRUE
  272. IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum
  273. VictoryDance PlayerNum
  274. END IF
  275. END FUNCTION
  276. ' DoSun:
  277. ' Draws the sun at the top of the screen.
  278. ' Parameters:
  279. ' Mouth - If TRUE draws "O" mouth else draws a smile mouth.
  280. '
  281. SUB DoSun (Mouth)
  282. 'set position of sun
  283. x = ScrWidth \ 2: y = Scl(25)
  284. 'clear old sun
  285. LINE (x - Scl(22), y - Scl(18))-(x + Scl(22), y + Scl(18)), BACKATTR, BF
  286. 'draw new sun:
  287. 'body
  288. CIRCLE (x, y), Scl(12), SUNATTR
  289. PAINT (x, y), SUNATTR
  290. 'rays
  291. LINE (x - Scl(20), y)-(x + Scl(20), y), SUNATTR
  292. LINE (x, y - Scl(15))-(x, y + Scl(15)), SUNATTR
  293. LINE (x - Scl(15), y - Scl(10))-(x + Scl(15), y + Scl(10)), SUNATTR
  294. LINE (x - Scl(15), y + Scl(10))-(x + Scl(15), y - Scl(10)), SUNATTR
  295. LINE (x - Scl(8), y - Scl(13))-(x + Scl(8), y + Scl(13)), SUNATTR
  296. LINE (x - Scl(8), y + Scl(13))-(x + Scl(8), y - Scl(13)), SUNATTR
  297. LINE (x - Scl(18), y - Scl(5))-(x + Scl(18), y + Scl(5)), SUNATTR
  298. LINE (x - Scl(18), y + Scl(5))-(x + Scl(18), y - Scl(5)), SUNATTR
  299. 'mouth
  300. IF Mouth THEN 'draw "o" mouth
  301. CIRCLE (x, y + Scl(5)), Scl(2.9), 0
  302. PAINT (x, y + Scl(5)), 0, 0
  303. ELSE 'draw smile
  304. CIRCLE (x, y), Scl(8), 0, (210 * pi# / 180), (330 * pi# / 180)
  305. END IF
  306. 'eyes
  307. CIRCLE (x - 3, y - 2), 1, 0
  308. CIRCLE (x + 3, y - 2), 1, 0
  309. PSET (x - 3, y - 2), 0
  310. PSET (x + 3, y - 2), 0
  311. END SUB
  312. 'DrawBan:
  313. ' Draws the banana
  314. 'Parameters:
  315. ' xc# - Horizontal Coordinate
  316. ' yc# - Vertical Coordinate
  317. ' r - rotation position (0-3). ( \_/ ) /-\
  318. ' bc - if TRUE then DrawBan draws the banana ELSE it erases the banana
  319. SUB DrawBan (xc#, yc#, r, bc)
  320. SELECT CASE r
  321. CASE 0
  322. IF bc THEN PUT (xc#, yc#), LBan&, PSET ELSE PUT (xc#, yc#), LBan&, XOR
  323. CASE 1
  324. IF bc THEN PUT (xc#, yc#), UBan&, PSET ELSE PUT (xc#, yc#), UBan&, XOR
  325. CASE 2
  326. IF bc THEN PUT (xc#, yc#), DBan&, PSET ELSE PUT (xc#, yc#), DBan&, XOR
  327. CASE 3
  328. IF bc THEN PUT (xc#, yc#), RBan&, PSET ELSE PUT (xc#, yc#), RBan&, XOR
  329. END SELECT
  330. END SUB
  331. 'DrawGorilla:
  332. ' Draws the Gorilla in either CGA or EGA mode
  333. ' and saves the graphics data in an array.
  334. 'Parameters:
  335. ' x - x coordinate of gorilla
  336. ' y - y coordinate of the gorilla
  337. ' arms - either Left up, Right up, or both down
  338. SUB DrawGorilla (x, y, arms)
  339. DIM i AS SINGLE ' Local index must be single precision
  340. 'draw head
  341. LINE (x - Scl(4), y)-(x + Scl(2.9), y + Scl(6)), OBJECTCOLOR, BF
  342. LINE (x - Scl(5), y + Scl(2))-(x + Scl(4), y + Scl(4)), OBJECTCOLOR, BF
  343. 'draw eyes/brow
  344. LINE (x - Scl(3), y + Scl(2))-(x + Scl(2), y + Scl(2)), 0
  345. 'draw nose if ega
  346. IF Mode = 9 THEN
  347. FOR i = -2 TO -1
  348. PSET (x + i, y + 4), 0
  349. PSET (x + i + 3, y + 4), 0
  350. NEXT i
  351. END IF
  352. 'neck
  353. LINE (x - Scl(3), y + Scl(7))-(x + Scl(2), y + Scl(7)), OBJECTCOLOR
  354. 'body
  355. LINE (x - Scl(8), y + Scl(8))-(x + Scl(6.9), y + Scl(14)), OBJECTCOLOR, BF
  356. LINE (x - Scl(6), y + Scl(15))-(x + Scl(4.9), y + Scl(20)), OBJECTCOLOR, BF
  357. 'legs
  358. FOR i = 0 TO 4
  359. CIRCLE (x + Scl(i), y + Scl(25)), Scl(10), OBJECTCOLOR, 3 * pi# / 4, 9 * pi# / 8
  360. CIRCLE (x + Scl(-6) + Scl(i - .1), y + Scl(25)), Scl(10), OBJECTCOLOR, 15 * pi# / 8, pi# / 4
  361. NEXT
  362. 'chest
  363. CIRCLE (x - Scl(4.9), y + Scl(10)), Scl(4.9), 0, 3 * pi# / 2, 0
  364. CIRCLE (x + Scl(4.9), y + Scl(10)), Scl(4.9), 0, pi#, 3 * pi# / 2
  365. FOR i = -5 TO -1
  366. SELECT CASE arms
  367. CASE 1
  368. 'Right arm up
  369. CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
  370. CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(4)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
  371. GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorR&
  372. CASE 2
  373. 'Left arm up
  374. CIRCLE (x + Scl(i - .1), y + Scl(4)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
  375. CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
  376. GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorL&
  377. CASE 3
  378. 'Both arms down
  379. CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
  380. CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
  381. GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorD&
  382. END SELECT
  383. NEXT i
  384. END SUB
  385. 'ExplodeGorilla:
  386. ' Causes gorilla explosion when a direct hit occurs
  387. 'Parameters:
  388. ' X#, Y# - shot location
  389. FUNCTION ExplodeGorilla (x#, y#)
  390. YAdj = Scl(12)
  391. XAdj = Scl(5)
  392. SclX# = ScrWidth / 320
  393. SclY# = ScrHeight / 200
  394. IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2
  395. PLAY "MBO0L16EFGEFDC"
  396. FOR i = 1 TO 8 * SclX#
  397. CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), i, ExplosionColor, , , -1.57
  398. LINE (GorillaX(PlayerHit) + 7 * SclX#, GorillaY(PlayerHit) + 9 * SclY# - i)-(GorillaX(PlayerHit), GorillaY(PlayerHit) + 9 * SclY# - i), ExplosionColor
  399. NEXT i
  400. FOR i = 1 TO 16 * SclX#
  401. IF i < (8 * SclX#) THEN CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), (8 * SclX# + 1) - i, BACKATTR, , , -1.57
  402. CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57
  403. NEXT i
  404. FOR i = 24 * SclX# TO 1 STEP -1
  405. CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, BACKATTR, , , -1.57
  406. FOR Count = 1 TO 200
  407. NEXT
  408. NEXT i
  409. ExplodeGorilla = PlayerHit
  410. END FUNCTION
  411. 'GetInputs:
  412. ' Gets user inputs at beginning of game
  413. 'Parameters:
  414. ' Player1$, Player2$ - player names
  415. ' NumGames - number of games to play
  416. SUB GetInputs (Player1$, Player2$, NumGames)
  417. COLOR 7, 0
  418. CLS
  419. LOCATE 8, 15
  420. LINE INPUT "Name of Player 1 (Default = 'Player 1'): "; Player1$
  421. IF Player1$ = "" THEN
  422. Player1$ = "Player 1"
  423. ELSE
  424. Player1$ = LEFT$(Player1$, 10)
  425. END IF
  426. LOCATE 10, 15
  427. LINE INPUT "Name of Player 2 (Default = 'Player 2'): "; Player2$
  428. IF Player2$ = "" THEN
  429. Player2$ = "Player 2"
  430. ELSE
  431. Player2$ = LEFT$(Player2$, 10)
  432. END IF
  433. DO
  434. LOCATE 12, 56: PRINT SPACE$(25);
  435. LOCATE 12, 13
  436. INPUT "Play to how many total points (Default = 3)"; game$
  437. NumGames = VAL(LEFT$(game$, 2))
  438. LOOP UNTIL NumGames > 0 AND LEN(game$) < 3 OR LEN(game$) = 0
  439. IF NumGames = 0 THEN NumGames = 3
  440. DO
  441. LOCATE 14, 53: PRINT SPACE$(28);
  442. LOCATE 14, 17
  443. INPUT "Gravity in Meters/Sec (Earth = 9.8)"; grav$
  444. gravity# = VAL(grav$)
  445. LOOP UNTIL gravity# > 0 OR LEN(grav$) = 0
  446. IF gravity# = 0 THEN gravity# = 9.8
  447. END SUB
  448. 'GetNum:
  449. ' Gets valid numeric input from user
  450. 'Parameters:
  451. ' Row, Col - location to echo input
  452. FUNCTION GetNum# (Row, Col)
  453. Result$ = ""
  454. Done = FALSE
  455. WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
  456. DO WHILE NOT Done
  457. LOCATE Row, Col
  458. PRINT Result$; CHR$(95); " ";
  459. Kbd$ = INKEY$
  460. SELECT CASE Kbd$
  461. CASE "0" TO "9"
  462. Result$ = Result$ + Kbd$
  463. CASE "."
  464. IF INSTR(Result$, ".") = 0 THEN
  465. Result$ = Result$ + Kbd$
  466. END IF
  467. CASE CHR$(13)
  468. IF VAL(Result$) > 360 THEN
  469. Result$ = ""
  470. ELSE
  471. Done = TRUE
  472. END IF
  473. CASE CHR$(8)
  474. IF LEN(Result$) > 0 THEN
  475. Result$ = LEFT$(Result$, LEN(Result$) - 1)
  476. END IF
  477. CASE ELSE
  478. IF LEN(Kbd$) > 0 THEN
  479. BEEP
  480. END IF
  481. END SELECT
  482. LOOP
  483. LOCATE Row, Col
  484. PRINT Result$; " ";
  485. GetNum# = VAL(Result$)
  486. END FUNCTION
  487. 'GorillaIntro:
  488. ' Displays gorillas on screen for the first time
  489. ' allows the graphical data to be put into an array
  490. 'Parameters:
  491. ' Player1$, Player2$ - The names of the players
  492. '
  493. SUB GorillaIntro (Player1$, Player2$)
  494. LOCATE 16, 34: PRINT "--------------"
  495. LOCATE 18, 34: PRINT "V = View Intro"
  496. LOCATE 19, 34: PRINT "P = Play Game"
  497. LOCATE 21, 35: PRINT "Your Choice?"
  498. DO WHILE Char$ = ""
  499. Char$ = INKEY$
  500. LOOP
  501. IF Mode = 1 THEN
  502. x = 125
  503. y = 100
  504. ELSE
  505. x = 278
  506. y = 175
  507. END IF
  508. SCREEN Mode
  509. SetScreen
  510. IF Mode = 1 THEN Center 5, "Please wait while gorillas are drawn."
  511. VIEW PRINT 9 TO 24
  512. IF Mode = 9 THEN PALETTE OBJECTCOLOR, BackColor
  513. DrawGorilla x, y, ARMSDOWN
  514. CLS 2
  515. DrawGorilla x, y, LEFTUP
  516. CLS 2
  517. DrawGorilla x, y, RIGHTUP
  518. CLS 2
  519. VIEW PRINT 1 TO 25
  520. IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46
  521. IF UCASE$(Char$) = "V" THEN
  522. Center 2, "Q B A S I C G O R I L L A S"
  523. Center 5, " STARRING: "
  524. P$ = Player1$ + " AND " + Player2$
  525. Center 7, P$
  526. PUT (x - 13, y), GorD&, PSET
  527. PUT (x + 47, y), GorD&, PSET
  528. Rest 1
  529. PUT (x - 13, y), GorL&, PSET
  530. PUT (x + 47, y), GorR&, PSET
  531. PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b"
  532. Rest .3
  533. PUT (x - 13, y), GorR&, PSET
  534. PUT (x + 47, y), GorL&, PSET
  535. PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-"
  536. Rest .3
  537. PUT (x - 13, y), GorL&, PSET
  538. PUT (x + 47, y), GorR&, PSET
  539. PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-"
  540. Rest .3
  541. PUT (x - 13, y), GorR&, PSET
  542. PUT (x + 47, y), GorL&, PSET
  543. PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b"
  544. Rest .3
  545. FOR i = 1 TO 4
  546. PUT (x - 13, y), GorL&, PSET
  547. PUT (x + 47, y), GorR&, PSET
  548. PLAY "T160O0L32EFGEFDC"
  549. Rest .1
  550. PUT (x - 13, y), GorR&, PSET
  551. PUT (x + 47, y), GorL&, PSET
  552. PLAY "T160O0L32EFGEFDC"
  553. Rest .1
  554. NEXT
  555. END IF
  556. END SUB
  557. 'Intro:
  558. ' Displays game introduction
  559. SUB Intro
  560. SCREEN 0
  561. WIDTH 80, 25
  562. MaxCol = 80
  563. COLOR 15, 0
  564. CLS
  565. Center 4, "Q B a s i c G O R I L L A S"
  566. COLOR 7
  567. Center 6, "Copyright (C) Microsoft Corporation 1990"
  568. Center 8, "Your mission is to hit your opponent with the exploding"
  569. Center 9, "banana by varying the angle and power of your throw, taking"
  570. Center 10, "into account wind speed, gravity, and the city skyline."
  571. Center 11, "The wind speed is shown by a directional arrow at the bottom"
  572. Center 12, "of the playing field, its length relative to its strength."
  573. Center 24, "Press any key to continue"
  574. PLAY "MBT160O1L8CDEDCDL4ECC"
  575. SparklePause
  576. IF Mode = 1 THEN MaxCol = 40
  577. END SUB
  578. 'MakeCityScape:
  579. ' Creates random skyline for game
  580. 'Parameters:
  581. ' BCoor() - a user-defined type array which stores the coordinates of
  582. ' the upper left corner of each building.
  583. SUB MakeCityScape (BCoor() AS XYPoint)
  584. x = 2
  585. 'Set the sloping trend of the city scape. NewHt is new building height
  586. Slope = FnRan(6)
  587. SELECT CASE Slope
  588. CASE 1: NewHt = 15 'Upward slope
  589. CASE 2: NewHt = 130 'Downward slope
  590. CASE 3 TO 5: NewHt = 15 '"V" slope - most common
  591. CASE 6: NewHt = 130 'Inverted "V" slope
  592. END SELECT
  593. IF Mode = 9 THEN
  594. BottomLine = 335 'Bottom of building
  595. HtInc = 10 'Increase value for new height
  596. DefBWidth = 37 'Default building height
  597. RandomHeight = 120 'Random height difference
  598. WWidth = 3 'Window width
  599. WHeight = 6 'Window height
  600. WDifV = 15 'Counter for window spacing - vertical
  601. WDifh = 10 'Counter for window spacing - horizontal
  602. ELSE
  603. BottomLine = 190
  604. HtInc = 6
  605. NewHt = NewHt * 20 \ 35 'Adjust for CGA
  606. DefBWidth = 18
  607. RandomHeight = 54
  608. WWidth = 1
  609. WHeight = 2
  610. WDifV = 5
  611. WDifh = 4
  612. END IF
  613. CurBuilding = 1
  614. DO
  615. SELECT CASE Slope
  616. CASE 1
  617. NewHt = NewHt + HtInc
  618. CASE 2
  619. NewHt = NewHt - HtInc
  620. CASE 3 TO 5
  621. IF x > ScrWidth \ 2 THEN
  622. NewHt = NewHt - 2 * HtInc
  623. ELSE
  624. NewHt = NewHt + 2 * HtInc
  625. END IF
  626. CASE 4
  627. IF x > ScrWidth \ 2 THEN
  628. NewHt = NewHt + 2 * HtInc
  629. ELSE
  630. NewHt = NewHt - 2 * HtInc
  631. END IF
  632. END SELECT
  633. 'Set width of building and check to see if it would go off the screen
  634. BWidth = FnRan(DefBWidth) + DefBWidth
  635. IF x + BWidth > ScrWidth THEN BWidth = ScrWidth - x - 2
  636. 'Set height of building and check to see if it goes below screen
  637. BHeight = FnRan(RandomHeight) + NewHt
  638. IF BHeight < HtInc THEN BHeight = HtInc
  639. 'Check to see if Building is too high
  640. IF BottomLine - BHeight <= MaxHeight + GHeight THEN BHeight = MaxHeight + GHeight - 5
  641. 'Set the coordinates of the building into the array
  642. BCoor(CurBuilding).XCoor = x
  643. BCoor(CurBuilding).YCoor = BottomLine - BHeight
  644. IF Mode = 9 THEN BuildingColor = FnRan(3) + 4 ELSE BuildingColor = 2
  645. 'Draw the building, outline first, then filled
  646. LINE (x - 1, BottomLine + 1)-(x + BWidth + 1, BottomLine - BHeight - 1), BACKGROUND, B
  647. LINE (x, BottomLine)-(x + BWidth, BottomLine - BHeight), BuildingColor, BF
  648. 'Draw the windows
  649. c = x + 3
  650. DO
  651. FOR i = BHeight - 3 TO 7 STEP -WDifV
  652. IF Mode <> 9 THEN
  653. WinColr = (FnRan(2) - 2) * -3
  654. ELSEIF FnRan(4) = 1 THEN
  655. WinColr = 8
  656. ELSE
  657. WinColr = WINDOWCOLOR
  658. END IF
  659. LINE (c, BottomLine - i)-(c + WWidth, BottomLine - i + WHeight), WinColr, BF
  660. NEXT
  661. c = c + WDifh
  662. LOOP UNTIL c >= x + BWidth - 3
  663. x = x + BWidth + 2
  664. CurBuilding = CurBuilding + 1
  665. LOOP UNTIL x > ScrWidth - HtInc
  666. LastBuilding = CurBuilding - 1
  667. 'Set Wind speed
  668. Wind = FnRan(10) - 5
  669. IF FnRan(3) = 1 THEN
  670. IF Wind > 0 THEN
  671. Wind = Wind + FnRan(10)
  672. ELSE
  673. Wind = Wind - FnRan(10)
  674. END IF
  675. END IF
  676. 'Draw Wind speed arrow
  677. IF Wind <> 0 THEN
  678. WindLine = Wind * 3 * (ScrWidth \ 320)
  679. LINE (ScrWidth \ 2, ScrHeight - 5)-(ScrWidth \ 2 + WindLine, ScrHeight - 5), ExplosionColor
  680. IF Wind > 0 THEN ArrowDir = -2 ELSE ArrowDir = 2
  681. LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 - 2), ExplosionColor
  682. LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 + 2), ExplosionColor
  683. END IF
  684. END SUB
  685. 'PlaceGorillas:
  686. ' PUTs the Gorillas on top of the buildings. Must have drawn
  687. ' Gorillas first.
  688. 'Parameters:
  689. ' BCoor() - user-defined TYPE array which stores upper left coordinates
  690. ' of each building.
  691. SUB PlaceGorillas (BCoor() AS XYPoint)
  692. IF Mode = 9 THEN
  693. XAdj = 14
  694. YAdj = 30
  695. ELSE
  696. XAdj = 7
  697. YAdj = 16
  698. END IF
  699. SclX# = ScrWidth / 320
  700. SclY# = ScrHeight / 200
  701. 'Place gorillas on second or third building from edge
  702. FOR i = 1 TO 2
  703. IF i = 1 THEN BNum = FnRan(2) + 1 ELSE BNum = LastBuilding - FnRan(2)
  704. BWidth = BCoor(BNum + 1).XCoor - BCoor(BNum).XCoor
  705. GorillaX(i) = BCoor(BNum).XCoor + BWidth / 2 - XAdj
  706. GorillaY(i) = BCoor(BNum).YCoor - YAdj
  707. PUT (GorillaX(i), GorillaY(i)), GorD&, PSET
  708. NEXT i
  709. END SUB
  710. 'PlayGame:
  711. ' Main game play routine
  712. 'Parameters:
  713. ' Player1$, Player2$ - player names
  714. ' NumGames - number of games to play
  715. SUB PlayGame (Player1$, Player2$, NumGames)
  716. DIM BCoor(0 TO 30) AS XYPoint
  717. DIM TotalWins(1 TO 2)
  718. J = 1
  719. FOR i = 1 TO NumGames
  720. CLS
  721. RANDOMIZE (TIMER)
  722. CALL MakeCityScape(BCoor())
  723. CALL PlaceGorillas(BCoor())
  724. DoSun SUNHAPPY
  725. Hit = FALSE
  726. DO WHILE Hit = FALSE
  727. J = 1 - J
  728. LOCATE 1, 1
  729. PRINT Player1$
  730. LOCATE 1, (MaxCol - 1 - LEN(Player2$))
  731. PRINT Player2$
  732. Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2)))
  733. Tosser = J + 1: Tossee = 3 - J
  734. 'Plot the shot. Hit is true if Gorilla gets hit.
  735. Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser))
  736. 'Reset the sun, if it got hit
  737. IF SunHit THEN DoSun SUNHAPPY
  738. IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit)
  739. LOOP
  740. SLEEP 1
  741. NEXT i
  742. SCREEN 0
  743. WIDTH 80, 25
  744. COLOR 7, 0
  745. MaxCol = 80
  746. CLS
  747. Center 8, "GAME OVER!"
  748. Center 10, "Score:"
  749. LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1)
  750. LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2)
  751. Center 24, "Press any key to continue"
  752. SparklePause
  753. COLOR 7, 0
  754. CLS
  755. END SUB
  756. 'PlayGame:
  757. ' Plots banana shot across the screen
  758. 'Parameters:
  759. ' StartX, StartY - starting shot location
  760. ' Angle - shot angle
  761. ' Velocity - shot velocity
  762. ' PlayerNum - the banana thrower
  763. FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)
  764. Angle# = Angle# / 180 * pi# 'Convert degree angle to radians
  765. Radius = Mode MOD 7
  766. InitXVel# = COS(Angle#) * Velocity
  767. InitYVel# = SIN(Angle#) * Velocity
  768. oldx# = StartX
  769. oldy# = StartY
  770. 'draw gorilla toss
  771. IF PlayerNum = 1 THEN
  772. PUT (StartX, StartY), GorL&, PSET
  773. ELSE
  774. PUT (StartX, StartY), GorR&, PSET
  775. END IF
  776. 'throw sound
  777. PLAY "MBo0L32A-L64CL16BL64A+"
  778. Rest .1
  779. 'redraw gorilla
  780. PUT (StartX, StartY), GorD&, PSET
  781. adjust = Scl(4) 'For scaling CGA
  782. xedge = Scl(9) * (2 - PlayerNum) 'Find leading edge of banana for check
  783. Impact = FALSE
  784. ShotInSun = FALSE
  785. OnScreen = TRUE
  786. PlayerHit = 0
  787. NeedErase = FALSE
  788. StartXPos = StartX
  789. StartYPos = StartY - adjust - 3
  790. IF PlayerNum = 2 THEN
  791. StartXPos = StartXPos + Scl(25)
  792. direction = Scl(4)
  793. ELSE
  794. direction = Scl(-4)
  795. END IF
  796. IF Velocity < 2 THEN 'Shot too slow - hit self
  797. x# = StartX
  798. y# = StartY
  799. pointval = OBJECTCOLOR
  800. END IF
  801. DO WHILE (NOT Impact) AND OnScreen
  802. Rest .02
  803. 'Erase old banana, if necessary
  804. IF NeedErase THEN
  805. NeedErase = FALSE
  806. CALL DrawBan(oldx#, oldy#, oldrot, FALSE)
  807. END IF
  808. x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)
  809. y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350)
  810. IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN
  811. OnScreen = FALSE
  812. END IF
  813. IF OnScreen AND y# > 0 THEN
  814. 'check it
  815. LookY = 0
  816. LookX = Scl(8 * (2 - PlayerNum))
  817. DO
  818. pointval = POINT(x# + LookX, y# + LookY)
  819. IF pointval = 0 THEN
  820. Impact = FALSE
  821. IF ShotInSun = TRUE THEN
  822. IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE
  823. END IF
  824. ELSEIF pointval = SUNATTR AND y# < SunHt THEN
  825. IF NOT SunHit THEN DoSun SUNSHOCK
  826. SunHit = TRUE
  827. ShotInSun = TRUE
  828. ELSE
  829. Impact = TRUE
  830. END IF
  831. LookX = LookX + direction
  832. LookY = LookY + Scl(6)
  833. LOOP UNTIL Impact OR LookX <> Scl(4)
  834. IF NOT ShotInSun AND NOT Impact THEN
  835. 'plot it
  836. rot = (t# * 10) MOD 4
  837. CALL DrawBan(x#, y#, rot, TRUE)
  838. NeedErase = TRUE
  839. END IF
  840. oldx# = x#
  841. oldy# = y#
  842. oldrot = rot
  843. END IF
  844. t# = t# + .1
  845. LOOP
  846. IF pointval <> OBJECTCOLOR AND Impact THEN
  847. CALL DoExplosion(x# + adjust, y# + adjust)
  848. ELSEIF pointval = OBJECTCOLOR THEN
  849. PlayerHit = ExplodeGorilla(x#, y#)
  850. END IF
  851. PlotShot = PlayerHit
  852. END FUNCTION
  853. 'Rest:
  854. ' pauses the program
  855. SUB Rest (t#)
  856. s# = TIMER
  857. t2# = MachSpeed * t# / SPEEDCONST
  858. DO
  859. LOOP UNTIL TIMER - s# > t2#
  860. END SUB
  861. 'Scl:
  862. ' Pass the number in to scaling for cga. If the number is a decimal, then we
  863. ' want to scale down for cga or scale up for ega. This allows a full range
  864. ' of numbers to be generated for scaling.
  865. ' (i.e. for 3 to get scaled to 1, pass in 2.9)
  866. FUNCTION Scl (n!)
  867. IF n! <> INT(n!) THEN
  868. IF Mode = 1 THEN n! = n! - 1
  869. END IF
  870. IF Mode = 1 THEN
  871. Scl = CINT(n! / 2 + .1)
  872. ELSE
  873. Scl = CINT(n!)
  874. END IF
  875. END FUNCTION
  876. 'SetScreen:
  877. ' Sets the appropriate color statements
  878. SUB SetScreen
  879. IF Mode = 9 THEN
  880. ExplosionColor = 2
  881. BackColor = 1
  882. PALETTE 0, 1
  883. PALETTE 1, 46
  884. PALETTE 2, 44
  885. PALETTE 3, 54
  886. PALETTE 5, 7
  887. PALETTE 6, 4
  888. PALETTE 7, 3
  889. PALETTE 9, 63 'Display Color
  890. ELSE
  891. ExplosionColor = 2
  892. BackColor = 0
  893. COLOR BackColor, 2
  894. END IF
  895. END SUB
  896. 'SparklePause:
  897. ' Creates flashing border for intro and game over screens
  898. SUB SparklePause
  899. COLOR 4, 0
  900. A$ = "* * * * * * * * * * * * * * * * * "
  901. WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
  902. WHILE INKEY$ = ""
  903. FOR A = 1 TO 5
  904. LOCATE 1, 1 'print horizontal sparkles
  905. PRINT MID$(A$, A, 80);
  906. LOCATE 22, 1
  907. PRINT MID$(A$, 6 - A, 80);
  908. FOR b = 2 TO 21 'Print Vertical sparkles
  909. c = (A + b) MOD 5
  910. IF c = 1 THEN
  911. LOCATE b, 80
  912. PRINT "*";
  913. LOCATE 23 - b, 1
  914. PRINT "*";
  915. ELSE
  916. LOCATE b, 80
  917. PRINT " ";
  918. LOCATE 23 - b, 1
  919. PRINT " ";
  920. END IF
  921. NEXT b
  922. NEXT A
  923. WEND
  924. END SUB
  925. 'UpdateScores:
  926. ' Updates players' scores
  927. 'Parameters:
  928. ' Record - players' scores
  929. ' PlayerNum - player
  930. ' Results - results of player's shot
  931. SUB UpdateScores (Record(), PlayerNum, Results)
  932. IF Results = HITSELF THEN
  933. Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1
  934. ELSE
  935. Record(PlayerNum) = Record(PlayerNum) + 1
  936. END IF
  937. END SUB
  938. 'VictoryDance:
  939. ' gorilla dances after he has eliminated his opponent
  940. 'Parameters:
  941. ' Player - which gorilla is dancing
  942. SUB VictoryDance (Player)
  943. FOR i# = 1 TO 4
  944. PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET
  945. PLAY "MFO0L32EFGEFDC"
  946. Rest .2
  947. PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET
  948. PLAY "MFO0L32EFGEFDC"
  949. Rest .2
  950. NEXT
  951. END SUB