home *** CD-ROM | disk | FTP | other *** search
/ The CIA World Factbook 1992 / k3bimage.iso / sel / 01 / 0018 / beehive.bas (.txt) next >
Encoding:
GW-BASIC  |  1991-12-02  |  5.8 KB  |  197 lines
  1. 10  KEY OFF:DEF SEG=0:POKE 1047,PEEK(1047) OR 64:GOTO 20
  2. 20  GOSUB 350
  3. 30  GOSUB 650
  4. 40  REM START
  5. 50  RANDOMIZE TIMER
  6. 60  WINNER=0:PREV.PLAYER=0:ROW=6:COL=6:CB=146:RB=89
  7. 70  PLAYER=INT(2*RND+1)
  8. 80  LOCATE 12,11:PRINT "Please wait a moment"
  9. 90  FOR J=1 TO 11:FOR K=1 TO 11:HIVE%(J,K)=0:NEXT K:NEXT J
  10. 100  FOR J=1 TO 20:PATHLEN(J)=0:NEXT J
  11. 110  FOR J=1 TO 65:PATH%(J)=0:USED%(J)=0:NODE%(J)=0:NEXT J
  12. 120  GOSUB 700:LOCATE 24,1:PRINT "Player:";
  13. 130  REM MAIN
  14. 140  IF PREV.PLAYER=PLAYER THEN 170
  15. 150  LOCATE 24,8:PRINT "               ";:LOCATE 24,8:PRINT PLAYER$(PLAYER);:IF PLAYER=1 THEN PUT (270,130),EYES1,PSET ELSE PUT (270,130),EYES2,PSET
  16. 160  PREV.PLAYER=PLAYER
  17. 170  PUT (CB,RB),BEE
  18. 180  DEF SEG=0:POKE 1050,PEEK(1052)
  19. 190  A$=RIGHT$(INKEY$,1):IF LEN(A$)=0 THEN 190
  20. 200  PUT (CB,RB),BEE:OCOL=COL:OROW=ROW
  21. 210  IF A$=CHR$(77) THEN ROW=ROW+1:COL=COL+1:IF ROW>11 OR COL>11 THEN ROW=OROW:COL=OCOL ELSE RB=RB+15:CB=CB+9
  22. 220  IF A$=CHR$(75) THEN ROW=ROW-1:COL=COL-1:IF ROW<1 OR COL<1 THEN ROW=OROW:COL=OCOL ELSE RB=RB-15:CB=CB-9
  23. 230  IF A$=CHR$(72) THEN ROW=ROW-1-(ROW=1):IF ROW<>OROW THEN CB=CB+9:RB=RB-15
  24. 240  IF A$=CHR$(80) THEN ROW=ROW+1+(ROW=11):IF ROW<>OROW THEN CB=CB-9:RB=RB+15
  25. 250  PUT (CB,RB),BEE
  26. 260  IF A$=" " THEN GOSUB 1050 ELSE 180
  27. 270  IF USED THEN PUT (CB,RB),BEE:GOTO 140
  28. 280  OROW=ROW:OCOL=COL:GOSUB 1110
  29. 290  IF POSSIBLE=1 THEN GOSUB 1290
  30. 300  IF WINNER=1 THEN 1880
  31. 310  LOCATE 24,1:PRINT "Player:";
  32. 320  IF PLAYER=1 THEN PLAYER=2 ELSE PLAYER=1
  33. 330  ROW=OROW:COL=OCOL:GOTO 140
  34. 340  REM INIT
  35. 350  CLS:COLR(1)=2:COLR(2)=3
  36. 360  DIM ROW.INC%(6),COL.INC%(6)
  37. 370  FOR J=1 TO 6:READ ROW.INC%(J),COL.INC%(J):NEXT J
  38. 380  DATA -1,-1,0,1,1,1,1,0,0,-1,-1,-1
  39. 390  DIM HIVE%(11,11)
  40. 400  DIM USED%(65),NODE%(65),PATH%(65),PATHLEN(20)
  41. 410  SCREEN 1:COLOR 1,2:DEFINT B
  42. 420  DIM HEXA(100),BALL1(100),BALL2(100),EYES1(100),EYES2(100)
  43. 430  LINE (30,10)-(21,15),3:LINE-STEP (0,10),3:LINE-STEP (9,5),3
  44. 440  LINE-STEP (9,-5),3:LINE-STEP (0,-10),3:LINE-STEP (-9,-5),3
  45. 450  LINE (30,11)-(22,16),2:LINE-STEP (0,9),2:LINE-STEP (8,4),2
  46. 460  LINE-STEP (7,-4),6:LINE-STEP (0,-10),6:LINE-STEP (-7,-4),6
  47. 470  GET (21,10)-(39,30),HEXA
  48. 480  CLS:CIRCLE (30,20),5,COLR(1):PAINT (30,20),COLR(1):GET (25,16)-(35,24),BALL1
  49. 490  GOSUB 580:GET (23,12)-(37,25),EYES1
  50. 500  CLS:CIRCLE (30,20),5,COLR(2):PAINT (30,20),COLR(2):GET (25,16)-(35,24),BALL2
  51. 510  GOSUB 580:GET (23,12)-(37,25),EYES2:CLS
  52. 520  READ X,Y:E=(4+INT((X+7)/8)*Y)/2:DIM BEE(E):BEE(0)=X:BEE(1)=Y:FOR I=2 TO E:READ A$:BEE(I)=VAL("&H"+A$):NEXT
  53. 530  DATA 26,8,828,A,5AA,802A,95AA,80AA
  54. 540  DATA 952A,AA,8002,A0,1500,0,0,0
  55. 550  DATA 500,0,0
  56. 560  RETURN
  57. 570  REM PARTS
  58. 580  CIRCLE (26,19),2,1:CIRCLE (34,19),2,1
  59. 590  PAINT (26,19),1:PAINT (34,19),1
  60. 600  PSET (29,17):LINE-STEP (-2.5,-5):LINE-STEP (-2.5,3)
  61. 610  PSET (31,17):LINE-STEP (2.5,-5):LINE-STEP (2.5,3)
  62. 620  CIRCLE (30,24),1,1:PAINT (30,24),1
  63. 630  RETURN
  64. 640  REM GETNAMES
  65. 650  LOCATE 12,16:PRINT "BeeHive":PUT (84,84),EYES1:PUT (192,86),EYES2
  66. 660  FOR I=1 TO 2:LOCATE 19+I*2-1,6:PRINT "Player"I"'s name";
  67. 670  INPUT PLAYER$(I):PLAYER$(I)=LEFT$(PLAYER$(I),15):NEXT I
  68. 680  CLS:RETURN
  69. 690  REM DRAWSCREEN
  70. 700  CLS:Y=7
  71. 710  FOR R=1 TO 11
  72. 720  X=90-R*9
  73. 730  FOR C=1 TO 11
  74. 740  X=X+18
  75. 750  PUT (X,Y),HEXA,OR
  76. 760  NEXT C
  77. 770  Y=Y+15
  78. 780  NEXT R
  79. 790  PSET (297,12),2:GOSUB 930:LINE-STEP (0,10),2
  80. 800  PSET (298,12),2:GOSUB 930:LINE-STEP (0,10),2
  81. 810  PSET (299,12),2:GOSUB 930:LINE-STEP (0,10),2
  82. 820  PSET (96,12),2:GOSUB 930:LINE-STEP (0,10),2
  83. 830  PSET (97,12),2:GOSUB 930:LINE-STEP (0,10),2
  84. 840  PSET (98,12),2:GOSUB 930:LINE-STEP (0,10),2
  85. 850  Y1=-5:Y2=5:PSET (99,9),3:GOSUB 990
  86. 860  PSET (99,10),3:GOSUB 990
  87. 870  PSET (100,11),3:GOSUB 990
  88. 880  Y1=5:Y2=-5:PSET (9,173),3:GOSUB 990
  89. 890  PSET (9,174),3:GOSUB 990
  90. 900  PSET (9,175),3:GOSUB 990
  91. 910  RETURN
  92. 920  REM UPNDOWN
  93. 930  FOR J=1 TO 10
  94. 940  LINE-STEP (0,10),COLR(1)
  95. 950  LINE-STEP (-9,5),COLR(1)
  96. 960  NEXT J
  97. 970  RETURN
  98. 980  REM ACROSS
  99. 990  FOR J= 1 TO 11
  100. 1000  LINE-STEP (9,Y1),COLR(2)
  101. 1010  LINE-STEP (9,Y2),COLR(2)
  102. 1020  NEXT J
  103. 1030  RETURN
  104. 1040  REM SET PIECE
  105. 1050  USED=0
  106. 1060  IF HIVE%(ROW,COL)<>0 THEN USED=1:RETURN
  107. 1070  HIVE%(ROW,COL)=PLAYER
  108. 1080  PUT (CB,RB),BEE:IF PLAYER=1 THEN PUT(CB+1,RB-1),BALL1 ELSE PUT(CB+1,RB-1),BALL2
  109. 1090  RETURN
  110. 1100  REM CHECKLINE
  111. 1110  POSSIBLE=1
  112. 1120  IF PLAYER=1 THEN 1200
  113. 1130  FOR ROW=1 TO 6:FF=0:FB=0
  114. 1140  FOR COL=1 TO 11
  115. 1150  IF HIVE%(ROW,COL)=PLAYER THEN FF=1
  116. 1160  IF HIVE%(12-ROW,COL)=PLAYER THEN FB=1
  117. 1170  NEXT COL
  118. 1180  IF FF=0 OR FB=0 THEN POSSIBLE=0:ROW=6
  119. 1190  NEXT ROW:RETURN
  120. 1200  FOR COL=1 TO 6:FF=0:FB=0
  121. 1210  FOR ROW=1 TO 11
  122. 1220  IF HIVE%(ROW,COL)=PLAYER THEN FF=1
  123. 1230  IF HIVE%(ROW,12-COL)=PLAYER THEN FB=1
  124. 1240  NEXT ROW
  125. 1250  IF FF=0 OR FB=0 THEN POSSIBLE=0:COL=6
  126. 1260  NEXT COL
  127. 1270  RETURN
  128. 1280  REM CHECKWINNER
  129. 1290  LOCATE 24,1:PRINT "Checking...           ";
  130. 1300  USED.CNTR=0:WINNER=0:NODE.CNTR=0:NODE.TOTAL=0:COUNTER=0
  131. 1310  IF PLAYER=1 THEN 1440
  132. 1320  FOR COL=1 TO 11:ROW=1
  133. 1330  IF HIVE%(ROW,COL)<>PLAYER THEN 1410
  134. 1340  NODEROW=ROW:NODECOL=COL:GOSUB 1560
  135. 1350  IF USED.FLAG=1 THEN 1410
  136. 1360  NODE.TOTAL=1:PATH.TOTAL=1:COUNTER=1
  137. 1370  PATH%(1)=100*NODEROW+NODECOL
  138. 1380  GOSUB 1650
  139. 1390  IF WINNER=1 THEN COL=11
  140. 1400  REM SKIP2
  141. 1410  NEXT COL
  142. 1420  RETURN
  143. 1430  REM CHECK1
  144. 1440  FOR ROW=1 TO 11:COL=1
  145. 1450  IF HIVE%(ROW,COL)<>PLAYER THEN 1530
  146. 1460  NODEROW=ROW:NODECOL=COL:GOSUB 1560
  147. 1470  IF USED.FLAG=1 THEN 1530
  148. 1480  NODE.TOTAL=1:PATH.TOTAL=1:COUNTER=1
  149. 1490  PATH%(1)=100*NODEROW+NODECOL
  150. 1500  GOSUB 1650
  151. 1510  IF WINNER=1 THEN ROW=11
  152. 1520  REM SKIP1
  153. 1530  NEXT ROW
  154. 1540  RETURN
  155. 1550  REM USEDLOOKUP
  156. 1560  USED.FLAG=0:SEARCH=100*NODEROW+NODECOL
  157. 1570  LK=0:IF USED.CNTR=0 THEN 1620
  158. 1580  FOR LK=1 TO USED.CNTR
  159. 1590  IF SEARCH=USED%(LK) THEN USED.FLAG=1:LK=USED.CNTR
  160. 1600  NEXT LK
  161. 1610  REM SKIPSEARCH
  162. 1620  IF USED.FLAG=0 THEN USED.CNTR=USED.CNTR+1:USED%(USED.CNTR)=SEARCH
  163. 1630  RETURN
  164. 1640  REM CHECKPATH
  165. 1650  NODE.CNTR=0
  166. 1660  FOR NC=1 TO 6
  167. 1670  NODEROW=NODEROW+ROW.INC%(NC):NODECOL=NODECOL+COL.INC%(NC)
  168. 1680  IF NODEROW<1 OR NODEROW>11 OR NODECOL<1 OR NODECOL>11 THEN 1750
  169. 1690  IF HIVE%(NODEROW,NODECOL)<>PLAYER THEN 1750
  170. 1700  GOSUB 1560:IF USED.FLAG=1 THEN 1750
  171. 1710  NODE.CNTR=NODE.CNTR+1
  172. 1720  NODE.TOTAL=NODE.TOTAL+1:NODE%(NODE.TOTAL)=100*NODEROW+NODECOL
  173. 1730  IF (PLAYER=2 AND NODEROW=11) OR (PLAYER=1 AND NODECOL=11) THEN WINNER=1:PATH.TOTAL=PATH.TOTAL+1:PATH%(PATH.TOTAL)=100*NODEROW+NODECOL:NC=6
  174. 1740  REM SKIPNODE
  175. 1750  NEXT NC
  176. 1760  IF WINNER=1 THEN RETURN
  177. 1770  IF NODE.CNTR=0 AND NODE.TOTAL=0 THEN RETURN
  178. 1780  IF NODE.CNTR=0 THEN PATH.TOTAL=PATH.TOTAL-PATHLEN(COUNTER):PATHLEN(COUNTER)=0:COUNTER=COUNTER-1
  179. 1790  IF NODE.CNTR>1 THEN COUNTER=COUNTER+NODE.CNTR-1
  180. 1800  NODEROW=INT(NODE%(NODE.TOTAL)/100)
  181. 1810  NODECOL=NODE%(NODE.TOTAL)-100*NODEROW
  182. 1820  PATH.TOTAL=PATH.TOTAL+1
  183. 1830  PATHLEN(COUNTER)=PATHLEN(COUNTER)+1
  184. 1840  PATH%(PATH.TOTAL)=NODE%(NODE.TOTAL)
  185. 1850  NODE.TOTAL=NODE.TOTAL-1
  186. 1860  GOTO 1650
  187. 1870  REM DRAWPATH
  188. 1880  LOCATE 1,1:PRINT "THE WINNER: ";:PRINT PLAYER$(PLAYER);
  189. 1890  FOR J=1 TO PATH.TOTAL
  190. 1900  ROW=INT(PATH%(J)/100):COL=PATH%(J)-100*ROW:CB=COL*18+38+(6-ROW)*9:RB=ROW*15-1
  191. 1910  IF PLAYER=1 THEN PUT(CB+1,RB-1),BALL1,XOR:PUT (CB,RB-3),EYES1,OR ELSE PUT(CB+1,RB-1),BALL2,XOR:PUT (CB,RB-3),EYES2,OR
  192. 1920  NEXT J
  193. 1930  REM GOAGAIN
  194. 1940  LOCATE 24,1:PRINT "Want to play again (Y/N)?";
  195. 1950  A$=INKEY$:IF A$<>"Y" AND A$<>"N" THEN 1950
  196. 1960  IF A$="N" THEN SCREEN 0,0,0:WIDTH 80:END ELSE CLS:GOTO 50
  197.