|
PROGRAM LSYS_SIERPINSKI_SQUARECURVE_2 !( © W.van Duyn 26th April 2004)
!warning the scale factor fluctuates between odd and even recursion depths
SET WINDOW 0,1199,0,903
SET background color "white"
SET color 0
PRINT"depth of rcursion try 1 to 12, size try 312,316,318"
INPUT depth,size
CLEAR
SET COLOR MIX (100)0.3,0.3,0.3 !dark gray
SET COLOR MIX (200)0.4,1.0,0.4 !emerald green
SET COLOR 16
FLOOD 1,1
IF mod(depth,2)=1 THEN LET w=round((1.47)^depth) ! odd scale factor
IF mod(depth,2)=0 THEN LET w=round(sqr(2)^depth) ! even scale factor
LET h=size/w
LET y=450+h/2
IF mod(depth,2)=0 THEN
LET x=600-((2^(depth/2))*(1/SQR(2)+1)-1)*h/SQR(2)+h/2
END IF
IF mod(depth,2)=1 THEN
LET x=600-((2^(depth/2))*(1/SQR(2)+1)-1)*h +h/(4*SQR(2))
END IF
LET k=45
LET a=0
CALL grid(w,h)
SET color 200
CALL axiom(depth,h,a,k,x,y)
END
SUB axiom(depth,h,a,k,x,y)
CALL lsysR(depth,h,a,k,x,y)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL moveON(h,x,y,a)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL lsysR(depth,h,a,k,x,y)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL moveON(h,x,y,a)
END SUB
SUB lsysL(depth,h,a,k,x,y)
IF depth=0 THEN
CALL moveON(h,x,y,a)
EXIT IF
ELSE
CALL turnRIGHT(a,k)
CALL lsysR(depth-1,h,a,k,x,y)
CALL turnLEFT(a,k)
CALL moveON(h,x,y,a)
CALL turnLEFT(a,k)
CALL lsysR(depth-1,h,a,k,x,y)
CALL turnRIGHT(a,k)
END IF
END SUB
SUB lsysR(depth,h,a,k,x,y)
IF depth=0 THEN
EXIT IF
ELSE
CALL turnLEFT(a,k)
CALL lsysL(depth-1,h,a,k,x,y)
CALL turnRIGHT(a,k)
CALL moveON(h,x,y,a)
CALL turnRIGHT(a,k)
CALL lsysL(depth-1,h,a,k,x,y)
CALL turnLEFT(a,k)
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=2.5*w*h
LET dx=600+h*w*5/4
LET dy=450+h*w*5/4
LET x1=x0
LET y1=y0
FOR k = 0 to 2.5*w
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 k
END SUB
|