PROGRAM LSYS_PENROSE    !(© W.van Duyn 22nd April 2004)
SET WINDOW 0,1199,0,903
SET background color "white"
SET color 0
PRINT"Number of iterations try 1,2,3,4,5,6 or 7; size try 360"
INPUT depth,size
CLEAR
SET COLOR "black"
FLOOD 1,1
SET COLOR MIX (100)0.3,0.3,0.3 !dark gray
SET COLOR MIX (200)0.0,0.8,0.3 !medium green
LET x=600
LET y=450
LET w=round(1.618034^depth)
LET h=size/w
LET k=36
LET a=0
CALL grid(w,h)
SET color 200
FOR i=1 TO 5
CALL generate(depth,h,a,k,x,y)
NEXT i
END

SUB generate(depth,h,a,k,x,y)
CALL push(h,x,y,a)
CALL lsysY(depth,h,a,k,x,y)
CALL pop(h,x,y,a)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
END SUB

SUB lsysW(depth,h,a,k,x,y)
IF depth=0 THEN
CALL moveON(h,x,y,a)
EXIT IF
ELSE
CALL lsysY(depth-1,h,a,k,x,y)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL lsysZ(depth-1,h,a,k,x,y)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL lsysX(depth-1,h,a,k,x,y)
CALL push(h,x,y,a)
CALL turnRIGHT(a,k)
CALL lsysY(depth-1,h,a,k,x,y)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL lsysW(depth-1,h,a,k,x,y)
CALL pop(h,x,y,a)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
END IF
END SUB

SUB lsysX(depth,h,a,k,x,y)
IF depth=0 THEN
CALL moveON(h,x,y,a)
EXIT IF
ELSE
CALL turnLEFT(a,k)
CALL lsysY(depth-1,h,a,k,x,y)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL lsysZ(depth-1,h,a,k,x,y)
CALL push(h,x,y,a)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL lsysW(depth-1,h,a,k,x,y)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL lsysX(depth-1,h,a,k,x,y)
CALL pop(h,x,y,a)
CALL turnLEFT(a,k)
END IF
END SUB

SUB lsysY(depth,h,a,k,x,y)
IF depth=0 THEN
CALL moveON(h,x,y,a)
EXIT IF
ELSE
CALL turnRIGHT(a,k)
CALL lsysW(depth-1,h,a,k,x,y)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL lsysX(depth-1,h,a,k,x,y)
CALL push(h,x,y,a)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL lsysY(depth-1,h,a,k,x,y)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL lsysZ(depth-1,h,a,k,x,y)
CALL pop(h,x,y,a)
CALL turnRIGHT(a,k)
END IF
END SUB

SUB lsysZ(depth,h,a,k,x,y)
IF depth=0 THEN
CALL moveON(h,x,y,a)
EXIT IF
ELSE
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL lsysY(depth-1,h,a,k,x,y)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL lsysW(depth-1,h,a,k,x,y)
CALL push(h,x,y,a)
CALL turnLEFT(a,k)
CALL lsysZ(depth-1,h,a,k,x,y)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL turnLEFT(a,k)
CALL lsysX(depth-1,h,a,k,x,y)
CALL pop(h,x,y,a)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL lsysX(depth-1,h,a,k,x,y)
END IF
END SUB

SUB moveON(h,x,y,a)
OPTION ANGLE degrees
LET dx=h*cos(a)
LET dy=h*sin(a)
PLOT x,y;x+dx,y+dy
LET x=x+dx
LET y=y+dy
END SUB

SUB turnRIGHT(a,k)
LET a=a-k
END SUB

SUB turnLEFT(a,k)
LET a=a+k
END SUB

SUB grid(w,h)
SET COLOR 100
LET dxy=h*(w+1)*2
LET dx=600+h*(w+1)
LET dy=450+h*(w+1)
LET x1=x0
LET y1=y0
FOR j = 0 to (w+1)*2
PLOT x1+dx,y0+dy; x1+dx-dxy,y0+dy
PLOT x0+dx,y1+dy; x0+dx,y1+dy-dxy
LET x0=x0-h
LET y0=y0-h
NEXT j
END SUB

MODULE stack
SHARE state(50,4),level
LET level=1
SUB push(h,x,y,a)
LET state(level,1)=h
LET state(level,2)=x
LET state(level,3)=y
LET state(level,4)=a
LET level=level+1
END SUB
SUB pop(h,x,y,a)
LET level=level-1
LET h=state(level,1)
LET x=state(level,2)
LET y=state(level,3)
LET a=state(level,4)
END SUB
END MODULE