|
|
http://mathworld.wolfram.com/LindenmayerSystem.html
http://mathworld.wolfram.com/PeanoCurve.html
http://mathworld.wolfram.com/SierpinskiArrowheadCurve.html
!'LindenmayerSystem
DIM P$(128)
INPUT PROMPT "MODE =":MODE
INPUT PROMPT "LEVEL=":N
LET X0=0
LET Y0=0
LET L=10
LET TH=0
FOR I=32 TO 128
LET P$(I)=CHR$(I)
NEXT I
SELECT CASE MODE
CASE 1
LET PARA$="F"
LET P$(ORD("F"))="F+F--F+F" !'Koch curve
LET TH=0
LET R=60
CASE 2
LET PARA$="F"
LET P$(ORD("F"))="F+F-F-F-F+F+F+F-F" !'Peano curve
LET TH=0
LET R=90
CASE 3
LET PARA$="F+F+F+F"
LET P$(ORD("F"))="F-F+F+FFF-F-F+F" !'Quadratic Koch island
LET TH=0
LET R=90
CASE 4
LET PARA$="F+F+F+F"
LET P$(ORD("F"))="-F+F-F-F+F+FF-F+F+FF+F-F-FF+FF-FF+F+F-FF-F-F+FF-F-F+F+F-F+" !'32-segment curve
LET TH=0
LET R=90
CASE 5
LET PARA$="YF"
LET P$(ORD("X"))="YF+XF+Y" !'Sierpinski arrowhead
LET P$(ORD("Y"))="XF-YF-X"
LET TH=0
LET R=60
CASE 6
LET PARA$="FX"
LET P$(ORD("X"))="X+YF++YF-FX--FXFX-YF+" !'Peano-Gosper curve
LET P$(ORD("Y"))="-FX+YFYF++YF+FX--FX-Y"
LET TH=0
LET R=60
CASE 7
LET PARA$="FXF--FF--FF"
LET P$(ORD("F"))="FF" !'Sierpinski triangle
LET P$(ORD("X"))="--FXF++FXF++FXF--"
LET TH=0
LET R=60
CASE 8
LET PARA$="F+XF+F+XF"
LET P$(ORD("X"))="XF-F+F-XF+F+XF-F+F-X" !'Square curve
LET TH=0
LET R=90
CASE 9
LET PARA$="FX"
LET P$(ORD("X"))="X+YF+" !'Dragon curve
LET P$(ORD("Y"))="-FX-Y"
LET TH=0
LET R=90
CASE 10
LET PARA$="L"
LET P$(ORD("L"))="+RF-LFL-FR+" !'Hilbert curve
LET P$(ORD("R"))="-LF+RFR+FL-"
LET TH=0
LET R=90
CASE 11
LET PARA$="X"
LET P$(ORD("X"))="XFYFX+F+YFXFY-F-XFYFX" !'Hilbert curve2
LET P$(ORD("Y"))="YFXFY-F-XFYFX+F+YFXFY"
LET TH=0
LET R=90
END SELECT
CALL MAKEPARA$(P$,PARA$,N)
CALL TURTLE(PARA$,0,X0,Y0,L,TH,R)
CALL TURTLE(PARA$,1,X0,Y0,L,TH,R)
END
EXTERNAL SUB MAKEPARA$(P$(),PARA$,N)
FOR LEV=1 TO N
LET W$=""
FOR K=1 TO LEN(PARA$)
LET W$=W$&P$(ORD(PARA$(K:K)))
NEXT K
LET PARA$=W$
NEXT LEV
END SUB
EXTERNAL SUB TURTLE(PARA$,FLG,XX,YY,LL,TT,RR)
DIM X(200),Y(200),T(200)
LET SP=1
LET XMIN=1E+10
LET XMAX=-1E+10
LET YMIN=1E+10
LET YMAX=-1E+10
LET TH=TT
LET R=RR
LET X0=XX
LET Y0=YY
LET L=LL
FOR I=1 TO LEN(PARA$)
SELECT CASE PARA$(I:I)
CASE "+"
LET TH=TH+R
CASE "-"
LET TH=TH-R
CASE "F"
LET X1=X0+L*COS(TH*PI/180)
LET Y1=Y0-L*SIN(TH*PI/180)
IF FLG<>0 THEN CALL LINE(X0,Y0,X1,Y1,7)
LET X0=X1
LET Y0=Y1
LET XMIN=MIN(XMIN,X0)
LET XMAX=MAX(XMAX,X0)
LET YMIN=MIN(YMIN,Y0)
LET YMAX=MAX(YMAX,Y0)
CASE "G"
LET X1=X0+L*COS(TH*PI/180)
LET Y1=Y0-L*SIN(TH*PI/180)
LET X0=X1
LET Y0=Y1
CASE "["
LET X(SP)=X0
LET Y(SP)=Y0
LET T(SP)=TH
LET SP=SP+1
CASE "]"
LET SP=SP-1
LET X0=X(SP)
LET Y0=Y(SP)
LET TH=T(SP)
CASE ELSE
END SELECT
NEXT I
IF FLG=0 THEN
LET MAXSIZE=800
LET MINSIZE=400
LET XSIZE=INT(XMAX-XMIN)
LET YSIZE=INT(YMAX-YMIN)
LET R=YSIZE/XSIZE
IF XSIZE>MAXSIZE THEN LET XSIZE=MAXSIZE
IF XSIZE<MINSIZE THEN LET XSIZE=MINSIZE
IF YSIZE/XSIZE<>R THEN LET YSIZE=INT(XSIZE*R)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW XMIN,XMAX,YMAX,YMIN
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END IF
END SUB
EXTERNAL SUB LINE(XS,YS,XE,YE,C)
SET COLOR C
PLOT LINES
PLOT LINES:XS,YS;XE,YE
END SUB
|
|