home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 63
/
063.d81
/
cg.bas
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
16KB
|
796 lines
100 rem crystal garden
110 rem by ian adam
120 :
130 rem vancouver b.c. canada
140 rem (c) march 1989
150 :
160 :
170 print "[147]";
180 :
190 rem code is first:
200 :
210 r$="00"
220 :
230 rem programmer notes:
240 :
250 rem variables:
260 :
270 cplot = 5900
280 plot = 5903
290 scolr = 5909
300 cursr = 5912
310 dump = 5924
320 box = 5933
330 ft = 5939
340 c = 5952
350 cg = 5957
360 sa = 5960
370 fm = 22*256+240:rem filename base
380 :
390 goto 940
400 :
410 :
420 : jump table:
430 :
440 sys cplot : colours & plot
450 sys plot : draw screen
460 : gets rule from first variable
470 : poke c-1, 128 or 0 , to
480 : wrap pattern around, or not
490 :
500 sys plot+3 : extend the same
510 sys scolr : set screen colours
520 : poke c, background colour
530 : poke c+1, colour bytes
540 : poke c+2, colour nibbles
550 :
560 sys cursr, row [,column]
570 : set cursor row & optional column
580 :
590 sys cursr+3 : set split screen
600 : poke cg, 0 all graphics
610 : poke cg, 40 all text
620 : poke cg, 218 +/- split
630 :
640 sys cursr+6 : cancel split etc.
650 sys dump-3 : check for printer
660 : peek(172)= 0 means printer ok
670 :
680 sys dump : print text
690 sys dump+3 : print hi-res screen
700 sys dump+6 : catch nmi, error
710 : poke c+6 & 7 with line number
720 :
730 sys box : pop message box
740 : poke c+4, box colour
750 :
760 sys box+3 : recall screen
770 sys ftop,n : fill top line with n
780 :
790 :
800 : more memory:
810 :
820 from 5888 10 bytes of structure
830 poke c+3, text background colour
840 poke sa, 2ndary address, text
850 poke sa+1, '' '' , graphics
860 poke sa+2, 10 for lf, 0 if not
870 :
880 : to print these, execute:
890 :
900 open 4,4,7:cmd 4:list 200-930
910 print#4:close 4:end
920 :
930 :
940 bb=255:ul=8192:ur=8504:nb=8:as=48
950 k=198:s1=54276:tr=26:br=53280
960 :
970 rem set seed:
980 :
990 sys ft,0:sys pl
1000 poke 8416,232
1010 r$="1031031332"
1020 :
1030 rem set colours:
1040 :
1050 poke c,4:poke c+1,216:poke c+2,.
1060 :
1070 rem plot screen:
1080 :
1090 poke 53265,27:poke 53269,.
1100 sys 5915:rem enable splitscreen
1110 poke c-1,.:rem wrap
1120 r$="1031031332"
1130 sys cp:rem colours, & plot
1140 :
1150 rem check printer:
1160 :
1170 sys 5921
1180 pr=peek(172)=0
1190 :
1200 rem more setup:
1210 :
1220 sys 5930:rem alter vectors
1230 j=rnd(-ti)
1240 :
1250 poke s1+20,128
1260 poke s1-3,70:poke s1+11,k:poke s1+16,bb:poke s1+14,129
1270 poke s1+1,7:poke s1+2,217:poke s1+20,.
1280 :
1290 rem more images:
1300 :
1310 for i=1 to 2000:next
1320 r$="3302032210"
1330 sys ft,.
1340 for i=8296 to 8400 step 8:poke i,20:next
1350 poke c,5:poke c+1,33:poke c+2,.
1360 sys cp
1370 :
1380 for i=1 to 2000:next
1390 r$="0023010110"
1400 sys ft,0
1410 poke 8336,2:poke 8416,48
1420 poke c,0:poke c+1,34:poke c+2,14
1430 sys cp
1440 for i=1 to 999:next
1450 for i=1 to 6
1460 : a=(i and 1)*16+2
1470 : poke c+1,a:sys sc
1480 : for j=1 to 500-25*a+500*(i=2):next
1490 next
1500 for i=50 to 242 step 16
1510 : poke c+1,i
1520 : sys sc
1530 : for j=1 to 99:next
1540 next
1550 :
1560 :
1570 rem on hidden screen:
1580 :
1590 poke cg,252
1600 print"[154][204][207][193][196][211][212][193][210] presents..."tab(32)"(c) 1989"
1610 print" [195]rystal [199]arden for the 64"
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]"
1630 print" [215]hat you have just seen is a"
1640 print" demonstration of a new graphics"
1650 print" structure, a complex artform that is"
1660 print" grown entirely within your computer."
1670 print" [205]uch like fractals, these crystals are"
1680 print" generated by a simple set of rules.":print
1690 print" [194]y varying the structure, you can"
1700 print" create a near-infinite variety of"
1710 print" crystalline images effortlessly. [217]ou"
1720 print" can choose the seed on which the"
1730 print" crystals grow, and define their"
1740 print" rules of growth. [212]he computer"
1750 print" takes it from there, and creates"
1760 print" your images.":print
1770 print" [214]ideo wallpaper? [217]es, it's that,"
1780 print" but [195][210][217][211][212][193][204] [199][193][210][196][197][206] is much, much"
1790 print" more... [208]ress [210][197][212][213][210][206] to find out.";
1800 :
1810 rem reveal it
1820 :
1830 for i=250 to 26 step-8
1840 : poke cg,i:j=1^1
1850 next
1860 :
1870 rem main program
1880 :
1890 r$="0120123123"
1900 wait k,15:poke k,.
1910 :
1920 gosub 5740, title & beep
1930 :
1940 gosub 6140, response
1950 on reply gosub 2030, 7160, 6230, 5490
1960 :
1970 goto 1920
1980 :
1990 rem ========
2000 :
2010 : enter loop
2020 :
2030 gosub 6010
2040 poke c,c0:poke c+1,c1:poke c+2,c2
2050 r$=o$:s=.
2060 poke c-1,w
2070 i=ls:gosub 3240,seed
2080 print"[147]":sys cp
2090 :
2100 rem * viewing loop *
2110 :
2120 a=peek(c+2):rem select colour
2130 if a=. then a=12
2140 poke 646,a:sys cu,20
2150 :
2160 for i=. to 999:rem await input
2170 : if peek(k) then 2380
2180 next
2190 :
2200 print"[195][210][217][211][212][193][204]: n[146] new m[146] manual x[146] extend"
2210 if peek(c-1)>127 then print " w[146] no";:goto 2230
2220 print" w[146] do";
2230 print" wrap r[146] random a[146] autopilot"
2240 print"[211][197][197][196]: v[146] vary e[146] enter manually"
2250 print"[195][207][204][207][210][211]: [198]keys[146] c[146] random q=quit "
2260 print"[207][213][212][208][213][212]: s[146] save l[146] load p[146] print[145]"
2270 :
2280 tr=210:gosub 5950:a=.:rem show
2290 :
2300 gosub 5900
2310 for i=. to 1600
2320 : if peek(k) then 2370
2330 next
2340 :
2350 sys sc:gosub 6010:goto 2120:rem try again
2360 :
2370 poke cg,.:sys sc
2380 get b$
2390 for h=1 to 18
2400 : if mid$("nxwravpmeslqc[133][134][135][136][140]",h,1)<>b$ then next:h=.
2410 :
2420 if h>12 then gosub 4130:goto 2120
2430 on h gosub 2780,2860,2910,2970,3030,3180,5320,2570,3700,4430,5080
2440 if h=12 then s=.:return
2450 if h then 2120
2460 if val(b$) then h=(27+val(b$)-(val(b$)=8))/2:b$="":goto 2420
2470 if a then 2200
2480 goto 2120
2490 ================
2500 :
2510 * code entry *
2520 :
2530 : r$ is 1st variable
2540 :
2550 : manual entry:
2560 :
2570 print"[147]":sys cu,18
2580 print"[212]he crystal is grown using a structure"
2590 print"of ten digits, each 0 to 3."
2600 print"[197]nter a code, then press [210][197][212][213][210][206]:"
2610 l=.:sys cu,23:print r$"[145]"
2620 tr=194:gosub 5950
2630 poke 204,.:get b$
2640 if (b$>"/" and b$<"4") or b$=" " or b$="" then poke 204,1:print b$;:l=l+1
2650 if b$=chr$(20) or b$="[157]" then if l then poke 204,1:print b$;:l=l-1
2660 if b$<>chr$(13) and l<14 then 2630
2670 poke 204,1
2680 :
2690 r$=""
2700 for i=1944 to 1953
2710 : r$=r$+chr$(peek(i) and 51)
2720 next
2730 sys cp
2740 return
2750 :
2760 : random code
2770 :
2780 r$=""
2790 for i=1 to 10
2800 : r$=r$+chr$(rnd(i)*4+as)
2810 next
2820 sys pl:return
2830 :
2840 : extend crystal
2850 :
2860 sys pl+3
2870 return
2880 :
2890 : wrap
2900 :
2910 poke c-1,bb-peek(c-1)
2920 sys pl
2930 return
2940 :
2950 : 1 random
2960 :
2970 gosub 4280,colors
2980 gosub 3220,seed
2990 goto 2780,code
3000 :
3010 : autopilot
3020 :
3030 for i=1 to 50
3040 : gosub 4280
3050 : gosub 3220
3060 : o$=r$:if peek(k) then return
3070 : gosub 2780
3080 : if peek(k) then return
3090 next
3100 gosub 5900:goto 3030
3110 :
3120 :===============
3130 :
3140 * seed entry *
3150 :
3160 : rnd entry, 7 ways
3170 :
3180 gosub 3220
3190 sys pl
3200 return
3210 :
3220 i=int(rnd(i)*7):if i=ls then 3220
3230 ls=i:poke cg,.
3240 on i goto 3320,3360,3420,3500,3530,3610
3250 :
3260 rem rnd centre
3270 sys ft,.
3280 poke 8344,rnd(i)*bb+1
3290 return
3300 :
3310 : 1 rnd byte across
3320 sys ft,rnd(i)*bb+1
3330 return
3340 :
3350 : rnd bytes across
3360 for i=ul to ur step nb
3370 : poke i,rnd(i)*bb
3380 next
3390 return
3400 :
3410 : several rnd bytes
3420 sys ft,.
3430 for i=ul to 8400 step nb
3440 : i=i+nb*int(rnd(i)*12)
3450 : poke i,rnd(i)*bb
3460 next
3470 return
3480 :
3490 : fill portion
3500 sys ft,.
3510 :
3520 rem change portion
3530 a=ul+nb*int(rnd(i)*15)
3540 b=rnd(i)*