another Logo fractal: flower
Author Message another Logo fractal: flower

Greetings.
Here is another set of routines in MSWLogo which produce
a space-filling curve.
If your monitor is 1024x768 then maximize the MSWLogo window and enter
flower 170 8
It works on my machine;
if it doesn't fill correctly on yours then try flower 170 7.
I pulled out the stops for this one.
It isn't very easy to explain how it works.
One big difference over the previous fractal routines is, when a line
segment gets broken down into smaller segments, the begin and end
points of this chain of segments are NOT the same as the end points
of the original line segment.
If there is interest, I could post a compressed .bmp image showing how
each of the 18 (!) basic patterns involved here breaks a segment into
2, 3, or 4 segments.
Note there are no parameters rev or flip here. I saw no way to include
them.
Here's a challenge for an enterprising student of Logo:
Write routines that will generate a fractal which is NOT a space-filling
curve, but which delineates the outer boundary of the flower. Also
generate the boundary between the inner and outer portions.
Here's a hint: Suppose you superimpose a hexagonal grid (like a
beehive, or a wargame board) on top of the flower pattern so that each
vertex is at the center of a hexagon. The boundary would trace a path
precisely along some of the edges of this hexagonal pattern.

Copy and modify this as you please. Email me if you have questions.
My name is David. Enjoy! :-)

to constantinit :size
make "segs { 3 3 2 2 3 3 2 3 3 3 3 4 4 3 3 4 4 3 }
make "w {{1 3 2}
{1 3 2}
{1 3}
{1 3}
{1 3 2}
{1 3 2}
{1 2}
{1 2 3}
{1 2 3}
{1 3 4}
{1 3 4}
{1 3 4 2}
{1 3 4 2}
{1 3 2}
{1 3 2}
{1 2 4 3}
{1 2 4 3}
{1 2 4}}
make "pat {{11 13 5}
{11 12 7}
{11 14}
{10 17}
{10 18 12}
{10 18 15}
{9 6}
{8 7 12}
{8 7 15}
{4 11 14}
{4 10 17}
{4 10 18 12}
{4 10 18 15}
{1 9 3}
{1 9 6}
{16 9 2 5}
{16 9 1 7}
{16 9 6}}
make "delta {{30 -90 -150}
{30 -90 -150}
{30 -90}
{30 -90}
{30 -90 30}
{30 -90 30}
{-30 90}
{-30 90 150}
{-30 90 150}
{30 -30 -150}
{30 -30 -150}
{30 -30 -150 -30}
{30 -30 -150 -30}
{30 -90 30}
{30 -90 30}
{-30 30 150 30}
{-30 30 150 30}
{-30 30 150}}
make "dely (:size * (sqrt 3) / 2)
make "row1 (:dely * 3 / 2)
make "row2 (:dely / 2)
make "row3 -(:dely / 2)
make "row4 -(:dely * 3 / 2)
make "col1 -(:size * 3 / 2)
make "col2 -(:size)
make "col3 -(:size / 2)
make "col4 0
make "col5 (:size / 2)
make "col6 :size
make "col7 (:size * 3 / 2)
end

to flower :size :maxd
constantinit :size
ht
setsc [0 0 0] cs
setpc [255 128 255]
pu
inner :size :maxd
setpc [255 255 64]
pu
outer :size :maxd
setfc [255 64 255]
pu setxy :col4 (:row3 + ((:row2 - :row3) / 3)) fill
setfc [200 255 100]
pu setxy :col4 (:row1 + ((:row2 - :row1) / 3)) fill
end

to inner :size :maxd
pattern :col4 :row2 -150 :size 2 1 :maxd
pattern :col3 :row3 90 :size 2 1 :maxd
pattern :col5 :row3 -30 :size 2 1 :maxd
end

to outer :size :maxd
pattern :col4 :row4 90 :size 4 1 :maxd
pattern :col6 :row4 30 :size 13 1 :maxd
pattern :col7 :row3 -30 :size 6 1 :maxd
pattern :col6 :row2 -30 :size 4 1 :maxd
pattern :col5 :row1 -90 :size 13 1 :maxd
pattern :col3 :row1 -150 :size 6 1 :maxd
pattern :col2 :row2 -150 :size 4 1 :maxd
pattern :col1 :row3 150 :size 13 1 :maxd
pattern :col2 :row4 90 :size 6 1 :maxd
end

to pattern :x :y :theta :dist :patnum :depth :maxd
(if (:depth = :maxd)
[ setxy :x :y seth :theta pd fd :dist]
[ localmake "endx (:x + ((sin :theta) * :dist))
localmake "endy (:y + ((cos :theta) * :dist))
localmake "thisw (item :patnum :w)
localmake "thispat (item :patnum :pat)
localmake "thisdelta (item :patnum :delta)
localmake "thisdist (:dist / (sqrt 3))
(if (:patnum < 10)
[ localmake "pointx (array 3)
localmake "pointy (array 3)
setitem 1 :pointx (:x + ((sin :theta) * :dist * 2 / 3))
setitem 1 :pointy (:y + ((cos :theta) * :dist * 2 / 3))
setitem 2 :pointx (:endx + ((sin (:theta - 60)) * :dist / 3))
setitem 2 :pointy (:endy + ((cos (:theta - 60)) * :dist / 3))
setitem 3 :pointx (:endx + ((sin (:theta + 60)) * :dist / 3))
setitem 3 :pointy (:endy + ((cos (:theta + 60)) * :dist / 3))
]
[ localmake "pointx (array 4)
localmake "pointy (array 4)
setitem 1 :pointx (:x + ((sin :theta) * :dist / 3))
setitem 1 :pointy (:y + ((cos :theta) * :dist / 3))
setitem 2 :pointx (:endx + ((sin (:theta - 120)) * :dist /
3))
setitem 2 :pointy (:endy + ((cos (:theta - 120)) * :dist /
3))
setitem 3 :pointx (:endx + ((sin (:theta + 120)) * :dist /
3))
setitem 3 :pointy (:endy + ((cos (:theta + 120)) * :dist /
3))
setitem 4 :pointx (:endx + ((sin :theta) * :dist / 3))
setitem 4 :pointy (:endy + ((cos :theta) * :dist / 3)) ] )
localmake "numsegs (item :patnum :segs)
(for [ i 1 :numsegs 1]
[ localmake "thisx (item (item :i :thisw) :pointx)
localmake "thisy (item (item :i :thisw) :pointy)
localmake "thistheta (:theta + (item :i :thisdelta))
localmake "thispatnum (item :i :thispat)
pattern :thisx :thisy :thistheta :thisdist :thispatnum
(:depth + 1) :maxd ] ) ] )
end

Sun, 21 May 2000 03:00:00 GMT

 Page 1 of 1 [ 1 post ]

Relevant Pages

Powered by phpBB® Forum Software