aUCBLogo Demos and Tests / hexagoncurve


to hexagoncurve
; this fractal fills the interior of a regular hexagon.
; each approximation is a simple closed curve.
;
; recommended: max screen resolution 1280x1024 or better
; full screen mswlogo WindowMode
;
; the first parameter is the size of the fractal.
; the 2nd parameter is the depth of recursion.
; example:
   
flake 600 5
end

to initialize
   
setPenColor RGB 0 0 0
   
setScreenColor RGB 1 1 1
   
setFloodColor RGB 0 0 1
   
PenPaint
   
disableLineSmooth
   
setPenSize [1 1]
   
cS
   
make "a [ [-60 .5 3 1 1] [0 .5 2 1 1] [60 .5 3 --1] ]
   
make "b [ [90 0.86602540 4 1 1] [60 .5 1 -1 1] [0 .5 2 1 1] [-60 .5
   
-1 1] ~
   
[-120 .5 1 -1 1] [-120 .5 1 1 1] [0 .5 3 --1] ]
   
make "c [ [-30 0.86602540 4 1 1] [0 .5 2 -1 1] [120 .5 3 --1] ]
   
make "d [ [0 .5 4 1 1] [30 0.28867513 2 -1 1] [-30 0.28867513
   
3 1 -1] ]
   
make "sizes [3 7 3 3]
   
make "specs (Array 4 1)
   
setItem :specs :a
   
setItem :specs :b
   
setItem :specs :c
   
setItem :specs :d
   
hT
end

to doshape :shape :ort :length :mirror :rev :depth
   
(local "segs "lspecs "x "y "start "step "finish "nspec)
   
(local "nshape "nort "nlength "nmirror "nrev "ndepth)
   
(ifelse (:depth==:maxdepth) [(setH :ort) (fd :length)] ~
   
[ (make "segs Item :shape :sizes) ~
   
(make "lspecs Item :shape :specs) ~
   
(make "x xCor) ~
   
(make "y yCor) ~
   
(if (:rev == 1) [(make "start 1) (make "step 1) (make "finish :segs)] ~
   
[(make "start :segs) (make "step -1) (make "finish 1)] ) ~
   
(for [seg :start :finish :step] ~
   
[ (make "nspec Item :seg :lspecs) ~
   
(make "nort :ort + (Item :nspec)*:mirror) ~
   
(make "nlength :length*(Item :nspec)) ~
   
(make "nshape (Item :nspec)) ~
   
(make "nmirror :mirror*(Item :nspec)) ~
   
(make "nrev :rev*(Item :nspec)) ~
   
(make "x :x+(:nlength*Sin(:nort))) ~
   
(make "y :y+(:nlength*Cos(:nort))) ~
   
(make "ndepth :depth+1) ~
   
(doshape :nshape :nort :nlength :nmirror :nrev :ndepth) ~
   
(setXY :x :y) ] ) ] )
end

to flake :size :maxdepth
   
initialize
   
make "ystart ((Sqrt(3))*:size/8)
   
PU
   
setXY :ystart
   
PD
   
make "dist (:size/4)
   
doshape 1 90 :dist 1 1 0
   
doshape 1 150 :dist 1 1 0
   
doshape -150 :dist 1 1 0
   
doshape -90 :dist 1 1 0
   
doshape -30 :dist 1 1 0
   
doshape 1 30 :dist 1 1 0
   
PU
   
setXY 0 0
   
fill
end