-- The beauty of fractals:
-- with a "plotter" object which directly writes to Tcl/Tk:
import Tk
import Ports
---------------------------------------------------------------------
-- a plotter object: messages:
-- PlotTo x y wp: move plotter to position (x,y) and write line to wish wp
-- CurrentPos x y: unify x y with current plotter position
-- Final: terminate plotter
data PlotterMsg = RLineTo Int Int | Final
plotter :: ((Int,Int),(Port SP_Msg,(TkRefType,String))) -> [PlotterMsg]
-> Success
plotter _ (Final :_) = success
plotter ((x,y),wpr) ((RLineTo tx ty) :ms) =
plotLine wpr [(x,y),(x+tx,y+ty)] &> plotter ((x+tx,y+ty),wpr) ms
plotLine (wport,(cref,color)) cs =
tkCAddCanvas cref [TkLine cs ("-fill "++color)] wport
---------------------------------------------------------------------
-- drawing fractal curves:
left p h = send (RLineTo (-h) 0) p
right p h = send (RLineTo h 0) p
up p h = send (RLineTo 0 (-h)) p
down p h = send (RLineTo 0 h) p
data FigureType stroketype = Figure stroketype (FigureType stroketype)
(FigureType stroketype)
(FigureType stroketype)
fr = Figure right fr fu fd
fu = Figure up fu fl fr
fd = Figure down fd fr fl
fl = Figure left fl fd fu
draw (Figure s f1 f2 f3) order diff p =
if order==0 then s p diff
else draw f1 (order-1) h p &>
draw f2 (order-1) (h-1) p &>
draw f1 (order-1) h p &>
draw f3 (order-1) (h-1) p &>
draw f1 (order-1) h p &>
s p (diff-3*h) -- to avoid rounding problems
where h = diff `div` 3
draw_all order diff p = draw fr order diff p &>
draw fd order diff p &>
draw fl order diff p &>
draw fu order diff p
fractal i x y d wpr
| let pp free in
newObject plotter ((x,y),wpr) pp & (draw_all i d pp &> send Final pp)
= done
fractal_tk =
TkCol [] [
TkLabel [TkText "Drawing a simple fractal curve:"],
TkRow []
([TkLabel [TkText "Select the order of the fractal:"]] ++
map (\o -> TkButton (drawFractal o) [TkText (show o)]) [2,3,4,5]),
TkCanvas [TkRef cref, TkBackground "white", TkHeight 600, TkWidth 600],
TkButton tkExit [TkText "Stop"]]
where cref free
drawFractal order wp = fractal order 150 150 300 (wp,(cref,color order))
color order = if order==2 then "green" else
if order==3 then "blue" else "red"
main = runWidget "Fractal Demo" fractal_tk