PROGRAM Sierpinski_Carpet   !VV 3M © W.Van Duyn 25th April 2004
SET MODE "color"
SET WINDOW 0,1199,0,903
SET BACKGROUND COLOR "white"
CLEAR
CALL init
END

SUB init
OPTION ANGLE degrees
PRINT "input: x try 250, y try 50"
INPUT x,y
PRINT "input: Size try 648,level try 4, dimension try 4"
INPUT size,level,ak
CLEAR
SET COLOR 16
FLOOD 1,1
LET k=360/ak
LET r=3
LET d=size/(r^level)
LET a=0
SET COLOR 15
FOR i=1 to ak
CALL shift(level,d,x,y,a,ak,k)
NEXT i
SET COLOR 15
FLOOD x+2,y+2
END SUB

SUB shift(level,d,x,y,a,ak,k)
LET lev=level
CALL move1(d,lev,a,x,y,k,ak)
CALL turnLEFT(a,k)
END SUB

SUB move1(d,lev,a,x,y,k,ak)
IF lev=0 THEN
CALL travelON(d,a,x,y)
EXIT IF
ELSE
CALL move1(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k,ak)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k,ak)
END IF
END SUB

SUB move2(d,lev,a,x,y,k,ak)
IF lev=0 THEN
CALL jump(d,a,x,y)
EXIT IF
ELSE
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k,ak)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k,ak)
END IF
END SUB

SUB erase(d,lev,a,x,y,k,ak)
IF lev=0 THEN
CALL jump(d,a,x,y)
EXIT IF
ELSE
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnRIGHT(a,k)
CALL turnRIGHT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnRIGHT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
CALL turnLEFT(a,k)
CALL erase(d,lev-1,a,x,y,k,ak)
END IF
END SUB

SUB travelON(d,a,x,y)
OPTION ANGLE degrees
LET x2=x+d*cos(a)
LET y2=y+d*sin(a)
PLOT x,y;x2,y2
LET x=x2
LET y=y2
END SUB

SUB jump(d,a,x,y)
OPTION ANGLE degrees
LET x2=x+d*cos(a)
LET y2=y+d*sin(a)
LET x=x2
LET y=y2
END SUB

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

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