stairs Art/Electric
L-SYSTEMS
back to programs
 
koch snowflakes
general von koch
hilbert curve
pythagorean tree
H-H dragon curve
peano-gosper 19
'H' branching curve
plant
sierpinski square
sierpinski arrow
gosper square
sierpinski curve
spirograph circle
sierpinski carpet
sierpinski gasket
peano-gosper 13
peano-gosper 7
peano curve
penrose tiling
snowflake halls
peano octagon
peano hexagon
levy curve
sierpinski pentagon
not sierpinski
peano curve - H
square knot
sierpinski square 2
koch pentagram
fass curve
square cross
cesaro triangle
realistic snowflake
gray code dragon
sierpinski gasket 3
sierpinski sieve
koch square curve
dekking island
koch island
koch ff curve
hexagon spacefill
 
e-mail
GOSPER SQUARE CURVE (DEKKING)
lsys gosper square curve

PROGRAM Peano_Gosper_Square_curve     ! ©W.van Duyn 20th 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: size try 800, level try 2"
INPUT size,level
CLEAR
SET COLOR "black"
FLOOD 1,1
LET x=(1200-size)/2
LET y=(900-size)/2
LET a=0
LET k=90
LET w=5^level
LET d=size/(w)
LET lev=level
CALL grid(w,d)
SET COLOR 14
CALL move2(d,lev,a,x,y,k)
END SUB

SUB move1(d,lev,a,x,y,k)
IF lev=0 THEN
CALL travelON(d,a,x,y)
EXIT IF
ELSE
CALL move1(d,lev-1,a,x,y,k)!1
CALL move1(d,lev-1,a,x,y,k)!2
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!3
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!4
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!5
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!6
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!7
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!8
CALL move1(d,lev-1,a,x,y,k)!9
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k)!10
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!11
CALL move1(d,lev-1,a,x,y,k)!12
CALL move2(d,lev-1,a,x,y,k)!13
CALL turnRIGHT(a,k)
CALL move1(d,lev-1,a,x,y,k)!14
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k)!15
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!16
CALL move1(d,lev-1,a,x,y,k)!17
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k)!18
CALL turnRIGHT(a,k)
CALL move1(d,lev-1,a,x,y,k)!19
CALL move2(d,lev-1,a,x,y,k)!20
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!21
CALL turnRIGHT(a,k)
CALL move1(d,lev-1,a,x,y,k)!22
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!23
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k)!24
CALL move2(d,lev-1,a,x,y,k)!25
CALL turnRIGHT(a,k)
END IF
END SUB

SUB move2(d,lev,a,x,y,k)
IF lev=0 THEN
CALL travelON(d,a,x,y)
EXIT IF
ELSE
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!1
CALL move1(d,lev-1,a,x,y,k)!2
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!3
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!4
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!5
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!6
CALL move2(d,lev-1,a,x,y,k)!7
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!8
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!9
CALL move2(d,lev-1,a,x,y,k)!10
CALL turnRIGHT(a,k)
CALL move1(d,lev-1,a,x,y,k)!11
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!12
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!13
CALL move2(d,lev-1,a,x,y,k)!14
CALL move2(d,lev-1,a,x,y,k)!15
CALL turnRIGHT(a,k)
CALL move1(d,lev-1,a,x,y,k)!16
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!17
CALL move1(d,lev-1,a,x,y,k)!18
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!19
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k)!20
CALL turnRIGHT(a,k)
CALL move2(d,lev-1,a,x,y,k)!21
CALL turnRIGHT(a,k)
CALL move1(d,lev-1,a,x,y,k)!22
CALL turnLEFT(a,k)
CALL move1(d,lev-1,a,x,y,k)!23
CALL turnLEFT(a,k)
CALL move2(d,lev-1,a,x,y,k)!24
CALL move2(d,lev-1,a,x,y,k)!25
END IF
END SUB

SUB travelON(h,x,y,a)
OPTION ANGLE degrees
LET dx=size*cos(a)
LET dy=size*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,d)
SET COLOR 8
LET dxy=(w+1)*d
LET dx=600+d*(w+1)/2
LET dy=450+d*(w+1)/2
LET x1=x0
LET y1=y0
FOR k = 0 to w+1
PLOT x1+dx,y0+dy; x1+dx-dxy,y0+dy
PLOT x0+dx,y1+dy; x0+dx,y1+dy-dxy
LET x0=x0-d
LET y0=y0-d
NEXT k
END SUB


Website, Text and Some Images Copyright © 2002 tzingaro.com, all rights reserved.