home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1984 July / 1984-07.d64 / bc (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  6KB  |  211 lines
  1. 10 rem quilt squares
  2. 20 goto 310
  3. 30 poke a,103:poke a+1,103:poke a+40,103:poke a+41,103:cc=c(1):return
  4. 40 poke a,103:poke a+1,100:poke a+40,100:poke a+41,96:cc=c(1):return
  5. 50 poke a,102:poke a+1,103:poke a+40,96:poke a+41,102:cc=c(1):return
  6. 60 poke a,101:poke a+1,96:poke a+40,103:poke a+41,101:cc=c(1):return
  7. 70 poke a,96:poke a+1,99:poke a+40,99:poke a+41,103:cc=c(1):return
  8. 80 poke a,96:poke a+1,96:poke a+40,96:poke a+41,96:cc=c(1):return
  9. 90 poke a,160:poke a+1,160:poke a+40,160:poke a+41,160:cc=c(1):return
  10. 100 poke a,160:poke a+1,163:poke a+40,163:poke a+41,103:cc=c(1):return
  11. 110 poke a,160:poke a+1,163:poke a+40,163:poke a+41,103:cc=c(2):return
  12. 120 poke a,165:poke a+1,160:poke a+40,167:poke a+41,165:cc=c(1):return
  13. 130 poke a,167:poke a+1,164:poke a+40,164:poke a+41,160:cc=c(2):return
  14. 140 poke a,167:poke a+1,164:poke a+40,164:poke a+41,160:cc=c(1):return
  15. 150 poke a,166:poke a+1,167:poke a+40,160:poke a+41,166:cc=c(1):return
  16. 160 poke a,166:poke a+1,167:poke a+40,160:poke a+41,166:cc=c(2):return
  17. 170 poke a,165:poke a+1,160:poke a+40,167:poke a+41,165:cc=c(2):return
  18. 180 poke a,224:poke a+1,224:poke a+40,224:poke a+41,224:cc=c(1):return
  19. 190 poke a,224:poke a+1,227:poke a+40,227:poke a+41,231:cc=c(1):return
  20. 200 poke a,224:poke a+1,227:poke a+40,227:poke a+41,231:cc=c(2):return
  21. 210 poke a,224:poke a+1,227:poke a+40,227:poke a+41,231:cc=c(3):return
  22. 220 poke a,229:poke a+1,224:poke a+40,231:poke a+41,229:cc=c(1):return
  23. 230 poke a,229:poke a+1,224:poke a+40,231:poke a+41,229:cc=c(2):return
  24. 240 poke a,229:poke a+1,224:poke a+40,231:poke a+41,229:cc=c(3):return
  25. 250 poke a,231:poke a+1,228:poke a+40,228:poke a+41,224:cc=c(3):return
  26. 260 poke a,231:poke a+1,228:poke a+40,228:poke a+41,224:cc=c(2):return
  27. 270 poke a,231:poke a+1,228:poke a+40,228:poke a+41,224:cc=c(1):return
  28. 280 poke a,230:poke a+1,231:poke a+40,224:poke a+41,230:cc=c(1):return
  29. 290 poke a,230:poke a+1,231:poke a+40,224:poke a+41,230:cc=c(2):return
  30. 300 poke a,230:poke a+1,231:poke a+40,224:poke a+41,230:cc=c(3):return
  31. 310 print "[147]":print "transferring character set"
  32. 320 print "please wait..."
  33. 330 rem transfer character set to ram
  34. 340 poke 56334,0:poke 1,51
  35. 350 for c=2048 to 6143
  36. 360 poke c,peek(c+51200)
  37. 370 next c
  38. 380 poke 1,55:poke 56334,129:poke 53272,19
  39. 390 rem
  40. 400 poke 53281,15
  41. 410 print "[147][151]":print tab(13)"quilt squares"
  42. 420 dim s(16),q(28),r(28)
  43. 430 print "use f1 to move to the quilt square"
  44. 440 print "desired, then press <return>."
  45. 450 print "fill in the sample squares."
  46. 460 rem redefine characters
  47. 470 for c=2048+8*35 to 2048+8*42-1
  48. 480 read g:poke c,g
  49. 490 next c
  50. 500 for c=2048+27*8 to 2048+30*8-1:read g:poke c,g:next c
  51. 510 data 0,1,3,7,15,31,63,127
  52. 520 data 255,254,252,248,240,224,192,128
  53. 530 data 128,192,224,240,248,252,254,255
  54. 540 data 127,63,31,15,7,3,1,0
  55. 550 data 255,255,255,255,255,255,255,255
  56. 560 data 255,128,128,128,128,128,128,128
  57. 570 data 255,1,1,1,1,1,1,1
  58. 580 data 128,128,128,128,128,128,128,255
  59. 590 data 255,129,129,129,129,129,129,255
  60. 600 data 1,1,1,1,1,1,1,255
  61. 610 rem sound
  62. 620 for c=54272 to 54296:poke c,0:next
  63. 630 poke 54296,15:poke 54277,190:poke 54278,248
  64. 640 hf=54273:lf=54272:w=54276
  65. 650 a$="()()()()"
  66. 660 b$="[][][][]"
  67. 670 for i=1 to 16:read s(i):next i
  68. 680 data 1352,1354,1356,1358,1432,1434,1436,1438
  69. 690 data 1512,1514,1516,1518,1592,1594,1596,1598
  70. 700 for i=1 to 28:read q(i),r(i):next i
  71. 710 data 1142,103,1262,100,1382,102,1379,101,1259,99,1139,96
  72. 720 data 1136,160,1256,163,1376,163,1496,165,1499,164,1502,164
  73. 730 data 1622,166,1619,166,1616,165
  74. 740 data 1133,224,1253,227,1373,227,1493,227,1613,229,1733,229,1853,229
  75. 750 data 1856,228,1859,228,1862,228,1742,230,1739,230,1736,230
  76. 760 qq(2)=6:qq(3)=15:qq(4)=28
  77. 770 print "choose number of colors:  2, 3, or 4"
  78. 780 gosub 2020
  79. 790 get e$:if e$<"2" or e$>"4" then 790
  80. 800 n=val(e$)
  81. 810 for i=1 to n
  82. 820 print "choose color ";i
  83. 830 print "[144] [146]   [146]   [146]  [159] [146]  [156] [146]   [146]   [146]  [158] [146]  [129] [151]"
  84. 840 print "0  1  2  3  4  5  6  7  8"
  85. 850 gosub 2020
  86. 860 get e$:if e$<"0" or e$>"8" then 860
  87. 870 c(i)=val(e$)
  88. 880 print tab(3*c(i))"^"
  89. 890 next i
  90. 900 print "[147]"
  91. 910 poke 53282,c(2):poke 53283,c(3):poke 53284,c(4)
  92. 920 poke 53265,peek(53265) or 64
  93. 930 rem print possible squares
  94. 940 rem two colors
  95. 950 cc=c(1)
  96. 960 poke 1139,96:poke 1139+lf,cc
  97. 970 poke 1142,103:poke 1142+lf,cc
  98. 980 poke 1259,99:poke 1259+lf,cc
  99. 990 poke 1262,100:poke 1262+lf,cc
  100. 1000 poke 1379,101:poke 1379+lf,cc
  101. 1010 poke 1382,102:poke 1382+lf,cc
  102. 1020 if n=2 then 1260
  103. 1030 poke 1136,160:poke 1136+lf,cc
  104. 1040 poke 1256,163:poke 1256+lf,cc
  105. 1050 poke 1376,163:poke 1376+lf,c(2)
  106. 1060 poke 1496,165:poke 1496+lf,cc
  107. 1070 poke 1499,164:poke 1499+lf,c(2)
  108. 1080 poke 1502,164:poke 1502+lf,cc
  109. 1090 poke 1616,165:poke 1616+lf,c(2)
  110. 1100 poke 1619,166:poke 1619+lf,c(2)
  111. 1110 poke 1622,166:poke 1622+lf,cc
  112. 1120 if n=3 then 1260
  113. 1130 poke 1133,224:poke 1133+lf,cc
  114. 1140 poke 1253,227:poke 1253+lf,cc
  115. 1150 poke 1373,227:poke 1373+lf,c(2)
  116. 1160 poke 1493,227:poke 1493+lf,c(3)
  117. 1170 poke 1613,229:poke 1613+lf,cc
  118. 1180 poke 1733,229:poke 1733+lf,c(2)
  119. 1190 poke 1853,229:poke 1853+lf,c(3)
  120. 1200 poke 1736,230:poke 1736+lf,c(3)
  121. 1210 poke 1739,230:poke 1739+lf,c(2)
  122. 1220 poke 1742,230:poke 1742+lf,c(1)
  123. 1230 poke 1856,228:poke 1856+lf,c(3)
  124. 1240 poke 1859,228:poke 1859+lf,c(2)
  125. 1250 poke 1862,228:poke 1862+lf,cc
  126. 1260 print ""
  127. 1270 for i=1 to 4
  128. 1280 print tab(8)a$:print tab(8)b$
  129. 1290 next i
  130. 1300 for t=1 to 16
  131. 1310 gosub 2020
  132. 1320 poke s(t),63
  133. 1330 for i=1 to qq(n)
  134. 1340 gosub 2020
  135. 1350 pp=0
  136. 1360 p=peek(q(i)+lf):if p=0 then pp=1
  137. 1370 poke q(i),28:poke q(i)+lf,pp:poke q(i),r(i):poke q(i)+lf,p
  138. 1380 get e$:if e$="" then 1370
  139. 1390 if asc(e$)=13 then 1430
  140. 1400 if e$<>"[133]" then 1370
  141. 1410 next i
  142. 1420 goto 1330
  143. 1430 a=s(t)
  144. 1440 if i>14 then 1470
  145. 1450 on i gosub 30,40,50,60,70,80,90,100,110,120,130,140,150,160
  146. 1460 goto 1480
  147. 1470 on i-14 gosub 170,180,190,200,210,220,230,240,250,260,270,280,290,300
  148. 1480 gosub 2040
  149. 1490 next t
  150. 1500 print ""
  151. 1510 print "press f1 to change"
  152. 1520 print "      f7 to print quilt"
  153. 1530 gosub 2020
  154. 1540 get e$:if e$="[136]" then 1880
  155. 1550 if e$<>"[133]" then 1540
  156. 1560 for i=1744 to 1766:poke i,32:poke i+40,32:next i
  157. 1570 print "[145][145]press return--no change"
  158. 1580 print tab(6)"f1 to change, then"
  159. 1590 print tab(9)"proceed as before"
  160. 1600 for t=1 to 16
  161. 1610 ps=0:a=s(t):gosub 2020
  162. 1620 pt=peek(a+lf):if pt=0 then ps=1
  163. 1630 gosub 2050
  164. 1640 poke a,40:poke a+1,41:poke a+40,27:poke a+41,29
  165. 1650 gosub 2060
  166. 1660 get e$:if e$="" then 1640
  167. 1670 if asc(e$)=13 then 1850
  168. 1680 if e$<>"[133]" then 1640
  169. 1690 poke a,40:poke a+1,41:poke a+40,27:poke a+41,29
  170. 1700 for i=1 to qq(n)
  171. 1710 gosub 2020
  172. 1720 pp=0
  173. 1730 p=peek(q(i)+lf):if p=0 then pp=1
  174. 1740 poke q(i),28:poke q(i)+lf,pp:poke q(i),r(i):poke q(i)+lf,p
  175. 1750 get e$:if e$="" then 1740
  176. 1760 if asc(e$)=13 then 1800
  177. 1770 if e$<>"[133]" then 1740
  178. 1780 next i
  179. 1790 goto 1700
  180. 1800 if i>14 then 1830
  181. 1810 on i gosub 30,40,50,60,70,80,90,100,110,120,130,140,150,160
  182. 1820 goto 1840
  183. 1830 on i-14 gosub 170,180,190,200,210,220,230,240,250,260,270,280,290,300
  184. 1840 gosub 2040
  185. 1850 next t
  186. 1860 for i=1744 to 1769:poke i,32:poke i+40,32:poke i+80,32:next i
  187. 1870 goto 1500
  188. 1880 for t=1 to 16
  189. 1890 a=s(t)
  190. 1900 gosub 2050
  191. 1910 cc=peek(a+lf)
  192. 1920 for b=s(t)-320 to s(t)+320 step 320
  193. 1930 for a=b-8 to b+24 step 8
  194. 1940 gosub 2060:gosub 2040
  195. 1950 next a,b
  196. 1960 next t
  197. 1970 print "press f7 to end program.";
  198. 1980 gosub 2020
  199. 1990 get e$:if e$="[136]" then 2070
  200. 2000 goto 1990
  201. 2010 stop
  202. 2020 poke 198,0:poke hf,84:poke lf,125
  203. 2030 poke w,17:for d=1 to 60:next d:poke w,0:return
  204. 2040 l=a+lf:poke l,cc:poke l+1,cc:poke l+40,cc:poke l+41,cc:return
  205. 2050 a1=peek(a):a2=peek(a+1):a3=peek(a+40):a4=peek(a+41):return
  206. 2060 poke a,a1:poke a+1,a2:poke a+40,a3:poke a+41,a4:return
  207. 2070 print"[147]"
  208. 2080 print "press run/stop - restore"
  209. 2090 print "before running program again."
  210. 2100 end
  211.