home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib34a.dsk / JULY.1988 / PYRAMID.bas < prev    next >
BASIC Source File  |  2023-02-26  |  12KB  |  201 lines
  1. 10  REM  **********************
  2. 20  REM  * PYRAMID            *
  3. 30  REM  * BY JIM LAZAR       *
  4. 40  REM  * COPYRIGHT (C) 1988 *
  5. 50  REM  * MICROSPARC, INC.   *
  6. 60  REM  * CONCORD, MA 01742  *
  7. 70  REM  **********************
  8. 80  DIM D%(52),H%(52),T%(52),P%(8,8),U%(9),CN$(13)
  9. 90  PRINT  CHR$(21): TEXT : HOME : PRINT "THE PYRAMID": PRINT : IF  PEEK(104) = 64  THEN 110
  10. 100  PRINT "RELOADING PROGRAM": POKE 104,64: POKE 16384,0: PRINT  CHR$(4)"RUN PYRAMID": PRINT 
  11. 110  ONERR  GOTO 1930
  12. 120 FL$ = "PYRAMID.ML": PRINT  CHR$(4)"BLOAD "FL$:FL$ = "PYRAMID.SHAPES": PRINT  CHR$(4)"BLOAD "FL$
  13. 130  HOME : INVERSE : FOR A = 1 TO 9: HTAB 21 -A: PRINT  SPC( A +A -1)"": POKE 2060,1: POKE 2061,255 -A *2: CALL 2062: NEXT 
  14. 140  VTAB 5: HTAB 19: PRINT "THE": VTAB 7: HTAB 17: PRINT "PYRAMID"
  15. 150  NORMAL : PRINT 
  16. 160  VTAB 13: HTAB 14: PRINT "BY  JIM LAZAR": HTAB 12: PRINT "COPYRIGHT (C) 1988": HTAB 13: PRINT "MICROSPARC, INC."
  17. 170  REM ** SET UP CARD DECK AND RANDONIZE **
  18. 180 C = 1: FOR A = 1 TO 13: FOR B = 1 TO 4:D%(C) = B *16 +A:C = C +1: NEXT : NEXT 
  19. 190  VTAB 21: PRINT "USE JOYSTICK OR KEYBOARD? (J OR K) ";
  20. 200  INVERSE : PRINT " " CHR$(8);: NORMAL : FOR A = 1 TO 3:B = D%( RND(1) *52 +1)
  21. 210 D%( RND(0) *52 +1) = D%( RND(1) *52 +1):D%( RND(0) *52 +1) = B: NEXT 
  22. 220  PRINT " " CHR$(8);: FOR A = 1 TO 3:B = D%( RND(1) *52 +1):D%( RND(0) *52 +1) = D%( RND(1) *52 +1):D%( RND(0) *52 +1) = B: NEXT 
  23. 230  IF  PEEK( -16384) <128  THEN 200
  24. 240 A =  PEEK( -16384) -128: POKE  -16368,0
  25. 250 A = A -32 *(A >95): IF A < >74  AND A < >75  THEN  PRINT  CHR$(7);: GOTO 200
  26. 260 JK = (A = 74): HOME 
  27. 270  REM ** SHUFFLE CARDS **
  28. 280  HGR : CALL 2054: POKE 237,0: POKE 238,0: CALL 2057: POKE 237,4: POKE 238,0: CALL 2057: POKE 237,32: POKE 238,0: CALL 2057: POKE 237,36: POKE 238,0: CALL 2057
  29. 290  POKE 237,17: POKE 238,60: CALL 2051: FOR A = 1 TO 100:B = D%( RND(1) *52 +1):D%( RND(0) *52 +1) = D%( RND(1) *52 +1):D%( RND(0) *52 +1) = B: NEXT 
  30. 300  HOME : VTAB 21: HTAB 12: PRINT "SHUFFLING CARDS"
  31. 310  FOR A = 1 TO 52: POKE 237,17: POKE 238,60 +(30 *( INT(A/2) = A/2)): CALL 2051
  32. 320 B = D%( RND(1) *52 +1):D%( RND(0) *52 +1) = D%( RND(1) *52 +1):D%( RND(0) *52 +1) = B
  33. 330  POKE 2060,1: POKE 2061,3: CALL 2062: NEXT : POKE 2060,1: POKE 2061,6: CALL 2062
  34. 340  FOR A = 90 TO 60  STEP  -1: POKE 237,17: POKE 238,A: CALL 2051: NEXT 
  35. 350  REM ** SHUFFLE MENU **
  36. 360  HOME : VTAB 21: PRINT "1. SHUFFLE CARDS AGAIN": PRINT "2. CUT AND DEAL CARDS": PRINT "3. DEAL CARDS": PRINT "ENTER 1,2, OR 3: ";:
  37. 370  GET A$: IF A$ <"1"  OR A$ >"3"  THEN  PRINT  CHR$(7);: GOTO 370
  38. 380 A =  VAL(A$): HOME : ON A GOTO 390,400,600
  39. 390  FOR A = 60 TO 90  STEP 5: POKE 237,17: POKE 238,A: CALL 2051: POKE 237,17: POKE 238,60: CALL 2051: NEXT : GOTO 300
  40. 400  FOR A = 17 TO 5  STEP  -1: POKE 237,A: POKE 238,60: CALL 2051: POKE 237,A +4: POKE 238,60: CALL 2057: NEXT 
  41. 410  FOR A = 60 TO 120  STEP 5: POKE 237,5: POKE 238,A: CALL 2051: POKE 237,5: POKE 238,A -40: CALL 2057: NEXT 
  42. 420  FOR A = 5 TO 31: POKE 237,A: POKE 238,120: CALL 2051: POKE 49200,0: NEXT 
  43. 430 P = 1: HOME : VTAB 23: PRINT "POSITION POINTER (WITH ARROW KEYS) WHERE";: PRINT "CARDS SHOULD BE CUT AND PRESS RETURN";
  44. 440  VTAB 21: HTAB P +6: PRINT "^";: POKE  -16368,0: POKE 2060,1: POKE 2061,220 +P: CALL 2062
  45. 450  IF  PEEK( -16384) <128  THEN 450
  46. 460 B =  PEEK( -16384) -128: POKE  -16368,0: IF B = 13  THEN 500
  47. 470  IF B = 8  AND P >1  THEN  PRINT  CHR$(8)" ":P = P -1: GOTO 440
  48. 480  IF B = 21  AND P <26  THEN  PRINT  CHR$(8)" ":P = P +1: GOTO 440
  49. 490  PRINT  CHR$(7);: GOTO 440
  50. 500  HOME :A = P *2:B = 1: FOR C = A TO 52:H%(B) = D%(C):B = B +1: NEXT : FOR C = 1 TO A -1:H%(B) = D%(C):B = B +1: NEXT 
  51. 510  FOR A = 1 TO 52:D%(A) = H%(A): NEXT 
  52. 520  FOR A = 31 TO P +5  STEP  -1: POKE 237,A: POKE 238,120: CALL 2051: POKE 237,A +4: POKE 238,120: CALL 2057: POKE 49200,0: NEXT 
  53. 530  FOR A = 110 TO 60  STEP  -5: POKE 237,P +5: POKE 238,A +40: CALL 2057: POKE 237,P +4: POKE 238,120: CALL 2051: POKE 237,P +5: POKE 238,A: CALL 2051: NEXT 
  54. 540 A = ( -1 *(P +5 >17)) +(P +5 <17): IF P +5 = 17  THEN 560
  55. 550  FOR B = P +5 TO 17  STEP A: POKE 237,B: POKE 238,60: CALL 2051: POKE 237,B +4: POKE 238,60: CALL 2057: POKE 237,B -4: POKE 238,60: CALL 2057: NEXT 
  56. 560  FOR A = P +4 TO 5  STEP  -1: POKE 237,A: POKE 238,120: CALL 2051: POKE 237,A +4: POKE 238,120: CALL 2057: POKE 49200,0: NEXT 
  57. 570  FOR A = 5 TO 17: POKE 237,A: POKE 238,120: CALL 2051: POKE 237,A -4: POKE 238,120: CALL 2057: NEXT 
  58. 580  FOR A = 110 TO 60  STEP  -5: POKE 237,17: POKE 238,A: CALL 2051: POKE 237,17: POKE 238,A +40: CALL 2057: NEXT 
  59. 590  REM ** BUILD PYRAMID **
  60. 600  FOR A = 17 TO 1  STEP  -1: POKE 237,A: POKE 238,60: CALL 2051: POKE 237,A +4: POKE 238,60: CALL 2057: NEXT 
  61. 610  FOR A = 60 TO 20  STEP  -5: POKE 237,1: POKE 238,A: CALL 2051: POKE 237,1: POKE 238,A +40: CALL 2057: NEXT 
  62. 620  CALL 2054: POKE 237,1: POKE 238,20: CALL 2051: HOME : VTAB 22: HTAB 12: PRINT "BUILDING PYRAMID":P = 52
  63. 630  FOR A = 1 TO 7: FOR B = 1 TO A:P%(B,A) = D%(P):P = P -1
  64. 640  POKE 237,1: POKE 238,20: CALL 2057: POKE 237,1: POKE 238,20: CALL 2051
  65. 650  POKE 237,21 -A *3 +(B -1) *6: POKE 238,5 +A *15: POKE 239,P%(B,A): CALL 2048: POKE 2060,1: POKE 2061,4: CALL 2062: NEXT : NEXT 
  66. 660  POKE 237,1: POKE 238,20: POKE 239,D%(P): CALL 2048: FOR A = 1 TO 9: READ U%(A): NEXT 
  67. 670  FOR A = 1 TO 13: READ CN$(A): NEXT 
  68. 680  DATA 1,0,17,27,37,47,57,67,77
  69. 690  DATA "N ACE"," TWO"," THREE"," FOUR"," FIVE"," SIX"," SEVEN","N EIGHT"," NINE"," TEN"," JACK"," QUEEN"," KING"
  70. 700 CU = 1:TA = 0
  71. 710  REM ** PRINT SLECTION INSTRUCTIONS **
  72. 720  HOME : VTAB 21: PRINT "ARROW KEYS - MOVE CURSOR";: IF JK  THEN  HTAB 28: PRINT "(JOYSTICK)";
  73. 730  PRINT : PRINT "RETURN - MATCH CARD";: IF JK  THEN  HTAB 28: PRINT "(BUTTON 0)";
  74. 740  PRINT : IF P >1  THEN  PRINT "N - NEXT CARD FROM HAND";: IF JK  THEN  HTAB 28: PRINT "(BUTTON 1)";
  75. 750  PRINT : PRINT "ESC - GIVE UP  ";
  76. 760  REM ** SELECTION MODE **
  77. 770  POKE  -16368,0: IF CU = 1  THEN X = 1:Y = 20:C = D%(P): GOTO 800
  78. 780  IF CU = 2  THEN X = 35:Y = 20:C = T%(TA): GOTO 800
  79. 790 B =  INT(U%(CU)/10):A = U%(CU) -B *10:X = 21 -A *3 +(B -1) *6:Y = 5 +A *15:C = P%(B,A)
  80. 800  POKE 237,X: POKE 238,Y: CALL 2057: FOR D = 1 TO 15: NEXT : POKE 237,X: POKE 238,Y: POKE 239,C: CALL 2048: FOR D = 1 TO 15: NEXT 
  81. 810  IF   NOT JK  THEN 860
  82. 820  IF  PEEK( -16287) >127  THEN 1170
  83. 830  IF  PEEK( -16286) >127  THEN 1090
  84. 840  IF  PDL(0) <75  THEN 1060
  85. 850  IF  PDL(0) >180  THEN 1020
  86. 860  IF  PEEK( -16384) <128  THEN 800
  87. 870 K =  PEEK( -16384) -128: POKE  -16368,0
  88. 880  IF K = 13  THEN 1170
  89. 890  IF K = 78  OR K = 110  THEN 1090
  90. 900  IF K = 8  THEN 1060
  91. 910  IF K = 21  THEN 1020
  92. 920  IF K < >27  THEN  PRINT  CHR$(7);: GOTO 800
  93. 930  REM ** GIVE UP? **
  94. 940  HOME : VTAB 21: PRINT "1. WHOOPS! BACK TO GAME": PRINT "2. NEW GAME": PRINT "3. QUIT": PRINT "ENTER 1,2, OR 3: ";:
  95. 950  GET A$: IF A$ <"1"  OR A$ >"3"  THEN  PRINT  CHR$(7);: GOTO 950
  96. 960 A =  VAL(A$): ON A GOTO 720,970,980
  97. 970  RUN 
  98. 980  HOME : VTAB 23: PRINT "ARE YOU SURE YOU WANT TO QUIT (Y/N) ? ";: GET A$: IF A$ < >"Y"  AND A$ < >"N"  AND A$ < >"y"  AND A$ < >"n"  THEN 980
  99. 990  IF A$ = "Y"  OR A$ = "y"  THEN  TEXT : HOME : VTAB 23: END 
  100. 1000  GOTO 720
  101. 1010  REM ** CURSOR RIGHT **
  102. 1020 CU = CU +1: IF CU >9  THEN CU = 1
  103. 1030  IF U%(CU) = 0  THEN 1020
  104. 1040  GOTO 770
  105. 1050  REM ** CURSOR LEFT **
  106. 1060 CU = CU -1: IF CU <1  THEN CU = 9
  107. 1070  IF U%(CU) = 0  THEN 1060
  108. 1080  GOTO 770
  109. 1090  IF P >1  THEN 1130
  110. 1100  REM ** TURN UP NEXT CARD FROM HAND **
  111. 1110  HOME : VTAB 21: PRINT  CHR$(7)"END OF HAND HAS BEEN REACHED"
  112. 1120  GOSUB 1990: GOTO 720
  113. 1130 TA = TA +1:T%(TA) = D%(P):U%(2) = 1: POKE 237,1: POKE 238,20: CALL 2051: POKE 237,35: POKE 238,20: POKE 239,T%(TA): CALL 2048
  114. 1140 P = P -1: POKE 237,1: POKE 238,20: POKE 239,D%(P): CALL 2048: POKE 2060,1: POKE 2061,4: CALL 2062
  115. 1150  GOTO 720
  116. 1160  REM ** MAKE FIRST CARD SELECTION **
  117. 1170 A =  INT(C/16):C1 = C -A *16
  118. 1180 S1 = U%(CU):U%(CU) = 0:S2 = CU
  119. 1190  IF C1 = 13  THEN 1570
  120. 1200  REM ** SECOND CARD SELECTION MODE **
  121. 1210  HOME : VTAB 21: PRINT "POSITION CURSOR OVER CARD TO MATCH WITH": PRINT "A"CN$(C1)" AND PRESS RETURN";: IF JK  THEN  HTAB 28: PRINT "(BUTTON 0)";
  122. 1220  PRINT : PRINT "SPACE - ABORT SELECTION  ";: IF JK  THEN  HTAB 28: PRINT "(BUTTON 1)";
  123. 1230 CU = CU +1: IF CU >9  THEN CU = 1
  124. 1240  IF U%(CU) = 0  THEN 1230
  125. 1250  POKE  -16368,0: IF CU = 1  THEN X = 1:Y = 20:C = D%(P): GOTO 1280
  126. 1260  IF CU = 2  THEN X = 35:Y = 20:C = T%(TA): GOTO 1280
  127. 1270 B =  INT(U%(CU)/10):A = U%(CU) -B *10:X = 21 -A *3 +(B -1) *6:Y = 5 +A *15:C = P%(B,A)
  128. 1280  POKE 237,X: POKE 238,Y: CALL 2057: FOR D = 1 TO 15: NEXT : POKE 237,X: POKE 238,Y: POKE 239,C: CALL 2048: FOR D = 1 TO 15: NEXT 
  129. 1290  IF   NOT JK  THEN 1340
  130. 1300  IF  PEEK( -16287) >127  THEN 1510
  131. 1310  IF  PEEK( -16286) >127  THEN 1410
  132. 1320  IF  PDL(0) <75  THEN 1470
  133. 1330  IF  PDL(0) >180  THEN 1430
  134. 1340  IF  PEEK( -16384) <128  THEN 1280
  135. 1350 K =  PEEK( -16384) -128: POKE  -16368,0
  136. 1360  IF K = 13  THEN 1510
  137. 1370  IF K = 8  THEN 1470
  138. 1380  IF K = 21  THEN 1430
  139. 1390  IF K < >32  THEN  PRINT  CHR$(7);: GOTO 1280
  140. 1400  REM ** ABORT SECOND SELECTION **
  141. 1410 CU = S2:U%(CU) = S1: GOTO 720
  142. 1420  REM ** CURSOR RIGHT **
  143. 1430 CU = CU +1: IF CU >9  THEN CU = 1
  144. 1440  IF U%(CU) = 0  THEN 1430
  145. 1450  GOTO 1250
  146. 1460  REM ** CURSOR LEFT **
  147. 1470 CU = CU -1: IF CU <1  THEN CU = 9
  148. 1480  IF U%(CU) = 0  THEN 1470
  149. 1490  GOTO 1250
  150. 1500  REM ** CHECK FOR LEGAL MATCH **
  151. 1510 A =  INT(C/16):C2 = C -A *16
  152. 1520  IF C1 +C2 = 13  THEN 1600
  153. 1530  REM  ** NO MATCH! **
  154. 1540  HOME : VTAB 21: PRINT  CHR$(7) CHR$(7)"A"CN$(C1)" AND A"CN$(C2)" DOES NOT MATCH!": PRINT "("C1" + "C2" <> 13)"
  155. 1550  GOSUB 1990: GOTO 1410
  156. 1560  REM ** HANDLE KING REMOVAL **
  157. 1570  HOME : VTAB 21: PRINT "A KING TOTALS 13 BY ITSELF": PRINT : PRINT "REMOVING CARD..."
  158. 1580  GOTO 1620
  159. 1590  REM ** HANDLE TWO CARD REMOVAL **
  160. 1600  HOME : VTAB 21: PRINT "A"CN$(C1)" AND A"CN$(C2)" DO MATCH!": PRINT : PRINT "REMOVING CARDS..."
  161. 1610  ON CU GOSUB 1830,1870: IF CU >2  THEN  GOSUB 1910
  162. 1620  ON S2 GOSUB 1830,1870: IF S2 >2  THEN CU = S2:U%(CU) = S1: GOSUB 1910
  163. 1630  FOR A = 1 TO 7: FOR B = 1 TO A: IF P%(B,A) >0  THEN  POKE 237,21 -A *3 +(B -1) *6: POKE 238,5 +A *15: POKE 239,P%(B,A): CALL 2048
  164. 1640  NEXT : NEXT 
  165. 1650  REM ** CHECK TO SEE WHICH CARDS ARE NOW AVAILABLE FOR MATCHING **
  166. 1660 U%(1) = (P >0):U%(2) = (TA >0): FOR A = 3 TO 9:U%(A) = 0: NEXT :A = 3
  167. 1670  FOR Y = 1 TO 7: FOR X = 1 TO Y: IF P%(X,Y) < >0  AND P%(X,Y +1) = 0  AND P%(X +1,Y +1) = 0  THEN U%(A) = X *10 +Y:A = A +1
  168. 1680  NEXT : NEXT 
  169. 1690 CU = 0
  170. 1700 CU = CU +1: IF CU >9  THEN CU = 1
  171. 1710  IF U%(CU) = 0  THEN 1700
  172. 1720  IF P%(1,1) = 0  THEN 1750
  173. 1730  GOTO 720
  174. 1740  REM ** PYRAMID GONE **
  175. 1750  HOME : VTAB 21: PRINT "YOU HAVE REMOVED THE LAST CARD OF THE": PRINT "PYRAMID.  CONGRATULATIONS!"
  176. 1760  FOR A = 1 TO 4: READ B,C: POKE 2060,B: POKE 2061,C: CALL 2062: FOR D = 1 TO 20: NEXT : NEXT : DATA 6,55,6,55,6,55,100,5
  177. 1770  GOSUB 1990
  178. 1780  HOME : VTAB 21: PRINT "1. NEW GAME": PRINT "2. QUIT": PRINT "ENTER 1 OR 2 ";:
  179. 1790  GET A$: IF A$ <"1"  OR A$ >"2"  THEN  PRINT  CHR$(7);: GOTO 1790
  180. 1800  IF A$ = "1"  THEN  RUN 
  181. 1810  TEXT : HOME : VTAB 23: END 
  182. 1820  REM ** REMOVE CARD FROM HAND **
  183. 1830  POKE 2060,1: POKE 2061,4: CALL 2062: POKE 237,1: POKE 238,20: IF P = 1  THEN  CALL 2057:P = 0: RETURN 
  184. 1840  CALL 2051:P = P -1
  185. 1850  POKE 237,1: POKE 238,20: POKE 239,D%(P): CALL 2048: RETURN 
  186. 1860  REM ** REMOVE CARD FROM TALON **
  187. 1870  POKE 2060,1: POKE 2061,4: CALL 2062: POKE 237,35: POKE 238,20: IF TA = 1  THEN  CALL 2057:TA = 0: RETURN 
  188. 1880  CALL 2051:TA = TA -1
  189. 1890  POKE 237,35: POKE 238,20: POKE 239,T%(TA): CALL 2048: RETURN 
  190. 1900  REM ** REMOVE CARD FROM PYRAMID **
  191. 1910 B =  INT(U%(CU)/10):A = U%(CU) -B *10:X = 21 -A *3 +(B -1) *6:Y = 5 +A *15:P%(B,A) = 0
  192. 1920  POKE 237,X: POKE 238,Y: CALL 2057: POKE 2060,1: POKE 2061,4: CALL 2062: RETURN 
  193. 1930  IF  PEEK(222) = 6  OR  PEEK(222) = 7  THEN 1960
  194. 1940  IF  PEEK(222) =  >254  THEN  RESUME 
  195. 1950  POKE 216,0: RESUME 
  196. 1960  PRINT : PRINT  CHR$(7)"PLEASE INSERT THE DISK WITH "FL$: PRINT "ON IT AND PRESS RETURN": PRINT 
  197. 1970  POKE  -16368,0: WAIT  -16384,128: IF  PEEK( -16384) < >141  THEN 1970
  198. 1980  GOTO 120
  199. 1990  PRINT : PRINT "PRESS RETURN TO CONTINUE";
  200. 2000  POKE  -16368,0: WAIT  -16384,128: IF  PEEK( -16384) < >141  THEN 2000
  201. 2010  PRINT : RETURN