home *** CD-ROM | disk | FTP | other *** search
/ Softdisk G-S 127 / SGDS 127.2mg / SDGS.127 / SDC127 / C / D.T (.txt) < prev    next >
Encoding:
Applesoft BASIC Source Code  |  1992-05-01  |  7.1 KB  |  293 lines  |  [FC] Applesoft BASIC Program (0x6C01)
  1. 1 Y = 1:D$(1) = "D":D$(2) = "T":BOX = 2051:OBOX = 2054:CBPX = 2057:TK =  PEEK(767):COMP =  PEEK(766)
  2. 10  GOTO 90
  3. 20  POKE 0,SH: POKE 3,Y: POKE 2, INT(X/14) *2: POKE 1,X -7 * PEEK(2)
  4. 30  CALL 4352 +10 *ER: RETURN 
  5. 90  PRINT  CHR$(4);"BLOAD XY.BIN"
  6. 100  REM **DIAMONDS & TRIANGLES
  7. 110  REM **BY DEXTER SAMIDA
  8. 120  REM **
  9. 230  REM    *** MAIN ROUTINE
  10. 240  GOSUB 2500
  11. 250  GOSUB 2000
  12. 255 X = 206 +6 *(DE = 1):Y = 150 -4 *(DE = 1):SH = (DE -1) *2: GOSUB 20
  13. 260  IF DE = COMP  THEN  GOSUB 5000: GOSUB 5250: GOTO 290
  14. 270  GOSUB 5250: GOSUB 3920
  15. 280  IF  RIGHT$(A$(XA),1) < >D$(DE)  THEN  PRINT  CHR$(7): GOSUB 3940: GOTO 280
  16. 285  GOSUB 5250
  17. 290  IF  LEN(A$(XA)) = 1  THEN A$(XA) = ".": GOTO 310
  18. 300 A$(XA) =  LEFT$(A$(XA),1)
  19. 310  GOSUB 4120: GOSUB 3000
  20. 330 A$(XA) = A$(XA) +D$(DE)
  21. 340  GOSUB 4120: GOSUB 3500
  22. 350 X = 206 +6 *(DE = 1):Y = 150 -4 *(DE = 1):SH = (DE -1) *2:ER = 1: GOSUB 20:ER = 0
  23. 360 DE = DE +1: IF DE = 3  THEN DE = 1
  24. 390  GOTO 250
  25. 500  POKE 230,32: NORMAL : PRINT  CHR$(20) CHR$(12): VTAB 1
  26. 501  PRINT "[";: FOR I = 1 TO 38: PRINT "\";: NEXT : PRINT "]";: FOR I = 1 TO 22: PRINT "~";: HTAB 40: PRINT "~";: NEXT 
  27. 502  PRINT "_";: FOR I = 1 TO 38: PRINT "\";: NEXT : PRINT "`";
  28. 509  POKE 32,1: POKE 33,38: POKE 34,1: POKE 35,23
  29. 510  HOME : POKE  -16300,0
  30. 520  PRINT  TAB( 9);"Diamonds and Triangles"
  31. 530  PRINT : PRINT " D & T is a two player game requiring"
  32. 540  PRINT "strategy and conceptual thinking."
  33. 550  PRINT 
  34. 555  PRINT " You win by eliminating three of your"
  35. 556  PRINT "opponent's pieces or by preventing"
  36. 557  PRINT "him from making a move.": PRINT 
  37. 560  PRINT " A foe is eliminated when a third man"
  38. 565  PRINT "is moved onto any stack having two. Ifboth men are yours, however, you lose"
  39. 580  PRINT "one of your own men!"
  40. 600  PRINT 
  41. 610  PRINT " The changing number in the middle of"
  42. 611  PRINT "the board is the number of squares to"
  43. 612  PRINT "be moved."
  44. 622  VTAB 22: PRINT  TAB( 10);"Press <ESC> to exit,"
  45. 623  PRINT  TAB( 7);"or <ANY KEY> to continue."
  46. 625  GET A$
  47. 627  IF A$ =  CHR$(27)  THEN A$ = "": GOTO 740
  48. 628  HOME : PRINT  CHR$(12);
  49. 630  PRINT : PRINT "MOVING:": PRINT 
  50. 632  PRINT " To move, select the piece you want"
  51. 633  PRINT "with the left and right arrows and"
  52. 635  PRINT "then press RETURN to move it.": PRINT 
  53. 636  PRINT " The direction it will move depends"
  54. 637  PRINT "on which figure it is. The triangles"
  55. 638  PRINT "move clockwise and the diamonds move"
  56. 639  PRINT "counter-clockwise as the diagrams"
  57. 640  PRINT "below illustrate."
  58. 642  PRINT 
  59. 645  PRINT  TAB( 11);"[\\]          [\\]"
  60. 650  PRINT  TAB( 11);"^  ~          ~  ^"
  61. 660  PRINT  TAB( 11);"~  ~          ~  ~"
  62. 670  PRINT  TAB( 11);"~  |          |  ~"
  63. 680  PRINT  TAB( 11);"_\\`          _\\`"
  64. 690  PRINT : PRINT  TAB( 9);"Triangle      Diamonds"
  65. 700  VTAB 23: PRINT  TAB( 7);"Press <ANY KEY> to continue.";: VTAB 1
  66. 710  GET A$:A$ = ""
  67. 740  POKE 230,64: POKE  -16299,0
  68. 750  HTAB 29: NORMAL : RETURN 
  69. 1260  REM  *** <ESC>
  70. 1330  REM  *** Menu Descripts
  71. 1410  CALL OBOX,1,3,28,6: INVERSE 
  72. 1412  HOME :COMP = COMP +1: IF COMP = 4  THEN COMP = 1
  73. 1425  PRINT "The computer is ";
  74. 1430  IF COMP = 3  THEN  PRINT "Nobody.   ": GOTO 1450
  75. 1435  IF COMP = 2  THEN  PRINT "Triangles.": GOTO 1450
  76. 1440  PRINT "Diamonds. "
  77. 1450  PRINT "Press RETURN to accept,": PRINT "any other to change again.": GET A$
  78. 1451  IF A$ < > CHR$(13)  THEN 1412
  79. 1456  CALL CBOX:A$ = "": RETURN 
  80. 1530  CALL OBOX,3,12,24,5: INVERSE 
  81. 1540  PRINT "Do you wish to E)xit,"
  82. 1550  PRINT "     R)estart or     "
  83. 1560  PRINT " C)ontinue? (E/R/C)"
  84. 1561  GET A$: IF A$ = "e"  OR A$ = "E"  THEN  PRINT  CHR$(4)"BYE"
  85. 1562  IF A$ = "r"  OR A$ = "R"  THEN  CALL CBOX: POKE 767,TK: POKE 766,COMP: RUN 
  86. 1563  IF A$ < >"c"  AND A$ < >"C"  THEN 1561
  87. 1564  CALL CBOX:A$ = "": RETURN 
  88. 1570  HTAB 29: RETURN 
  89. 1575  CALL OBOX,3,10,24,4: INVERSE 
  90. 1576 TK = TK +1: IF TK = 2  THEN TK = 0
  91. 1580  PRINT "Sound is now ";
  92. 1590  IF TK  THEN  PRINT "on.": GOTO 1593
  93. 1592  PRINT "off."
  94. 1593  PRINT : PRINT "Press a key.": GET A$:A$ = ""
  95. 1595  HTAB 29: CALL CBOX: RETURN 
  96. 2000  REM     ** RANDOM NUMBER 
  97. 2010  FOR B = 1 TO 10 + RND(1) *10
  98. 2015  IF TK = 1  THEN  POKE 6,B: POKE 7,90: CALL 801
  99. 2020 X = 82:Y = 85:SH =  INT( RND(1) *8) *2 +14: GOSUB 20: NEXT 
  100. 2030 NUM =  INT(8 * RND(0) +1): RETURN 
  101. 2500  REM    *** INITIALIZATION
  102. 2510  FOR X = 3 TO 6:A%(X) = 120: NEXT 
  103. 2520  FOR X = 8 TO 10:A%(X) = 8: NEXT 
  104. 2530 A%(1) = 8:A%(2) = 64:A%(7) = 64
  105. 2540 B%(1) = 8:B%(2) = 8
  106. 2550 B%(3) = 8:B%(4) = 55
  107. 2560 B%(5) = 102:B%(6) = 149
  108. 2570 B%(7) = 149:B%(8) = 149
  109. 2580 B%(9) = 102:B%(10) = 55
  110. 2590  FOR X = 3 TO 6
  111. 2600 A$(X) = "D": NEXT 
  112. 2610  FOR X = 8 TO 10
  113. 2620 A$(X) = "T": NEXT :A$(1) = "T"
  114. 2630 A$(2) = ".":A$(7) = "."
  115. 2640  FOR XA = 10 TO 1  STEP  -1: GOSUB 4120
  116. 2650  NEXT :XA = 1
  117. 2660 DE = 1
  118. 2670 X = 206 +6 *(DE = 1):Y = 150 -4 *(DE = 1):SH = (DE -1) *2:ER = 1: GOSUB 20:DE = 2
  119. 2680 X = 206 +6 *(DE = 1):Y = 150 -4 *(DE = 1):SH = (DE -1) *2: GOSUB 20:ER = 0
  120. 2690 DE =  INT(2 * RND(1) +1): RETURN 
  121. 3000  REM    *** MOVE DICE
  122. 3010  IF DE = 1  THEN XB = XA -NUM: FOR XX = XA TO XB  STEP  -1
  123. 3020  IF DE = 2  THEN XB = NUM +XA: FOR XX = XA TO XB
  124. 3030 XA = XX: IF XX <1  THEN XA = (10 +XX)
  125. 3040  IF XX >10  THEN XA = (XX -10)
  126. 3050 ZZ = 0
  127. 3060  POKE 6,(XA -1)
  128. 3070  CALL 768
  129. 3080 A =  PEEK(6):B =  PEEK(7)
  130. 3130  FOR Y = 1 TO 120
  131. 3140  NEXT : IF ZZ GOTO 4010
  132. 3150  IF TK = 1  AND XX < >XB  THEN  POKE 6,14: POKE 7,53: CALL 801
  133. 3160  NEXT : RETURN 
  134. 3395  GOTO 4020
  135. 3500  REM    *** CHECK FOR WIN
  136. 3510 Q =  -1:W =  -1: FOR X = 1 TO 10
  137. 3520  IF  RIGHT$(A$(X),1) = "T"  THEN Q = Q +1: IF A$(X) = "DT"  THEN W = W +.2
  138. 3530  IF A$(X) = "TT"  THEN Q = Q +1
  139. 3540  IF  RIGHT$(A$(X),1) = "D"  THEN W = W +1: IF A$(X) = "TD"  THEN Q = Q +.2
  140. 3550  IF A$(X) = "DD"  THEN W = W +1
  141. 3560  NEXT : IF Q >.1  AND W >.1  THEN  RETURN 
  142. 3570  GOTO 3590
  143. 3580 Q = (DE = 1):W = 0
  144. 3590  FOR X = 1 TO 2510: NEXT 
  145. 3620 :
  146. 3630  IF Q >W  THEN Q$(1) = "Triangles":Q$(2) = "Diamonds ": GOTO 3645
  147. 3640 Q$(1) = "Diamonds ":Q$(2) = "Triangles"
  148. 3645 :
  149. 3650  CALL OBOX,1,1,40,24: HOME 
  150. 3660  INVERSE 
  151. 3670  PRINT  TAB( 9);"Diamonds and Triangles": PRINT 
  152. 3680  PRINT : HTAB 5: PRINT "It looks like we have a winner!"
  153. 3690  PRINT : PRINT : HTAB 7: PRINT "And the winner is ";
  154. 3700  FOR Y = 1 TO 750: NEXT 
  155. 3710  FOR X = 1 TO 10: HTAB 25: PRINT Q$(1);
  156. 3720  FOR Y = 1 TO 200: NEXT : HTAB 25: PRINT Q$(2);
  157. 3730  FOR Y = 1 TO 200: NEXT : NEXT 
  158. 3740  IF  LEFT$(Q$(1),1) = "D"  THEN Q$(1) = "Diamonds"
  159. 3750  HTAB 25: PRINT Q$(1);"!"
  160. 3755  GOSUB 6300
  161. 3760  PRINT : PRINT : PRINT : HTAB 7: PRINT "Congratulations "Q$(1)"!": HTAB 4: PRINT "You are the champion, the victor": HTAB 5: PRINT "and the ruler of all you see.": PRINT 
  162. 3790  FOR Y = 1 TO 1700: NEXT 
  163. 3800  PRINT : HTAB 8: PRINT "Have another game? (Y/N) ";
  164. 3805  POKE  -16368,0
  165. 3810  GET A$: PRINT 
  166. 3815  IF A$ = "n"  OR A$ = "N"  THEN 3840
  167. 3820  IF A$ < >"y"  AND A$ < >"Y"  THEN 3810
  168. 3830  CALL 2057: GOTO 230
  169. 3840  POKE  -16303,0: POKE  -16300,0
  170. 3850  POKE 32,0: POKE 34,0
  171. 3860  POKE 33,40
  172. 3870  NORMAL : HOME 
  173. 3880  PRINT  CHR$(4)"bye"
  174. 3910  GOSUB 5000: RETURN 
  175. 3920  REM    ** PICK SQUARE
  176. 3930  GOSUB 4580
  177. 3940 ZZ = 1:GC = 0:PO = 1:XD = 0
  178. 3950  GOTO 3060
  179. 3960 :
  180. 3970 S =  PEEK( -16384)
  181. 3980  IF COMP = DE  THEN 3910
  182. 3990  IF S >127  THEN 4020
  183. 4000 GC = GC +1
  184. 4010 X = A +16:Y = B +10:SH = 30: GOSUB 20: GOTO 3960
  185. 4020  GET A$:XA = J(PO): IF A$ =  CHR$(8)  THEN PO = PO -1:XD = 0
  186. 4030  IF A$ =  CHR$(21)  THEN PO = PO +1:XD = 0
  187. 4035 GC = 0
  188. 4041  IF A$ = "s"  OR A$ = "S"  THEN  GOSUB 1575:XD = 0
  189. 4042  IF A$ = "h"  OR A$ = "H"  THEN  GOSUB 4140: GOSUB 5000:XD = 0: GOTO 3060
  190. 4043  IF A$ = "q"  OR A$ = "Q"  THEN  GOSUB 1530:XD = 0
  191. 4044  IF A$ = "?"  OR A$ = "/"  THEN  GOSUB 500:XD = 0
  192. 4045  IF A$ = "c"  OR A$ = "C"  THEN  GOSUB 1410:XD = 0
  193. 4050  IF A$ =  CHR$(13)  THEN 4140
  194. 4060  IF PO = 0  THEN PO = PP
  195. 4070  IF PO = PP +1  THEN PO = 1
  196. 4074  GOSUB 4140
  197. 4075 XA = J(PO)
  198. 4090  IF A$ =  CHR$(27)  THEN  GOSUB 1530:XD = 0
  199. 4095 XD = XD +1: IF XD >3  THEN  GOSUB 6380
  200. 4110  GOTO 3060
  201. 4120  REM    ** DRAW FIGURE
  202. 4130  GOSUB 4500
  203. 4140  IF  LEFT$(A$(XA),1) = "."  THEN A$(XA) =  RIGHT$(A$(XA),1)
  204. 4150  IF  LEN(A$(XA)) < >1  THEN 4210
  205. 4160  IF A$(XA) = "."  THEN  RETURN 
  206. 4170  IF A$(XA) = "D"  THEN SH = 0:X = 6:Y = 0
  207. 4180  IF A$(XA) = "T"  THEN SH = 2:X = 0:Y = 4
  208. 4190 X = X +A%(XA):Y = Y +B%(XA): GOSUB 20
  209. 4200  RETURN 
  210. 4210  IF A$(XA) = "DT"  THEN 4260
  211. 4220  IF A$(XA) = "TD"  THEN 4290
  212. 4230  IF A$(XA) = "DD"  THEN 4320
  213. 4240  IF A$(XA) = "TT"  THEN 4350
  214. 4250  GOTO 4380
  215. 4260 X = 6 +A%(XA):Y = B%(XA) -4:SH = 0: GOSUB 20:X = X -6:Y = Y +12:SH = 2: GOTO 20
  216. 4290 X = A%(XA):Y = B%(XA) -4:SH = 2: GOSUB 20:X = X +6:Y = Y +8:SH = 0: GOTO 20
  217. 4320 X = 6 +A%(XA):Y = B%(XA) -4:SH = 0: GOSUB 20:Y = Y +10: GOTO 20
  218. 4350 X = A%(XA):Y = B%(XA):SH = 2: GOSUB 20:Y = Y +10: GOTO 20
  219. 4380  IF A$(XA) = "DDD"  OR A$(XA) = "TDD"  OR A$(XA) = "DTD"  THEN A$(XA) = "DD"
  220. 4390  IF A$(XA) = "TTT"  OR A$(XA) = "DTT"  OR A$(XA) = "TDT"  THEN A$(XA) = "TT"
  221. 4400  IF A$(XA) = "DDT"  THEN A$(XA) = "DT"
  222. 4410  IF A$(XA) = "TTD"  THEN A$(XA) = "TD"
  223. 4420  GOTO 4210
  224. 4500  REM    ** DELETE BOX
  225. 4510 SH = 4:X = A%(XA) -2:Y = B%(XA) -5: GOTO 20
  226. 4580  REM    ** FIND PLAY
  227. 4590  GOSUB 6250
  228. 4600 XA = J(1): RETURN 
  229. 5000  REM    *** COMPUTER MOVE
  230. 5010  FOR X = 1 TO 10
  231. 5020 Z%(X) = 0
  232. 5030  IF  RIGHT$(A$(X),1) < >D$(DE)  THEN 5180
  233. 5040  IF DE = 2  THEN FI = X +NUM: GOTO 5060
  234. 5050 FI = X -NUM
  235. 5060  IF FI >10  THEN FI = FI -10
  236. 5070  IF FI <1  THEN FI = FI +10
  237. 5080 FE = DE +1: IF FE = 3  THEN FE = 1
  238. 5090 O$ = D$(DE):P$ = D$(FE)
  239. 5100 EE$(1) = P$ +O$:EE$(2) = O$ +P$:EE$(3) = P$ +P$
  240. 5110  IF A$(FI) = EE$(3)  THEN Z%(X) = 6
  241. 5120  IF A$(FI) = EE$(1)  OR A$(FI) = EE$(2)  THEN Z%(X) = 5
  242. 5130  IF A$(FI) = P$  THEN Z%(X) = 4
  243. 5140  IF A$(FI) = "."  THEN Z%(X) = 3
  244. 5150  IF A$(FI) = O$  THEN Z%(X) = 2
  245. 5160  IF  LEFT$(A$(X),1) = P$  THEN Z%(X) = Z%(X) -.6
  246. 5170  IF  LEN(A$(X)) = 2  AND  LEFT$(A$(X),1) = O$  THEN Z%(X) = Z%(X) +.5
  247. 5180  NEXT 
  248. 5190 Y = 0
  249. 5200  FOR X = 1 TO 10
  250. 5210  IF Z%(X) >Y  THEN Y = Z%(X):XA = X
  251. 5220  NEXT 
  252. 5221  FOR X = 1 TO 10: IF XA = J(X)  THEN PO = X
  253. 5222  NEXT : RETURN 
  254. 5250  REM  ** ARROWS
  255. 5260  FOR XX = 1 TO 10
  256. 5270  IF A$(XX) < >"."  THEN 5300
  257. 5280  GOSUB 6000
  258. 5290 X = VA +12:Y = VB +6:SH = VC: GOSUB 20
  259. 5300  NEXT 
  260. 5310  ROT= 0: RETURN 
  261. 6000  REM  *** DO THE VALUES
  262. 6010  POKE 6,(XX -1)
  263. 6020  POKE 7,(DE -1): CALL 815
  264. 6030 VA =  PEEK(6):VB =  PEEK(7):VC =  PEEK(8): IF   NOT VC  THEN VC = 12: RETURN 
  265. 6031  IF VC = 32  THEN VC = 10: RETURN 
  266. 6032  IF VC = 48  THEN VC = 6: RETURN 
  267. 6033 VC = 8: RETURN 
  268. 6250  REM  ** PLACE PICKER
  269. 6260 PP = 0
  270. 6270  FOR Y = 1 TO 10
  271. 6280  IF  RIGHT$(A$(Y),1) = D$(DE)  THEN PP = PP +1:J(PP) = Y
  272. 6290  NEXT : RETURN 
  273. 6300  REM  ** SONG
  274. 6305  IF TK = 0  THEN  RETURN 
  275. 6310  POKE 6,35: POKE 7,75: CALL 801
  276. 6317  FOR XS = 1 TO 2
  277. 6320  POKE 6,25: POKE 7,110: CALL 801
  278. 6330  POKE 6,20: POKE 7,145: CALL 801
  279. 6340  POKE 6,19: POKE 7,135: CALL 801
  280. 6350  NEXT 
  281. 6360  POKE 6,15: POKE 7,140: CALL 801
  282. 6370  RETURN 
  283. 6380  REM  ** OoPS!
  284. 6390  CALL OBOX,5,9,21,10
  285. 6400  INVERSE : PRINT "Use Left and Right"
  286. 6410  PRINT "Arrows to pick."
  287. 6420  PRINT "Use <RETURN> to"
  288. 6430  PRINT "move the piece."
  289. 6450  PRINT "Press first letter"
  290. 6455  PRINT "for a menu item."
  291. 6460  FOR XD = 1 TO 500: NEXT : PRINT : PRINT "Press <ANY KEY>. "
  292. 6470  POKE  -16384,0: GET A$: CALL CBOX
  293. 6480 XD = 0:GC = 0: RETURN