PROGRAM sierpinski_curve2     ! © W.van Duyn April 2004
!ported from Pascal to True Basic grid added and program ammended
!calculates the entire set 1 thru n plots only n or
!can plot all together, remove condition in moveN() sub progs
SET MODE "color"
SET WINDOW 0,1199,0,903
SET BACKGROUND COLOR "white"
PRINT "input: size try 640, number try 1 through 7 "
INPUT size,number
CLEAR
SET COLOR "white"
FLOOD 10,10
SET COLOR MIX (100) 0.8,0.8,0.8
SET COLOR MIX (200) 0.9,0.1,0.9
LET number$=STR$(number)
LET size$=STR$(size)
LET h = size/4
LET x=2*h+(600-3*size/4)
LET y=3*h+(450-size/2)
LET f=size/(2^(number+2))
!factor used to prevent drawing all curves of order n-1,n-2...etc
!to deactivate - change to: f=size/number
CALL sierpinski(number,h,x,y,f)
SET COLOR "black"
FLOOD 600,450
CALL grid(size,number)
SET COLOR 100
PLOT TEXT, at 600-size/2,430-size/2: "Sierpinski curve, " & "order: " & number$ & " size: " & size$
END

SUB sierpinski(number,h,x,y,f)
SET COLOR 16
LET level=0
DO
LET level=level+1
LET h=h/2
LET x= x-h
LET y= y+h
CALL A(level,f,h,x,y)
CALL move1(h,x,y,f)
CALL B(level,f,h,x,y)
CALL move4(h,x,y,f)
CALL C(level,f,h,x,y)
CALL move6(h,x,y,f)
CALL D(level,f,h,x,y)
CALL move3(h,x,y,f)
LOOP UNTIL level=number
END SUB

SUB A(level,f,h,x,y)
IF level >0 THEN
CALL A(level-1,f,h,x,y)
CALL move1(h,x,y,f)
CALL B(level-1,f,h,x,y)
CALL move2(h,x,y,f)
CALL D(level-1,f,h,x,y)
CALL move3(h,x,y,f)
CALL A(level-1,f,h,x,y)
END IF
END SUB

SUB B(level,f,h,x,y)
IF level >0 THEN
CALL B(level-1,f, h,x,y)
CALL move4(h,x,y,f)
CALL C(level-1,f,h,x,y)
CALL move5(h,x,y,f)
CALL A(level-1,f,h,x,y)
CALL move1(h,x,y,f)
CALL B(level-1,f,h,x,y)
END IF
END SUB

SUB C(level,f,h,x,y)
IF level >0 THEN
CALL C(level-1,f, h,x,y)
CALL move6(h,x,y,f)
CALL D(level-1,f,h,x,y)
CALL move7(h,x,y,f)
CALL B(level-1,f,h,x,y)
CALL move4(h,x,y,f)
CALL C(level-1,f,h,x,y)
END IF
END SUB

SUB D(level,f,h,x,y)
IF level >0 THEN
CALL D(level-1,f,h,x,y)
CALL move3(h,x,y,f)
CALL A(level-1,f,h,x,y)
CALL move8(h,x,y,f)
CALL C(level-1,f,h,x,y)
CALL move6(h,x,y,f)
CALL D(level-1,f,h,x,y)
END IF
END SUB

SUB move1(h,x,y,f)
LET x2=x+h
LET y2=y-h
IF h<=f THEN PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move2(h,x,y,f)
LET x2=x+2*h
LET y2=y+0
IF h<=f THEN PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move3(h,x,y,f)
LET x2=x+h
LET y2=y+h
IF h<=f THEN PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move4(h,x,y,f)
LET x2=x-h
LET y2=y-h
IF h<=f THEN PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move5(h,x,y,f)
LET x2=x+0
LET y2=y-2*h
IF h<=f THEN PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move6(h,x,y,f)
LET x2=x-h
LET y2=y+h
IF h<=f THEN PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move7(h,x,y,f)
LET x2=x-2*h
LET y2=y
IF h<=f THEN PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move8(h,x,y,f)
LET x2=x
LET y2=y+2*h
IF h<=f THEN PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB grid(size,number)
SET COLOR 100
LET g=2^number
LET w=size/g
LET dxy=g*w
LET dx=600-size/2
LET dy=450-size/2
LET x1,x0 =-(w/4)
LET y1,y0 =0
FOR i = 0 to g
PLOT x1+dx,y0+dy; x1+dx+dxy,y0+dy
PLOT x0+dx,y1+dy; x0+dx,y1+dxy+dy
LET x0=x0+w
LET y0=y0+w
NEXT i
END SUB