home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 63 / 063.d81 / cg.bas (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1989-01-01  |  16.1 KB  |  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)*bb+1
  346. 3550 for i=a to a+nb*int(rnd(i)*22+4) step nb
  347. 3560 : poke i,b
  348. 3570 next
  349. 3580 return
  350. 3590 :
  351. 3600 : select & random
  352. 3610 sys ft,.
  353. 3620 for i=8232 to 8312 step nb
  354. 3630 : poke i,rnd(i)*bb
  355. 3640 next
  356. 3650 poke 8440,rnd(i)*bb+1
  357. 3660 return
  358. 3670 :
  359. 3680 * manual entry *
  360. 3690 :
  361. 3700 print"[147]":sys cu,18
  362. 3710 print" [217]ou may enter seed-value bytes"
  363. 3720 print" into as many consecutive top-row"
  364. 3730 print" positions as you wish.":print
  365. 3740 print" [211]tart position (1 to 40):";
  366. 3750 tr=194:gosub 5950
  367. 3760 a$="20":sys ft,.
  368. 3770 gosub 6940
  369. 3780 if a>40 then 3760
  370. 3790 :
  371. 3800 print"[147]":sys cu,18
  372. 3810 print"[197]nter consecutive seed values, 0 to"bb
  373. 3820 print:print"[208]ress [198]1 to quit:"
  374. 3830 for i=a to 40
  375. 3840 : sys cu,22:print"[208]osition" i "[157]:"
  376. 3850 : gosub 6930
  377. 3860 : if a>bb or b$>"[132]" then 3890
  378. 3870 : poke 8184+i*nb,a
  379. 3880 next
  380. 3890 sys cp:return
  381. 3900 :
  382. 3910 * set up menu *
  383. 3920 :
  384. 3930 print"[147]":poke br,.:poke c+3,.
  385. 3940 if s then sys sc:poke cg,.:return
  386. 3950 o$=r$:r$="0230011133":rem pattern
  387. 3960 w=peek(c-1):poke c-1,bb
  388. 3970 c0=peek(c):c1=peek(c+1):c2=peek(c+2)
  389. 3980 poke c,.:poke c+1,226:poke c+2,13
  390. 3990 :
  391. 4000 a=ul+80:a1=144:a2=129:rem 1st line
  392. 4010 sys ft,a1+1
  393. 4020 poke ul,1:poke ur,a1
  394. 4030 poke a-nb,a1:poke a,a2:poke a+nb,a2-1:poke a+16,.
  395. 4040 b=64:for i=a+24 to 8412 step nb:poke i,b:next
  396. 4050 poke i,.:poke i+nb,a1:poke i+16,a2
  397. 4060 :
  398. 4070 s=bb:sys cp
  399. 4080 return
  400. 4090 :==========
  401. 4100 :
  402. 4110 * colours *
  403. 4120 :
  404. 4130 on h-12 goto 4280,4150,4170,4210,4230,4380
  405. 4140 :
  406. 4150 poke c, peek(c)+1 and 15
  407. 4160 sys sc:return
  408. 4170 a=peek(c+1) and 15
  409. 4180 a=a+1 and 15
  410. 4190 poke c+1, (peek(c+1)and 240)+a
  411. 4200 sys sc:return
  412. 4210 poke c+1, peek(c+1)+16 and bb
  413. 4220 sys sc:return
  414. 4230 poke c+2, peek(c+2)+1 and 15
  415. 4240 sys sc:return
  416. 4250 :
  417. 4260 : rnd colours
  418. 4270 :
  419. 4280 poke c+1,bb*rnd(i):a=peek(c+1) and 15
  420. 4290 poke c+2,rnd(i)*16:b=peek(c+2)
  421. 4300 if a=b then 4290
  422. 4310 i=int(rnd(i)*16)
  423. 4320 if i=a or i=b then 4380
  424. 4330 poke c,i
  425. 4340 sys sc:return
  426. 4350 :
  427. 4360 : std colours
  428. 4370 :
  429. 4380 poke c,.:poke c+1,226:poke c+2,13
  430. 4390 sys sc:return
  431. 4400 :
  432. 4410 :* save *
  433. 4420 :
  434. 4430 print"[147]":gosub7560
  435. 4440 if fl=. then return
  436. 4450 sys cu,17,3
  437. 4460 print"[211]ave [195]rystal to disk as [211][197][197][196] --"
  438. 4470 d$="w":gosub 4630
  439. 4480 if a>19 or b$="[133]" then 5260
  440. 4490 :
  441. 4500 for i=ul to ur step nb
  442. 4510 : print#2,str$(peek(i))
  443. 4520 next
  444. 4530 print#2,peek(c+1)
  445. 4540 print#2,peek(c+2)
  446. 4550 print#2,peek(c)
  447. 4560 print#2,r$+chr$(peek(c-1))
  448. 4570 gosub 4820:if a>19 then 5270
  449. 4580 :
  450. 4590 goto 5250
  451. 4600 :
  452. 4610 : get name, open file
  453. 4620 :
  454. 4630 n$="cg."
  455. 4640 tr=186:gosub 5950
  456. 4650 print"[208]lease enter the name."
  457. 4660 print"[208]ress [198]1 escape"
  458. 4670 print"      [198]7 directory:"
  459. 4680 sys cu,23:print n$"[175] "
  460. 4690 wait k,15:get b$
  461. 4700 if b$=chr$(20) or b$="[157]" then if len(n$)>3 then n$=left$(n$,len(n$)-1)
  462. 4710 if b$=chr$(13) then sys cu,23:print n$" ":goto 4790
  463. 4720 if b$="[133]" then return
  464. 4730 if b$="[136]" then gosub 4910:goto 4640
  465. 4740 if b$<"-" or b$>"z" then 4680
  466. 4750 if b$>"9" then if b$<"a" then 4680
  467. 4760 if len(n$)>15 then n$=left$(n$,15)
  468. 4770 n$=n$+b$:goto 4680
  469. 4780 :
  470. 4790 gosub 6010:poke 788,237
  471. 4800 open 1,8,15
  472. 4810 open 2,8,8,n$+",p,"+d$
  473. 4820 input#1,a,b$
  474. 4830 if a<20 then return
  475. 4840 tr=210:gosub 5950
  476. 4850 poke 788,234:print:print"[208]roblem:" b$
  477. 4860 print"[208]ress space bar"
  478. 4870 wait k,bb:poke k,.
  479. 4880 gosub 6010
  480. 4890 poke 788,234:close 2:close 1:return
  481. 4900 :
  482. 4910 poke 788,239:open 1,8,15:open 2,8,0,"$0:cg.*":rem directory
  483. 4920 print:input#1,a,b$:if a>19 then 4850
  484. 4930 poke cg,10:b$=chr$(34):c$=" "
  485. 4940 for i=1 to 8:get#2,a$,a$,a$,a$,a$:next
  486. 4950 if a$<>b$ then print"[206]o crystals on disk!":goto 4890
  487. 4960 :
  488. 4970 for i=1 to 18:get#2,a$
  489. 4980 if a$<>b$ then printa$;:next:rem name
  490. 4990 :
  491. 5000 for i=1 to 30
  492. 5010 : get#2,a$:if a$=c$ then next
  493. 5020 for i=1 to 4:get#2,a$,a$,a$:next:rem skip
  494. 5030 print:get#2,a$:if a$=b$ then 4970
  495. 5040 goto 4890
  496. 5050 :
  497. 5060 :* load *
  498. 5070 :
  499. 5080 print"[147]":sys cu,17,3
  500. 5090 print"[204]oad [195]rystal from [196]isk"
  501. 5100 d$="r":gosub 4630
  502. 5110 if a>19 or b$="[133]" then 5260
  503. 5120 :
  504. 5130 for i=8192 to 8504 step 8
  505. 5140 : input#2,a$
  506. 5150 : poke i,val(a$) and bb
  507. 5160 next
  508. 5170 input#2,a$:poke c+1,val(a$) and bb
  509. 5180 input#2,a$:poke c+2,val(a$) and bb
  510. 5190 input#2,a$:poke c,val(a$) and bb
  511. 5200 input#2,r$
  512. 5210 if len(r$)<11 then poke c-1,.:goto5250
  513. 5220 poke c-1,val(right$(r$,1))
  514. 5230 r$=left$(r$,10)
  515. 5240 :
  516. 5250 poke 788,234
  517. 5260 close 2:close 1
  518. 5270 sys cp
  519. 5280 return
  520. 5290 :
  521. 5300 : print crystal
  522. 5310 :
  523. 5320 poke 788,237
  524. 5330 sys du-3
  525. 5340 pr=peek(172)=.
  526. 5350 if pr=. then gosub 5430:gosub 6230:sys sc:goto 6010
  527. 5360 :
  528. 5370 sys du+3
  529. 5380 open 4,4,peek(sa)
  530. 5390 print#4,chr$(27)chr$(50);
  531. 5400 :
  532. 5410 if peek(sa+2) then print#4,chr$(13)chr$(14)"[195][207][196][197]: " r$:print#4
  533. 5420 close 4
  534. 5430 poke 788,234
  535. 5440 return
  536. 5450 :
  537. 5460 :
  538. 5470 * quit crystal *
  539. 5480 :
  540. 5490 sys box
  541. 5500 sys cu,19,.:fori=217to242:pokei,peek(i)or128:next
  542. 5510 print tab(24)"[150][209]uit [208]rogram"
  543. 5520 print tab(24)"- [193]re you sure?"
  544. 5530 print tab(25)"[198]1 [195]ontinue"
  545. 5550 print tab(25)"[198]7 [210]eturn":print tab(28) "to [204][207][193][196][211][212][193][210]";
  546. 5580 :
  547. 5590 gosub 6140
  548. 5600 if re-7 then return
  549. 5610 print"[147][199]oodbye from ..."
  550. 5620 print"[153][195][160][210] [217] [211] [212] [193] [204]   [199] [193] [210] [196] [197] [206]"
  551. 5630 :
  552. 5640 sys 5918
  553. 5650 :
  554. 5660 open15,8,15,"r0:hello connect=hello connect"
  555. 5670 input#15,a:close15
  556. 5680 ifa<>63thenend
  557. 5690 print"[147][144]load"chr$(34)"hello connect"chr$(34)",8"
  558. 5700 print"run":poke2048,0:poke44,8:poke631,13:poke632,13:poke198,2:end
  559. 5710 :
  560. 5720 :*  main menu  *
  561. 5730 :
  562. 5740 poke 788,234:gosub 3930, setup
  563. 5750 poke cg,154
  564. 5760 :
  565. 5770 sys cu,13,6:printtab(10)"[153][204][207][193][196][211][212][193][210]  presents"
  566. 5780 print"[150]    [195][160][210][160][217][160][211][160][212][160][193][160][204][160]  [160][160][160][199][160][193][160][210][160][196][160][197][160][206]"
  567. 5790 print"[153][205]ain [205]enu: 1  [154][199]row some [195]rystals       "
  568. 5800 printtab(11)"2  [154][200]elp - [208]rogram [195]ommands  "
  569. 5810 printtab(11)"3  [154][208]rinter [195]ontrols         "
  570. 5820 printtab(11)"4  [154][204]eave [195]rystal [199]arden       "
  571. 5830 print"[153]    [208]ress a [206]umber or [198]unction [203]ey     "
  572. 5840 :
  573. 5850 print"[154]    [194]y  [201]an [193]dam      [214]ancouver [194][195][153]"
  574. 5860 poke s1,21:poke s1+20,143
  575. 5870 for i=20 to k step 20:poke s1-3,i:next
  576. 5880 poke s1,20
  577. 5890 :
  578. 5900 i=rnd(-peek(s1+23))
  579. 5910 return
  580. 5920 :
  581. 5930 rem reveal menu
  582. 5940 :
  583. 5950 a=peek(cg):if a=. then a=250
  584. 5960 b=-8
  585. 5970 goto 6050
  586. 5980 :
  587. 5990 rem conceal menu
  588. 6000 :
  589. 6010 a=peek(cg):if a<50 then a=50
  590. 6020 b=8
  591. 6030 tr=bb
  592. 6040 :
  593. 6050 if peek(c+1)=32 then b=b/4
  594. 6060 for i=a to tr step b
  595. 6070 : poke cg,i and bb:j=b^2
  596. 6080 next
  597. 6090 if tr=bb then poke cg,.
  598. 6100 tr=26:return
  599. 6110 :
  600. 6120 : function key input
  601. 6130 :
  602. 6140 print"":wait k,15
  603. 6150 get a$:re=val(a$)
  604. 6160 if a$>"[132]" then if a$<"[140]" then re=2*asc(a$)-265:if re>7 then re=re-7
  605. 6170 if a$=chr$(13) then re=1
  606. 6180 if re then if re<8 then return
  607. 6190 goto 6140
  608. 6200 :
  609. 6210 :* printer controls *
  610. 6220 :
  611. 6230 print"[158][147]"
  612. 6240 a$="                                     ":printa$
  613. 6250 print"      [195]rystal [199]arden    for the 64   "
  614. 6260 printa$
  615. 6270 print tab(48)"[208]rinter [195]ontrols:"
  616. 6280 tr=24:gosub 5950
  617. 6290 poke 788,239:sys du-3:poke 788,234:rem test
  618. 6300 pr=peek(172)=0
  619. 6310 if pr=0 then 7040
  620. 6320 :
  621. 6330 rem ok
  622. 6340 :
  623. 6350 print tab(43)"[212]he secondary address for text is"
  624. 6360 print"   set to" peek(sa) "for upper/lower case,"
  625. 6370 print"   text mode, auto line feed."
  626. 6380 print tab(43)"[212]he secondary address for graphics"
  627. 6390 print"   is set to" peek(sa+1) "for graphics mode,"
  628. 6400 print"   [206][207] line feed."
  629. 6410 print tab(43)"[208]lease check the manual for your"
  630. 6420 print"   printer or interface for details."
  631. 6430 print tab(45)"[198]1  [195]hange secondary addresses"
  632. 6440 print tab(5)"[198]3  [208]rint help screen"
  633. 6460 print tab(5)"[198]7  [205]ain menu";
  634. 6470 gosub 6140:if (re and 1)=. then 6470
  635. 6480 if re=1 then gosub 6620
  636. 6490 if re=3 then gosub 6540
  637. 6510 if re=7 then return
  638. 6520 goto 6230
  639. 6530 :
  640. 6540 poke 788,239
  641. 6550 open 4,4,peek(sa):cmd 4
  642. 6560 gosub 7320:print#4:close 4
  643. 6570 poke 788,234
  644. 6580 return
  645. 6590 :
  646. 6600 set sec'y addrs
  647. 6610 :
  648. 6620 print"[147]" tab(243)"[212]he text secondary address must"
  649. 6630 print"   be set for upper and lower case,"
  650. 6640 print"   text mode, automatic line feed."
  651. 6650 print tab(163)"[201]f necessary, check your manual."
  652. 6660 print tab(163)"[197]nter secondary address, or press"
  653. 6670 print"   [210][197][212][213][210][206] for" peek(sa)
  654. 6680 gosub 6930
  655. 6690 if a then poke sa,a and bb
  656. 6700 :
  657. 6710 print"[147]" tab(243)"[212]he crystals can only be printed"
  658. 6720 print"   on an [197]pson-compatible printer."
  659. 6730 print tab(123)"[212]he secondary address must be set"
  660. 6740 print"   for transparent graphics mode,"
  661. 6750 print"   [206][207] line feed.  [193] value of 5 works"
  662. 6760 print"   for most interfaces;  however,"
  663. 6770 print"   the [212]ymac needs a 6."
  664. 6780 print tab(123)"[197]nter secondary address, or press"
  665. 6790 print"   [210][197][212][213][210][206] for" peek(sa+1)
  666. 6800 gosub 6930
  667. 6810 if a then poke sa+1,a and bb
  668. 6820 print"[147][195]rystals are normally printed"
  669. 6830 print"with a space between them."
  670. 6840 print"[208]ress:":print "[198]1  ok- return"
  671. 6850 print"[198]7  set printouts with no space between"
  672. 6860 print"   images.  [212]his allows you to extend"
  673. 6870 print"   a crystal and print it as one image."
  674. 6880 gosub 6140:poke sa+2,10*abs(re<7)
  675. 6890 re=1:return
  676. 6900 :
  677. 6910 : input number
  678. 6920 :
  679. 6930 a$=""
  680. 6940 sys cu,23:print a$"[175]   "
  681. 6950 wait k,15:get b$
  682. 6960 if b$=chr$(20) or b$=chr$(157) then if len(a$) then a$=left$(a$,len(a$)-1)
  683. 6970 if b$=chr$(13) or b$>"[132]" then a=val(a$):return
  684. 6980 if b$<"0" or b$>"9" then 6940
  685. 6990 if len(a$)>2 then a$=left$(a$,2)
  686. 7000 a$=a$+b$:goto 6940
  687. 7010 :
  688. 7020 : no printer
  689. 7030 :
  690. 7040 print tab(45)"[212]here is no printer active."
  691. 7050 print tab(45)"[201]f you have a printer, please"
  692. 7060 print tab(5)"check that it is properly"
  693. 7070 print tab(5)"connected, has paper available,"
  694. 7080 print tab(5)"and is turned on."
  695. 7090 print tab(165)"[198]1  activate printer"
  696. 7100 print tab(5)"[198]3  back to menu"
  697. 7110 gosub 6140:if re=1 then 6230
  698. 7120 return
  699. 7130 :
  700. 7140 :*  help screen  *
  701. 7150 :
  702. 7160 print"[147][150]";
  703. 7170 tr=24:gosub 5950
  704. 7180 poke c+3,9:poke br,9
  705. 7190 :
  706. 7200 if pr then 7220
  707. 7210 d$="[150]           [208]ress [198]1 to return          [157][148] ":goto 7240
  708. 7220 d$="[150]     [198]1 [210]eturn        [198]5 [208]rint page    [157][148] "
  709. 7230 :
  710. 7240 gosub 7320
  711. 7250 sys cu,24:printd$;
  712. 7260 wait k,15:get a$
  713. 7270 if a$="5" or a$="[135]" then if pr then 6540
  714. 7280 return
  715. 7290 :
  716. 7300 : help text
  717. 7310 :
  718. 7320 print"   [195][210][217][211][212][193][204] [199][193][210][196][197][206]   --   [200]elp [211]creen    ":print
  719. 7330 poke 646,1:sys cu,1
  720. 7340 print"[212]hese are the commands while viewing:":print
  721. 7350 print"[195]rystal: [206]  [206]ew [195]rystal, automatic"
  722. 7360 print tab(9)"[205]  [206]ew [195]rystal, manual"
  723. 7370 print tab(9)"[216]  [197]xtend same crystal"
  724. 7380 print tab(9)"[215]  [212]urn pattern-wrap on or off"
  725. 7390 print tab(9)"[210]  [210]andom crystal and colors"
  726. 7400 print tab(9)"[193]  [193]utopilot  (any key = quit)"
  727. 7410 print"[211]eed:    [214]  [214]ary pattern (auto seed)"
  728. 7420 print tab(9)"[197]  [197]nter [206]ew [211]eed, manually":print
  729. 7430 print"[195]olors: [198]1  [194]ackground [195]olor"
  730. 7440 print tab(8)"[198]3  [195]hange [195]olor 1"
  731. 7450 print tab(8)"[198]5  [195]hange [195]olor 2"
  732. 7460 print tab(8)"[198]7  [195]hange [195]olor 3"
  733. 7470 print tab(8)"[198]8  [211]tandard [195]olors"
  734. 7480 print tab(9)"[195]  [210]andom [195]olors":print
  735. 7490 print"[197]xtras:  [208]  [208]rint crystal ([197]pson-type)"
  736. 7500 print tab(9)"[211]  [211]ave crystal to disk"
  737. 7510 print tab(9)"[204]  [204]oad crystal from disk"
  738. 7520 print tab(9)"[209]  [209]uit - back to main menu"
  739. 7530 return
  740. 7540 :
  741. 7550 :
  742. 7560 print"[147]":gosub5950
  743. 7570 print"     [211]ave picture in which format?"
  744. 7580 print"       [158][203][155]oala"
  745. 7590 print"       [158][193][155]dvanced [207][195][208]"
  746. 7600 print"       [158][211][155]eed (mathematical data)"
  747. 7610 print"       [159][197][154]xit[156]"
  748. 7620 waitk,15 : geta$
  749. 7630 ifa$<>"s"thengoto7650
  750. 7640 fl=1:goto7670
  751. 7650 ifa$<>"e"thengoto7690
  752. 7660 fl=0
  753. 7670 print"[147]":gosub6010:return
  754. 7680 :
  755. 7690 ifa$<>"k"thengoto7760
  756. 7700 ml=10
  757. 7710 en$="[203]oala":un$="'[193][146]pic ' prefix"
  758. 7720 gosub 7860:ifms=.thengoto7660
  759. 7730 poke788,239:sys5632:poke788,234
  760. 7740 goto7660: rem get back jo-jo
  761. 7750 :
  762. 7760 ifa$<>"a"thengoto7620
  763. 7770 ml=12:px$=""
  764. 7780 en$="[193]dvanced [207][195][208]"
  765. 7790 un$="'mpic' suffix"
  766. 7800 gosub 7860:ifms=.thengoto7660
  767. 7810 poke788,239:sys5635:poke788,234
  768. 7820 goto7660: rem to were you belong
  769. 7830 :
  770. 7840 :-------------------------------
  771. 7850 :
  772. 7860 print"[147][155]  [208]lease enter ";en$;"[155] filename --"
  773. 7870 print"        [[205]aximum of";ml;" [155]characters]"
  774. 7880 print"        [159][ ";un$
  775. 7890 print"            is [206][207][212] required.]"
  776. 7900 ms=. : bs$="" : l$="[164][164][164][164][164][164][164][164][164][164][164][164]"
  777. 7910 print"[145]";bs$;right$(l$,ml-ms):waitk,15:geta$
  778. 7920 ifa$="[133]"thenms=.:goto7950
  779. 7930 ifa$<>chr$(13)thengoto7960
  780. 7940 ifms>.thengoto8040
  781. 7950 print"[147]" : return
  782. 7960 ifa$<>"[157]"anda$<>chr$(20)then7990
  783. 7970 ifms>0thenms=ms-1:bs$=left$(bs$,ms)
  784. 7980 goto 7910
  785. 7990 ifa$<"0"then7910
  786. 8000 if(a$>"9"anda$<"a")ora$>"z"then7910
  787. 8010 ifms=mlthen7910
  788. 8020 bs$=bs$+a$:ms=ms+1:goto7910
  789. 8030 :
  790. 8040 ifml<>10thengoto8060
  791. 8050 fs$=left$(chr$(129)+"pic "+bs$+"          ",15):ms=15:goto8070
  792. 8060 bs$=bs$+"           ":fs$=left$(bs$,12)+"mpic":ms=16
  793. 8070 forx=1toms:poke((fm-1)+x),asc(mid$(fs$,x,1)):next:print"[147]"
  794. 8080 poke5712,ms : ms=1 : return
  795. 10000 open15,8,15,"s0:cg.bas":close15:save"cg.bas",8:end
  796.