home *** CD-ROM | disk | FTP | other *** search
/ Softdisk G-S 131 / SGDS 131.2mg / SDGS.131 / SDC131 / C / MD.3 (.txt) < prev    next >
Encoding:
Applesoft BASIC Source Code  |  1992-08-22  |  7.2 KB  |  233 lines  |  [FC] Applesoft BASIC Program (0x6001)
  1. 120  DIM Q(16),R%(16),S%(16),G%(16),C(20)
  2. 170  RESTORE 
  3. 180 HG = 49234: HCOLOR= 3:NP = 1
  4. 190 MP = 1:CH = 32:BS$ =  CHR$(8):FS$ =  CHR$(21):CR$ =  CHR$(13):UP$ =  CHR$(11):DN$ =  CHR$(10):ES$ =  CHR$(27):BL$ =  CHR$(7)
  5. 200  GOSUB 1060
  6. 210 :
  7. 220  FOR X = 1 TO 16: READ R%(X),S%(X): NEXT 
  8. 230  DATA  4,19,6,16,6,22,8,13,8,19,8,25,10,10,10,16,10,22,10,28
  9. 240  DATA  12,13,12,19,12,25,14,16,14,22,16,19
  10. 250  FOR X = 1 TO 5: READ W$(X): NEXT X
  11. 260  DATA "Create your own magic diamond","Print out your diamond's cells",How to create a Magic Diamond,Main menu,Quit
  12. 270  FOR X = 1 TO 10: READ L$(X): NEXT X
  13. 280  DATA A,B,C,D,E,F,G,H,A(L)L,MENU
  14. 290  GOTO 690
  15. 300  REM  **PRINT OUT DIAMOND**
  16. 310  HPLOT 55,75 TO 139,11 TO 223,75 TO 139,139 TO 55,75
  17. 320  HPLOT 76,59 TO 160,123: HPLOT 97,43 TO 181,107
  18. 330  HPLOT 118,27 TO 202,91: HPLOT 76,91 TO 160,27
  19. 340  HPLOT 97,107 TO 181,43: HPLOT 118,123 TO 202,59
  20. 350  RETURN 
  21. 360  REM   **INPUT ROUTINE**
  22. 370 IN$ = "":T1$ = "_____"
  23. 380  VTAB 24: HTAB 35: PRINT "?HELP": VTAB 22
  24. 390  HTAB  PEEK(231): PRINT  LEFT$(T1$, PEEK(249) - PEEK(231));: HTAB  PEEK(231)
  25. 400  GET T$: IF T$ = ES$  THEN 1410
  26. 410  IF T$ = "/"  OR T$ = "?"  THEN  GOSUB 2280: GOTO 370
  27. 420  ON T$ =  CHR$(13) GOTO 610: IF  PEEK(36) +1 =  PEEK(249)  THEN  IF T$ < > CHR$(8)  THEN  IF T$ < > CHR$(127)  THEN  IF T$ < > CHR$(4)  THEN  PRINT  CHR$(7);: GOTO 400
  28. 430  IF T$ =  CHR$(24)  THEN 370
  29. 450  IF T$ =  CHR$(21)  THEN  GOSUB 550: GOTO 540
  30. 460  IF T$ =  CHR$(8)  THEN  IF  LEN(IN$) = 1  THEN  PRINT  CHR$(8);:IN$ = "": GOTO 400
  31. 470  IF T$ =  CHR$(4)  OR T$ =  CHR$(127)  THEN  IF  LEN(IN$) <2  THEN 370
  32. 480  IF T$ =  CHR$(8)  OR T$ =  CHR$(4)  OR T$ =  CHR$(127)  THEN  IF IN$ = "" GOTO 400
  33. 490  IF T$ =  CHR$(8)  THEN  IF IN$ < >""  THEN  PRINT T$;:IN$ =  LEFT$(IN$, LEN(IN$) -1): GOTO 400
  34. 500  IF T$ =  CHR$(4)  OR T$ =  CHR$(127)  THEN  IF  LEN(IN$) >1  THEN  HTAB  PEEK(231): PRINT  LEFT$(T1$, PEEK(249) - PEEK(231));: HTAB  PEEK(231): PRINT IN$ CHR$(8)"_" CHR$(8);:IN$ =  LEFT$(IN$, LEN(IN$) -1): GOTO 400
  35. 510  IF T$ < CHR$(45)  OR T$ > CHR$(57)  THEN  PRINT  CHR$(7);: GOTO 400
  36. 520  IF T$ =  CHR$(46)  THEN  PRINT  CHR$(7);: GOTO 370
  37. 530  ON T$ <" " GOTO 400
  38. 540  PRINT T$;:IN$ = IN$ +T$: GOTO 400
  39. 550 T$ =  CHR$( SCRN(  PEEK(36), INT( PEEK(37) *2)) + SCRN(  PEEK(36), INT( PEEK(37) *2) +1) *16 -128): IF T$ = "_"  THEN T$ = "": PRINT  CHR$(7);
  40. 560  IF IN$ = ""  THEN  PRINT  CHR$(7);: GOTO 370
  41. 570  IF  LEN(IN$) = 1  THEN  PRINT BS$;BS$;BS$; SPC( 3);
  42. 580  IF  LEN(IN$) = 2  THEN  PRINT BS$;BS$; SPC( 3);
  43. 590  IF  LEN(IN$) = 3  THEN  PRINT BS$; SPC( 3);
  44. 600  RETURN 
  45. 610  ON  PEEK(249) - PEEK(231) <2  OR  PEEK(36) +1 > =  PEEK(249) GOTO 620: FOR US =  PEEK(36) +2 TO  PEEK(249): PRINT  LEFT$(T1$,1);: NEXT 
  46. 620  IF IN$ = ""  THEN  PRINT  CHR$(7);: GOTO 370
  47. 630  IF  LEN(IN$) = 1  THEN  PRINT BS$;BS$;BS$; SPC( 3)
  48. 640  IF  LEN(IN$) = 2  THEN  PRINT BS$;BS$; SPC( 3);
  49. 650  IF  LEN(IN$) = 3  THEN  PRINT BS$; SPC( 3);
  50. 660  RETURN 
  51. 670  GOSUB 1060: GOTO 690
  52. 680  REM   ** MAIN MENU **
  53. 690  VTAB 1: HTAB 13: PRINT "MAGIC DIAMONDS"
  54. 700  VTAB 5: HTAB 15: INVERSE : PRINT "-- MENU --"
  55. 710 M1 = 1
  56. 720  FOR C1 = 1 TO 5: IF M1 = C1  THEN  INVERSE 
  57. 730  HTAB 7: VTAB 2 *C1 +7: PRINT W$(C1): NORMAL 
  58. 740  NEXT 
  59. 750  VTAB 24: HTAB 1: PRINT "ARROWS MOVE HIGHLIGHT - RETURN SELECTS"
  60. 760  GET K$
  61. 770  NORMAL : HTAB 7: VTAB 2 *M1 +7: PRINT W$(M1)
  62. 780  IF (K$ = BS$  OR K$ = UP$)  THEN M1 = M1 -1: IF M1 <1  THEN M1 = 5
  63. 790  IF (K$ = FS$  OR K$ = DN$)  THEN M1 = M1 +1: IF M1 >5  THEN M1 = 1
  64. 800  IF K$ = CR$  THEN  INVERSE : HTAB 7: VTAB 2 *M1 +7: PRINT W$(M1): NORMAL : GOTO 840
  65. 810  IF K$ = ES$  THEN M1 = 5: GOTO 840
  66. 820  INVERSE : HTAB 7: VTAB 2 *M1 +7: PRINT W$(M1): NORMAL 
  67. 830  GOTO 760
  68. 840  ON M1 GOTO 860,880,892,891,890
  69. 850  GOSUB 1060: GOTO 690
  70. 860  GOSUB 1060: GOSUB 1760: GOSUB 310: GOSUB 1800: GOSUB 1110: GOSUB 1940
  71. 870  GOSUB 1210: GOSUB 1430: GOSUB 1490: GOSUB 910: CALL 54915: GOTO 870
  72. 880  GOSUB 1060: GOTO 2060
  73. 890  GOSUB 1060: GOTO 2220
  74. 891  PRINT  CHR$(4)"-md.1"
  75. 892  PRINT  CHR$(4)"-md.2"
  76. 900  REM  ** TEST 20 SETS **
  77. 910 C(1) = Q(1) +Q(3) +Q(6) +Q(10):C(2) = Q(2) +Q(5) +Q(9) +Q(13)
  78. 920 C(3) = Q(4) +Q(8) +Q(12) +Q(15):C(4) = Q(7) +Q(11) +Q(14) +Q(16)
  79. 930 C(5) = Q(1) +Q(2) +Q(4) +Q(7):C(6) = Q(3) +Q(5) +Q(8) +Q(11)
  80. 940 C(7) = Q(6) +Q(9) +Q(12) +Q(14):C(8) = Q(10) +Q(13) +Q(15) +Q(16)
  81. 950 C(9) = Q(7) +Q(8) +Q(9) +Q(10):C(10) = Q(1) +Q(5) +Q(12) +Q(16)
  82. 960 C(11) = Q(1) +Q(3) +Q(2) +Q(5):C(12) = Q(4) +Q(8) +Q(7) +Q(11)
  83. 970 C(13) = Q(12) +Q(15) +Q(14) +Q(16):C(14) = Q(6) +Q(10) +Q(9) +Q(13)
  84. 980 C(15) = Q(5) +Q(9) +Q(8) +Q(12):C(16) = Q(4) +Q(2) +Q(15) +Q(13)
  85. 990 C(17) = Q(3) +Q(6) +Q(11) +Q(14):C(18) = Q(2) +Q(3) +Q(14) +Q(15)
  86. 1000 C(19) = Q(4) +Q(11) +Q(6) +Q(13):C(20) = Q(1) +Q(7) +Q(16) +Q(10)
  87. 1010  FOR X = 1 TO 20
  88. 1020  IF C(X) < >C(1)  THEN  GOSUB 1960: GOSUB 1070: GOTO 1410
  89. 1030  NEXT X
  90. 1040  RETURN 
  91. 1050  REM   ** CLEAR SCREEN **
  92. 1060  HCOLOR= 0: HPLOT 0,0: CALL  -3082: RETURN 
  93. 1070  VTAB 24: HTAB 12: PRINT "- Press a Key -": GET P$
  94. 1080  IF P$ = ES$  THEN 1410
  95. 1090  RETURN 
  96. 1100  REM   ** PRINT PATHS **
  97. 1110  VTAB 1: HTAB 23: PRINT "PATHS:    AB"
  98. 1120  VTAB 2: HTAB 31: PRINT "FH  DE"
  99. 1130  VTAB 3: HTAB 29: PRINT "EG  CG  CF"
  100. 1140  VTAB 4: HTAB 27: PRINT "CD  BF  AE  GH"
  101. 1150  VTAB 5: HTAB 29: PRINT "AH  DH  BD"
  102. 1160  VTAB 6: HTAB 31: PRINT "BG  AC"
  103. 1170  VTAB 7: HTAB 33: PRINT "EF"
  104. 1180  VTAB 1: HTAB 1: PRINT "PATH  ADD":XX = 3
  105. 1190  RETURN 
  106. 1200  REM    ** PATH SELECTION **
  107. 1210  VTAB 19: HTAB 10: PRINT "Which PATH do you wish to use? ";
  108. 1220  VTAB 20: HTAB 2: FOR C1 = 1 TO 10: IF NP = C1  THEN  INVERSE 
  109. 1230  PRINT L$(C1);: NORMAL : PRINT "  ";: NEXT 
  110. 1240  IF K$ < > CHR$(255)  THEN  GET K$
  111. 1241  IF K$ >"@"  AND K$ <"I"  THEN NP =  ASC(K$) -64: GOTO 1220
  112. 1242  IF K$ >"`"  AND K$ <"i"  THEN NP =  ASC(K$) -96: GOTO 1220
  113. 1243  IF K$ = "L"  OR K$ = "l"  THEN NP = 9: GOTO 1220
  114. 1244  IF K$ = "M"  OR K$ = "m"  THEN NP = 10: GOTO 1220
  115. 1250  IF (K$ = BS$  OR K$ = UP$)  THEN NP = NP -1: IF NP <1  THEN NP = 10
  116. 1260  IF (K$ = FS$  OR K$ = DN$)  THEN NP = NP +1: IF NP >10  THEN NP = 1
  117. 1270  IF (K$ = CR$  OR K$ =  CHR$(255))  THEN 1300
  118. 1280  IF K$ = ES$  THEN NP = 10:K$ =  CHR$(255): GOTO 1220
  119. 1290  GOTO 1220
  120. 1300  ON NP GOTO 1320,1330,1340,1350,1360,1370,1380,1390,1400,1410
  121. 1310  GOSUB 2040: GOTO 1210
  122. 1320 P = 1:F$ = "A": RETURN 
  123. 1330 P = 2:F$ = "B": RETURN 
  124. 1340 P = 3:F$ = "C": RETURN 
  125. 1350 P = 4:F$ = "D": RETURN 
  126. 1360 P = 5:F$ = "E": RETURN 
  127. 1370 P = 6:F$ = "F": RETURN 
  128. 1380 P = 7:F$ = "G": RETURN 
  129. 1390 P = 8:F$ = "H": RETURN 
  130. 1400 P = 9:F$ = "+": RETURN 
  131. 1410  POP : GOSUB 1060: GOTO 690
  132. 1420  REM    ** INPUT VALUE FOR PATH **
  133. 1430  VTAB 22: HTAB 4: PRINT "What number is to be added? ";:
  134. 1440  ROT= 36: SCALE= 32: GOSUB 370:V =  VAL(IN$): VTAB 24: HTAB 35: PRINT  SPC( 5)
  135. 1450  FOR X = 1 TO 16:BN = Q(X) +V: IF BN < -999  OR BN >9999  THEN  GOSUB 2160: GOSUB 2040: GOTO 1430
  136. 1460  NEXT X
  137. 1470  RETURN 
  138. 1480  REM  ** FILL PATH AND UPDATE DIAMOND **
  139. 1490  ON P GOTO 1510,1520,1530,1540,1550,1560,1570,1580,1590,1410
  140. 1500  GOTO 1210
  141. 1510 Q(1) = Q(1) +V:Q(9) = Q(9) +V:Q(11) = Q(11) +V:Q(15) = Q(15) +V: GOTO 1600
  142. 1520 Q(1) = Q(1) +V:Q(8) = Q(8) +V:Q(13) = Q(13) +V:Q(14) = Q(14) +V: GOTO 1600
  143. 1530 Q(5) = Q(5) +V:Q(6) = Q(6) +V:Q(7) = Q(7) +V:Q(15) = Q(15) +V: GOTO 1600
  144. 1540 Q(3) = Q(3) +V:Q(7) = Q(7) +V:Q(12) = Q(12) +V:Q(13) = Q(13) +V: GOTO 1600
  145. 1550 Q(3) = Q(3) +V:Q(4) = Q(4) +V:Q(9) = Q(9) +V:Q(16) = Q(16) +V: GOTO 1600
  146. 1560 Q(2) = Q(2) +V:Q(6) = Q(6) +V:Q(8) = Q(8) +V:Q(16) = Q(16) +V: GOTO 1600
  147. 1570 Q(4) = Q(4) +V:Q(5) = Q(5) +V:Q(10) = Q(10) +V:Q(14) = Q(14) +V: GOTO 1600
  148. 1580 Q(2) = Q(2) +V:Q(10) = Q(10) +V:Q(11) = Q(11) +V:Q(12) = Q(12) +V: GOTO 1600
  149. 1590  GOSUB 2020
  150. 1600  GOSUB 1900: GOSUB 1800: GOSUB 1940: GOSUB 1070: GOSUB 2040: RETURN 
  151. 1610 B =  ABS(Q(1))
  152. 1620  FOR I = 2 TO 16
  153. 1630  IF  ABS(Q(I)) >B  THEN B =  ABS(Q(I))
  154. 1640  NEXT I
  155. 1650 N =  LEN( STR$(B)):N = N +1
  156. 1660  FOR J = 1 TO 16:Z$ =  STR$( ABS(Q(J))):G%(J) = N - LEN(Z$): NEXT J
  157. 1670  PRINT : PRINT  SPC( 3 *N); SPC( G%(1));Q(1)
  158. 1680  PRINT  SPC( 2 *N); SPC( G%(2));Q(2); SPC( N); SPC( G%(3));Q(3)
  159. 1690  PRINT  SPC( N); SPC( G%(4));Q(4); SPC( N); SPC( G%(5));Q(5); SPC( N); SPC( G%(6));Q(6)
  160. 1700  PRINT  SPC( G%(7));Q(7); SPC( N); SPC( G%(8));Q(8); SPC( N); SPC( G%(9));Q(9); SPC( N); SPC( G%(10));Q(10)
  161. 1710  PRINT  SPC( N); SPC( G%(11));Q(11); SPC( N); SPC( G%(12));Q(12); SPC( N); SPC( G%(13));Q(13)
  162. 1720  PRINT  SPC( 2 *N); SPC( G%(14));Q(14); SPC( N); SPC( G%(15));Q(15)
  163. 1730  PRINT  SPC( 3 *N); SPC( G%(16));Q(16)
  164. 1740  RETURN 
  165. 1750  REM  ** SET UP BASIC DIAMOND **
  166. 1760 Q(1) = 16:Q(2) = 5:Q(3) = 2:Q(4) = 9:Q(5) = 11:Q(6) = 3:Q(7) = 4:Q(8) = 7
  167. 1770 Q(9) = 10:Q(10) = 13:Q(11) = 14:Q(12) = 6:Q(13) = 8:Q(14) = 15:Q(15) = 12:Q(16) = 1
  168. 1780  RETURN 
  169. 1790  REM  ** FILL UP 16 CELLS **
  170. 1800  FOR X = 1 TO 16: VTAB R%(X): HTAB S%(X): PRINT  SPC( 4): NEXT X
  171. 1810  FOR X = 1 TO 16:AA = R%(X):BB = S%(X):LL =  LEN( STR$(Q(X)))
  172. 1820  IF LL = 1  THEN BB = BB +2
  173. 1830  IF LL = 2  OR LL = 3  THEN BB = BB +1
  174. 1840  VTAB AA: HTAB BB: PRINT Q(X);: NEXT X: RETURN 
  175. 1850  REM  ** CLEAR DIAMOND CELLS **
  176. 1860  FOR X = 1 TO 16: VTAB R%(X): HTAB S%(X): PRINT  SPC( 4): NEXT X: RETURN 
  177. 1870  REM   ** CLEAR PATH/VALUE **
  178. 1880  FOR X = 3 TO 16: VTAB X: HTAB 1: PRINT  SPC( 7): NEXT X:XX = 3: RETURN 
  179. 1890  REM  ** PRINT PATH/VALUE **
  180. 1900  VTAB XX: HTAB 1: PRINT  SPC( 7): HTAB 1: PRINT F$;"  ";V;:XX = XX +1
  181. 1910  IF XX = 17  THEN XX = 3
  182. 1920  RETURN 
  183. 1930  REM  ** CLEAR MAGIC SUM & REWRITE **
  184. 1940  VTAB 17: HTAB 1: PRINT  SPC( 17): HTAB 1: PRINT "Magic Sum = ";Q(1) +Q(3) +Q(6) +Q(10);: HTAB 30: PRINT "ESC:MENU";: RETURN 
  185. 1950  REM  ** FAILED 20 SET TEST **
  186. 1960  VTAB 20: HTAB 1
  187. 1970  PRINT "A mistake has been made. Your diamond"
  188. 1980  PRINT "did not test true! Examine your PATHS."
  189. 1990  PRINT "Program returns to the menu. Try again."
  190. 2000  RETURN 
  191. 2010  REM  ** ALL CELLS **
  192. 2020  IF F$ = "+"  THEN  FOR X = 1 TO 16:Q(X) = Q(X) +V: NEXT X: RETURN 
  193. 2030  REM  ** CLEAR BOTTOM 6 LINES **
  194. 2040  FOR X = 19 TO 24: VTAB X: HTAB 1: PRINT  SPC( 40): NEXT X: RETURN 
  195. 2050  REM  ** PRINT OUT CELLS **
  196. 2060  VTAB 12: HTAB 4: PRINT "Be certain your printer is READY!"
  197. 2070  VTAB 22: HTAB 4: PRINT "Press:  <ESC> for Menu": HTAB 12: PRINT "<any other key> to Print";
  198. 2080  GET A$: IF A$ = ES$  THEN 850
  199. 2090  PRINT  CHR$(4)"PR#0": PRINT  CHR$(4)"PR#1"
  200. 2100  GOSUB 1610
  201. 2110  PRINT 
  202. 2120  PRINT "Magic Sum = ";(Q(1) +Q(3) +Q(6) +Q(10))
  203. 2130  PRINT  CHR$(4)"PR#0": PRINT 
  204. 2140  GOSUB 1060: CALL 2304: POKE 48688, PEEK(0): POKE 48689, PEEK(1): GOTO 170
  205. 2150  REM  ** CELL VALUE SIZE TEST **
  206. 2160  PRINT BL$;: GOSUB 2040
  207. 2170  VTAB 19: HTAB 1
  208. 2180  PRINT "That last value you entered will make"
  209. 2190  PRINT "cell values either greater than 9999"
  210. 2200  PRINT "or less than -999. Try again!!"
  211. 2210  GOSUB 1070: RETURN 
  212. 2220  VTAB 12: HTAB 2
  213. 2230  PRINT "Are you sure you want to quit (Y/N)? ";: GET A$
  214. 2240  IF A$ < >"Y"  AND A$ < >"y"  AND A$ < >"N"  AND A$ < >"n"  THEN  PRINT BL$;: GOTO 2220
  215. 2250  IF A$ = "N"  OR A$ = "n"  THEN  GOSUB 1060: GOTO 690
  216. 2260  PRINT  CHR$(4)"BYE"
  217. 2270  REM  ** HELP AT INPUT **
  218. 2280  VTAB 11: HTAB 35: INVERSE : PRINT "HELP": NORMAL 
  219. 2290  VTAB 12: HTAB 31: PRINT "DEL erase"
  220. 2300  VTAB 13: HTAB 30: PRINT "RTN accept"
  221. 2310  VTAB 14: HTAB 30: PRINT "ESC menu"
  222. 2320  VTAB 15: HTAB 28: PRINT "CTRL/D erase"
  223. 2330  VTAB 16: HTAB 26: PRINT "NEG # Subtrcts"
  224. 2340  VTAB 17: HTAB 27: PRINT "Press a key";: GET A$
  225. 2350  VTAB 11: HTAB 34: PRINT  SPC( 7)
  226. 2360  VTAB 12: HTAB 31: PRINT  SPC( 9)
  227. 2370  VTAB 13: HTAB 29: PRINT  SPC( 12)
  228. 2380  VTAB 14: HTAB 30: PRINT  SPC( 11)
  229. 2390  VTAB 15: HTAB 27: PRINT  SPC( 14)
  230. 2400  VTAB 16: HTAB 25: PRINT  SPC( 16)
  231. 2410  VTAB 17: HTAB 23: PRINT  SPC( 18)
  232. 2420  VTAB 17: HTAB 30: PRINT "ESC:MENU"
  233. 2430  RETURN