Turtle graphics - Pythagoras tree

100 gosub 8000:print chr$(147);chr$(5);
105 print "2016-July basic month: terraspin"
110 print "http://reddit.com/r/retrobattlestations"
115 print "written by fozztexx - commodore 64 port by fozztexx"
120 print "commodore 64 basic has bitwise operators so much of the line"
125 print "clipping logic is simplified compared to the apple ii version"
130 print "the commodore 64 has *no* graphics commands at all"
135 print "all graphics has to be done using peeks and pokes"
140 print "line drawing is handled by a complicated routine at 1500"
145 print "individual pixels are then plotted with the routine at 1700"
150 print "2016-08-10 alvalongo"
155 print "name=tortu08.bas"
170 print "========================================"
199 :
200 rem === initialize variables
210 sw=320:sh=200:xs=sw/1000:ys=(sh*4)/(1000*3):k1=1:e=1
220 sw=sw-k1:sh=sh-k1:dg=360:k7=7:k8=8:z0=0:sid=54296
230 p8={pi}/180:rem pi is a c64 constant
235 sid=54272:rem sound device
240 dim b(7),c(39),l(199):rem bitmask, column offset, line
245 gosub 8100
250 rem === set turtle start at center of screen pointing up, pen up
260 tx=500:ty=sh/ys/2:ta=90:tp=z0
265 :
300 rem === get command to execute
301 rem numeric values will be pushed onto a stack
302 rem a command will pop off a value and then execute
303 rem d - lower the pen
304 rem u - raise the pen
305 rem m - move
306 rem t - turn
307 rem ======================
310 cm$="500,700 g d 200 m [ -45 t 150 m [ -45 t 100 m [ -45 t 50 m ] 45 t 50 m"
311 cm$=cm$+" ] 45 t 100 m [ -45 t 50 m ] 45 t 50 m"
312 cm$=cm$+" ] 45 t 150 m [ -45 t 100 m [ -45 t 50 m ] 45 t 50 m"
314 cm$=cm$+" ] 45 t 100 m [ -45 t 50 m ] 45 t 50 m"
390 :
460 rem ### if the program crashes it will
470 rem ### be stuck in graphics mode.
480 rem ### type run 900 to get back to text
490 gosub 6000:gosub 6100
495 :
500 rem === command interpreter
510 ip=k1:sp=z0
520 c$=mid$(cm$,ip,k1)
530 if c$=" " or c$="," then ip=ip+k1:goto 520
531 gosub 9000
535 print ip;",";tx;",";ty;",";ta;",";tp;",";d$
540 if c$>="-" and c$<="9" then v=val(mid$(cm$,ip)):gosub 1010:gosub 1210
550 if c$="(" then v=ip:gosub 1010
560 if c$=")" then gosub 2010
570 if c$="m" then gosub 2510
580 if c$="t" then gosub 3010
590 if c$="u" then gosub 3510
600 if c$="d" then gosub 4010
601 if c$="h" then gosub 7000:rem home
602 if c$="x" then gosub 7100:rem set x
603 if c$="y" then gosub 7200:rem set y
604 if c$="g" then gosub 7300:rem set x and y
605 if c$="b" then gosub 7400:rem set bearing
606 if c$="[" then gosub 7500:rem set push
607 if c$="]" then gosub 7600:rem set pop
610 ip=ip+k1
620 if ip<=len(cm$) then 520
700 get k$:if k$="" then gosub 8200:goto 700
900 print "End"
910 gosub 8000
990 end
1000 rem === push onto stack
1010 sp=sp+k1:sk(sp)=v
1020 return
1025 :
1100 rem === pop from stack
1110 v=sk(sp):sp=sp-k1
1120 return
1125 :
1200 rem === skip over number
1210 ip=ip+k1
1220 if ip>len(cm$) then 1250
1230 c2$=mid$(cm$, ip, k1)
1240 if c2$>="-" and c2$<="9" then goto 1210
1250 ip=ip-k1
1260 return
1265 :
1500 rem === plot a line
1510 x1%=x1:x2%=x2:y1%=y1:y2%=y2
1520 dx%=abs(x2%-x1%):sx%=-k1:if x1%<x2% then sx%=k1
1530 dy%=abs(y2%-y1%):sy%=-k1:if y1%<y2% then sy%=k1
1540 er%=-dy%:if dx%>dy% then er%=dx%
1550 er%=er%/2
1560 gosub 1710
1570 if x1%=x2% and y1%=y2% then return
1580 e2%=er%
1590 if e2%>-dx% then er%=er%-dy%:x1%=x1%+sx%
1600 if x1%=x2% and y1%=y2% then return
1610 if e2%<dy% then er%=er%+dx%:y1%=y1%+sy%
1620 if x1%=x2% and y1%=y2% then return
1630 goto 1560
1640 :
1700 rem === plot a point ===========
1710 by=l(y1%)+c(x1%/k8)
1730 poke by,peek(by) or b(x1% and k7)
1740 return
1750 :
2000 rem === loop instruction end
2010 gosub 1110:bp=v
2020 gosub 1110:lr=v
2030 lr=lr-k1
2040 if lr<k1 then return
2050 v=lr:gosub 1010
2060 v=bp:gosub 1010
2070 ip=bp
2080 return
2085 :
2500 rem === move
2510 gosub 1110
2520 lx=v*cos((dg-ta)*p8):ly=v*sin((dg-ta)*p8)
2530 if tp>z0 then x1=tx:y1=ty:x2=x1+lx:y2=y1+ly:gosub 4510
2540 tx=tx+lx:ty=ty+ly
2550 return
2555 :
3000 rem === turn
3010 gosub 1110
3020 ta=ta-v
3030 if ta<z0  then ta=ta+dg:goto 3030
3040 if ta>=dg then ta=ta-dg:goto 3040
3050 return
3055 :
3500 rem === pen up
3510 tp=k0
3520 return
3525 :
4000 rem === pen down
4010 tp=k1
4020 return
4025:
4500 rem === draw line, clipping if needed
4510 x1=x1*xs:x2=x2*xs:y1=y1*ys:y2=y2*ys
4520 x=x1:y=y1:gosub 5010:c1=c
4530 x=x2:y=y2:gosub 5010:c2=c
4540 if c1=z0 and c2=z0 then gosub 1510:return
4550 if c1 and c2 then return
4560 c=c1:if c=z0 then c=c2
4570 if c and 1 then x=x1+(x2-x1)*(sh-y1)/(y2-y1):y=sh:goto 4610
4580 if c and 2 then x=x1+(x2-x1)*(z0-y1)/(y2-y1):y=z0:goto 4610
4590 if c and 4 then y=y1+(y2-y1)*(sw-x1)/(x2-x1):x=sw:goto 4610
4600 if c and 8 then y=y1+(y2-y1)*(z0-x1)/(x2-x1):x=z0:goto 4610
4610 if c=c1 then x1=x:y1=y:goto 4630
4620 x2=x:y2=y
4630 goto 4520
5000 rem === calculate region code
5010 c=z0
5020 if y>sh then c=c or k1
5030 if y<z0 then c=c or 2
5040 if x>sw then c=c or 4
5050 if x<z0 then c=c or k8
5060 return
5065 :
6000 rem === enable hi-res 320x200 screen
6010 poke 56576,(peek(56576)and 252)or 2:rem video bank 1 at $4000
6015 poke 53272,0+128:rem offset $0000 (hires)+$2000(color)
6020 poke 53265,peek(53265) or 32:rem hires-on
6030 bm=16384:rem bitmap memory at $4000
6040 cm=24576:rem color memory at $6000
6050 for x=0 to 7:b(x)=2^(k7-(x and k7)):next x:rem bit mask
6060 for x=0 to 39:c(x)=k8*x:next x:rem column offset
6070 for y=0 to 199:l(y)=bm+320*int(y/k8)+(y and k7):next y:rem line
6080 return
6095 :
6100 rem === clear hires screen
6110 for i=cm to cm+999:poke i,3:next:rem color
6120 sys 49152:rem clear hires
6130 return
6135 :
7000 rem === home
7010 tx=500:ty=sh/ys/2:ta=90
7020 return
7025 :
7100 rem === set x position
7110 gosub 1110
7120 tx=v
7130 return
7135 :
7200 rem === set y position
7210 gosub 1110
7220 ty=v
7230 return
7235 :
7300 rem === set x and y position
7310 gosub 1110
7320 ty=v
7330 gosub 1110
7340 tx=v
7350 return
7355 :
7400 rem === set bearing
7410 gosub 1110
7420 ta=abs(v)-90
7430 return
7435 :
7500 rem === push
7510 v=ta:gosub 1000
7520 v=ty:gosub 1000
7530 v=tx:gosub 1000
7540 return
7545 :
7600 rem === pop
7610 gosub 1110:tx=v
7620 gosub 1110:ty=v
7630 gosub 1110:ta=v
7640 return
7645 :
8000 rem === enable text screen ===
8010 poke 56576,(peek(56576)and 252)or 3:rem video bank 0 at $0000
8015 poke 53272,16+6:rem offset $0400+$1800
8020 poke 53265,peek(53265) and 223:rem text
8030 return
8100 rem === clear hires screen assembler
8110 s=z0:for by=49152 to 49176
8120 read a:poke by,a:s=s+a:next by
8130 read a:if s<>a then print "error assembly":end
8140 data 169,0,133,251,169,64,133,252
8150 data 162,32,160,0,169,0,145,251
8160 data 136,208,251,230,252,202,208
8170 data 246,96,3919
8180 return
8195 :
8200 rem --- beep
8210 poke sid+4,0:poke sid+5,9:poke sid+6,11:poke sid+24,15
8220 poke sid,95:poke sid+1,41:rem 622hz=10591
8230 poke sid+4,17
8240 z=ti+100
8250 if ti<z then 8250
8260 poke sid+4,16
8270 z=ti+100
8280 if ti<z then 8280
8290 return
9000 rem ===
9010 d$=c$:if c$<"-" and c$>"9" then 9070
9020 jp=ip
9030 jp=jp+k1
9040 if jp>len(cm$) then 9070
9050 c2$=mid$(cm$, jp, k1)
9060 if c2$>="-" and c2$<="9" then d$=d$+c2$:goto 9030
9070 return