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 -1] ]
   make "b [ [90 0.86602540 4 1 1] [60 .5 1 -1 1] [0 .5 2 1 1] [-60 .5
   1 -1 1] ~
   [-120 .5 1 -1 1] [-120 .5 1 1 1] [0 .5 3 -1 -1] ]
   make "c [ [-30 0.86602540 4 1 1] [0 .5 2 -1 1] [120 .5 3 -1 -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 1 :specs :a
   setItem 2 :specs :b
   setItem 3 :specs :c
   setItem 4 :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 1 :nspec)*:mirror) ~
   (make "nlength :length*(Item 2 :nspec)) ~
   (make "nshape (Item 3 :nspec)) ~
   (make "nmirror :mirror*(Item 4 :nspec)) ~
   (make "nrev :rev*(Item 5 :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 0 :ystart
   PD
   make "dist (:size/4)
   doshape 1 90 :dist 1 1 0
   doshape 1 150 :dist 1 1 0
   doshape 1 -150 :dist 1 1 0
   doshape 1 -90 :dist 1 1 0
   doshape 1 -30 :dist 1 1 0
   doshape 1 30 :dist 1 1 0
   PU
   setXY 0 0
   fill
end