home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 63 / 063.d81 / cg.bas (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  16KB  |  796 lines
  1. 100 rem  crystal garden
  2. 110 rem   by ian adam
  3. 120 :
  4. 130 rem  vancouver b.c. canada
  5. 140 rem     (c) march 1989
  6. 150 :
  7. 160 :
  8. 170 print "[147]";
  9. 180 :
  10. 190 rem code is first:
  11. 200 :
  12. 210 r$="00"
  13. 220 :
  14. 230 rem programmer notes:
  15. 240 :
  16. 250 rem variables:
  17. 260 :
  18. 270 cplot = 5900
  19. 280 plot  = 5903
  20. 290 scolr = 5909
  21. 300 cursr = 5912
  22. 310 dump  = 5924
  23. 320 box   = 5933
  24. 330 ft    = 5939
  25. 340 c     = 5952
  26. 350 cg    = 5957
  27. 360 sa    = 5960
  28. 370 fm = 22*256+240:rem filename base
  29. 380 :
  30. 390 goto 940
  31. 400 :
  32. 410 :
  33. 420 : jump table:
  34. 430 :
  35. 440 sys cplot    : colours & plot
  36. 450 sys plot     : draw screen
  37. 460 : gets rule from first variable
  38. 470 : poke c-1, 128 or 0 , to
  39. 480 :  wrap pattern around, or not
  40. 490 :
  41. 500 sys plot+3   : extend the same
  42. 510 sys scolr    : set screen colours
  43. 520 : poke c,   background colour
  44. 530 : poke c+1, colour bytes
  45. 540 : poke c+2, colour nibbles
  46. 550 :
  47. 560 sys cursr, row [,column]
  48. 570 : set cursor row & optional column
  49. 580 :
  50. 590 sys cursr+3  : set split screen
  51. 600 : poke cg,  0   all graphics
  52. 610 : poke cg,  40  all text
  53. 620 : poke cg,  218 +/- split
  54. 630 :
  55. 640 sys cursr+6 : cancel split etc.
  56. 650 sys dump-3  : check for printer
  57. 660 : peek(172)= 0 means printer ok
  58. 670 :
  59. 680 sys dump    : print text
  60. 690 sys dump+3  : print hi-res screen
  61. 700 sys dump+6  : catch nmi, error
  62. 710 : poke c+6 & 7 with line number
  63. 720 :
  64. 730 sys box     : pop message box
  65. 740 : poke c+4, box colour
  66. 750 :
  67. 760 sys box+3   : recall screen
  68. 770 sys ftop,n  : fill top line with n
  69. 780 :
  70. 790 :
  71. 800 : more memory:
  72. 810 :
  73. 820 from 5888  10 bytes of structure
  74. 830 poke c+3,  text background colour
  75. 840 poke sa,   2ndary address, text
  76. 850 poke sa+1,   ''     ''  , graphics
  77. 860 poke sa+2, 10 for lf, 0 if not
  78. 870 :
  79. 880 : to print these, execute:
  80. 890 :
  81. 900 open 4,4,7:cmd 4:list 200-930
  82. 910 print#4:close 4:end
  83. 920 :
  84. 930 :
  85. 940 bb=255:ul=8192:ur=8504:nb=8:as=48
  86. 950 k=198:s1=54276:tr=26:br=53280
  87. 960 :
  88. 970 rem set seed:
  89. 980 :
  90. 990 sys ft,0:sys pl
  91. 1000 poke 8416,232
  92. 1010 r$="1031031332"
  93. 1020 :
  94. 1030 rem set colours:
  95. 1040 :
  96. 1050 poke c,4:poke c+1,216:poke c+2,.
  97. 1060 :
  98. 1070 rem plot screen:
  99. 1080 :
  100. 1090 poke 53265,27:poke 53269,.
  101. 1100 sys 5915:rem enable splitscreen
  102. 1110 poke c-1,.:rem wrap
  103. 1120 r$="1031031332"
  104. 1130 sys cp:rem colours, & plot
  105. 1140 :
  106. 1150 rem check printer:
  107. 1160 :
  108. 1170 sys 5921
  109. 1180 pr=peek(172)=0
  110. 1190 :
  111. 1200 rem more setup:
  112. 1210 :
  113. 1220 sys 5930:rem alter vectors
  114. 1230 j=rnd(-ti)
  115. 1240 :
  116. 1250 poke s1+20,128
  117. 1260 poke s1-3,70:poke s1+11,k:poke s1+16,bb:poke s1+14,129
  118. 1270 poke s1+1,7:poke s1+2,217:poke s1+20,.
  119. 1280 :
  120. 1290 rem more images:
  121. 1300 :
  122. 1310 for i=1 to 2000:next
  123. 1320 r$="3302032210"
  124. 1330 sys ft,.
  125. 1340 for i=8296 to 8400 step 8:poke i,20:next
  126. 1350 poke c,5:poke c+1,33:poke c+2,.
  127. 1360 sys cp
  128. 1370 :
  129. 1380 for i=1 to 2000:next
  130. 1390 r$="0023010110"
  131. 1400 sys ft,0
  132. 1410 poke 8336,2:poke 8416,48
  133. 1420 poke c,0:poke c+1,34:poke c+2,14
  134. 1430 sys cp
  135. 1440 for i=1 to 999:next
  136. 1450 for i=1 to 6
  137. 1460 : a=(i and 1)*16+2
  138. 1470 : poke c+1,a:sys sc
  139. 1480 : for j=1 to 500-25*a+500*(i=2):next
  140. 1490 next
  141. 1500 for i=50 to 242 step 16
  142. 1510 : poke c+1,i
  143. 1520 : sys sc
  144. 1530 : for j=1 to 99:next
  145. 1540 next
  146. 1550 :
  147. 1560 :
  148. 1570 rem on hidden screen:
  149. 1580 :
  150. 1590 poke cg,252
  151. 1600 print"[154][204][207][193][196][211][212][193][210] presents..."tab(32)"(c) 1989"
  152. 1610 print"      [195]rystal [199]arden  for the 64"
  153. 1620 print"      [183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]"
  154. 1630 print"   [215]hat you have just seen is a"
  155. 1640 print" demonstration of a new graphics"
  156. 1650 print" structure, a complex artform that is"
  157. 1660 print" grown entirely within your computer."
  158. 1670 print" [205]uch like fractals, these crystals are"
  159. 1680 print" generated by a simple set of rules.":print
  160. 1690 print"   [194]y varying the structure, you can"
  161. 1700 print" create a near-infinite variety of"
  162. 1710 print" crystalline images effortlessly.  [217]ou"
  163. 1720 print" can choose the seed on which the"
  164. 1730 print" crystals grow, and define their"
  165. 1740 print" rules of growth.  [212]he computer"
  166. 1750 print" takes it from there, and creates"
  167. 1760 print" your images.":print
  168. 1770 print"   [214]ideo wallpaper?  [217]es, it's that,"
  169. 1780 print" but [195][210][217][211][212][193][204] [199][193][210][196][197][206] is much, much"
  170. 1790 print" more...    [208]ress [210][197][212][213][210][206] to find out.";
  171. 1800 :
  172. 1810 rem reveal it
  173. 1820 :
  174. 1830 for i=250 to 26 step-8
  175. 1840 : poke cg,i:j=1^1
  176. 1850 next
  177. 1860 :
  178. 1870 rem main program
  179. 1880 :
  180. 1890 r$="0120123123"
  181. 1900 wait k,15:poke k,.
  182. 1910 :
  183. 1920 gosub 5740, title & beep
  184. 1930 :
  185. 1940 gosub 6140, response
  186. 1950 on reply gosub 2030, 7160, 6230, 5490
  187. 1960 :
  188. 1970 goto 1920
  189. 1980 :
  190. 1990 rem ========
  191. 2000 :
  192. 2010 : enter loop
  193. 2020 :
  194. 2030 gosub 6010
  195. 2040 poke c,c0:poke c+1,c1:poke c+2,c2
  196. 2050 r$=o$:s=.
  197. 2060 poke c-1,w
  198. 2070 i=ls:gosub 3240,seed
  199. 2080 print"[147]":sys cp
  200. 2090 :
  201. 2100 rem * viewing loop *
  202. 2110 :
  203. 2120 a=peek(c+2):rem select colour
  204. 2130 if a=. then a=12
  205. 2140 poke 646,a:sys cu,20
  206. 2150 :
  207. 2160 for i=. to 999:rem await input
  208. 2170 : if peek(k) then 2380
  209. 2180 next
  210. 2190 :
  211. 2200 print"[195][210][217][211][212][193][204]: n[146] new  m[146] manual x[146] extend"
  212. 2210 if peek(c-1)>127 then print "      w[146] no";:goto 2230
  213. 2220 print"      w[146] do";
  214. 2230 print" wrap r[146] random a[146] autopilot"
  215. 2240 print"[211][197][197][196]:    v[146] vary e[146] enter manually"
  216. 2250 print"[195][207][204][207][210][211]:  [198]keys[146]  c[146] random       q=quit  "
  217. 2260 print"[207][213][212][208][213][212]:  s[146] save l[146] load   p[146] print[145]"
  218. 2270 :
  219. 2280 tr=210:gosub 5950:a=.:rem show
  220. 2290 :
  221. 2300 gosub 5900
  222. 2310 for i=. to 1600
  223. 2320 : if peek(k) then 2370
  224. 2330 next
  225. 2340 :
  226. 2350 sys sc:gosub 6010:goto 2120:rem try again
  227. 2360 :
  228. 2370 poke cg,.:sys sc
  229. 2380 get b$
  230. 2390 for h=1 to 18
  231. 2400 : if mid$("nxwravpmeslqc[133][134][135][136][140]",h,1)<>b$ then next:h=.
  232. 2410 :
  233. 2420 if h>12 then gosub 4130:goto 2120
  234. 2430 on h gosub 2780,2860,2910,2970,3030,3180,5320,2570,3700,4430,5080
  235. 2440 if h=12 then s=.:return
  236. 2450 if h then 2120
  237. 2460 if val(b$) then h=(27+val(b$)-(val(b$)=8))/2:b$="":goto 2420
  238. 2470 if a then 2200
  239. 2480 goto 2120
  240. 2490 ================
  241. 2500 :
  242. 2510 *  code entry  *
  243. 2520 :
  244. 2530 : r$ is 1st variable
  245. 2540 :
  246. 2550 : manual entry:
  247. 2560 :
  248. 2570 print"[147]":sys cu,18
  249. 2580 print"[212]he crystal is grown using a structure"
  250. 2590 print"of ten digits, each 0 to 3."
  251. 2600 print"[197]nter a code, then press [210][197][212][213][210][206]:"
  252. 2610 l=.:sys cu,23:print r$"[145]"
  253. 2620 tr=194:gosub 5950
  254. 2630 poke 204,.:get b$
  255. 2640 if (b$>"/" and b$<"4") or b$=" " or b$="" then poke 204,1:print b$;:l=l+1
  256. 2650 if b$=chr$(20) or b$="[157]" then if l then poke 204,1:print b$;:l=l-1
  257. 2660 if b$<>chr$(13) and l<14 then 2630
  258. 2670 poke 204,1
  259. 2680 :
  260. 2690 r$=""
  261. 2700 for i=1944 to 1953
  262. 2710 : r$=r$+chr$(peek(i) and 51)
  263. 2720 next
  264. 2730 sys cp
  265. 2740 return
  266. 2750 :
  267. 2760 : random code
  268. 2770 :
  269. 2780 r$=""
  270. 2790 for i=1 to 10
  271. 2800 :  r$=r$+chr$(rnd(i)*4+as)
  272. 2810 next
  273. 2820 sys pl:return
  274. 2830 :
  275. 2840 : extend crystal
  276. 2850 :
  277. 2860 sys pl+3
  278. 2870 return
  279. 2880 :
  280. 2890 : wrap
  281. 2900 :
  282. 2910 poke c-1,bb-peek(c-1)
  283. 2920 sys pl
  284. 2930 return
  285. 2940 :
  286. 2950 : 1 random
  287. 2960 :
  288. 2970 gosub 4280,colors
  289. 2980 gosub 3220,seed
  290. 2990 goto 2780,code
  291. 3000 :
  292. 3010 : autopilot
  293. 3020 :
  294. 3030 for i=1 to 50
  295. 3040 : gosub 4280
  296. 3050 : gosub 3220
  297. 3060 : o$=r$:if peek(k) then return
  298. 3070 : gosub 2780
  299. 3080 : if peek(k) then return
  300. 3090 next
  301. 3100 gosub 5900:goto 3030
  302. 3110 :
  303. 3120 :===============
  304. 3130 :
  305. 3140 *  seed entry  *
  306. 3150 :
  307. 3160 : rnd entry, 7 ways
  308. 3170 :
  309. 3180 gosub 3220
  310. 3190 sys pl
  311. 3200 return
  312. 3210 :
  313. 3220 i=int(rnd(i)*7):if i=ls then 3220
  314. 3230 ls=i:poke cg,.
  315. 3240 on i goto 3320,3360,3420,3500,3530,3610
  316. 3250 :
  317. 3260 rem rnd centre
  318. 3270 sys ft,.
  319. 3280 poke 8344,rnd(i)*bb+1
  320. 3290 return
  321. 3300 :
  322. 3310 : 1 rnd byte across
  323. 3320 sys ft,rnd(i)*bb+1
  324. 3330 return
  325. 3340 :
  326. 3350 : rnd bytes across
  327. 3360 for i=ul to ur step nb
  328. 3370 : poke i,rnd(i)*bb
  329. 3380 next
  330. 3390 return
  331. 3400 :
  332. 3410 : several rnd bytes
  333. 3420 sys ft,.
  334. 3430 for i=ul to 8400 step nb
  335. 3440 : i=i+nb*int(rnd(i)*12)
  336. 3450 : poke i,rnd(i)*bb
  337. 3460 next
  338. 3470 return
  339. 3480 :
  340. 3490 : fill portion
  341. 3500 sys ft,.
  342. 3510 :
  343. 3520 rem change portion
  344. 3530 a=ul+nb*int(rnd(i)*15)
  345. 3540 b=rnd(i)*