--------------------------------------------------- -- Tutorium 1 und 2 zu Informatik I WS 2003/2004 -- -- Alexander Butsch und Markus Westphal -- -- -- -- Lindenmayer: Implementierung von Lindenmayer- -- -- Systemen in Haskell -- --------------------------------------------------- import GraphicsUtils ------------------------------------------------ Datentyp Stack ---------------------------------------------------- type Stack a = [a] createStack :: Stack a createStack = [] push :: Stack a -> a -> Stack a push k a = (a:k) pop :: Stack a -> Stack a pop (x:xs) = xs top :: Stack a -> a top (x:xs) = x isEmpty :: Stack a -> Bool isEmpty [] = True isEmpty _ = False ------------------------------------------ Einfaches Textersetzungs-System ----------------------------------------- type Rule = (Char, [Char]) doSubstitutions :: [Rule] -> [Char] -> Int -> [Char] doSubstitutions rules str 0 = str doSubstitutions rules str n = doSubstitutions rules (doSubstitution rules str) (n-1) doSubstitution :: [Rule] -> [Char] -> [Char] doSubstitution rules [] = [] doSubstitution rules (c:cs) = (applyRules rules c) ++ (doSubstitution rules cs) applyRules :: [Rule] -> Char -> [Char] applyRules [] c = [c] applyRules ((l, r) : xs) c | c == l = r | otherwise = applyRules xs c ------------------------------------------------- Turtle-Grafik Engine --------------------------------------------- type MyAngle = Float type Location = (Float, Float) type State = (MyAngle, Location, Color) evaluate :: Float -> Float -> [Char] -> State -> Stack State -> [Graphic] -> [Graphic] evaluate rotOffset lineLength [] state stack graphic = graphic evaluate rotOffset lineLength (c:cs) state stack graphic | c == 'F' = evaluate rotOffset lineLength cs (forward lineLength state) stack ((drawLine lineLength state) : graphic) | c == 'f' = evaluate rotOffset lineLength cs (forward lineLength state) stack graphic | c == '+' = evaluate rotOffset lineLength cs (rotate rotOffset state) stack graphic | c == '-' = evaluate rotOffset lineLength cs (rotate (-rotOffset) state) stack graphic | c == '|' = evaluate rotOffset lineLength cs (turn state) stack graphic | c == '[' = evaluate rotOffset lineLength cs state (push stack state) graphic | c == ']' = evaluate rotOffset lineLength cs (top stack) (pop stack) graphic | isColor(c) = evaluate rotOffset lineLength cs (changeColor c state) stack graphic | c == '{' = evaluate rotOffset lineLength newCs state stack (poly : graphic) | otherwise = evaluate rotOffset lineLength cs state stack graphic where (newCs, poly) = drawPolygon rotOffset lineLength cs state [] rotate :: Float -> State -> State rotate offset (angle, location, color) = (angle + offset, location, color) turn :: State -> State turn (angle, location, color) = (angle + 180, location, color) forward :: Float -> State -> State forward lineLength (angle, (x, y), color) = (angle, (x+dx, y+dy), color) where dx = lineLength * (cos (2*pi*angle/360)) dy = lineLength * (sin (2*pi*angle/360)) changeColor :: Char -> State -> State changeColor colorChar (angle, location, color) = (angle, location, colormap colorChar) isColor :: Char -> Bool isColor a = elem a ['w', 'r', 'y', 'g', 'b'] colormap :: Char -> Color colormap 'w' = White colormap 'r' = Red colormap 'y' = Yellow colormap 'g' = Green colormap 'b' = Blue drawLine :: Float -> State -> Graphic drawLine lineLength (angle, (x, y), color) = line p1 p2 --withColor color (line p1 p2) where p1 = (truncate x, truncate y) p2 = (truncate (x+dx), truncate (y+dy)) dx = lineLength * (cos (2*pi*angle/360)) dy = lineLength * (sin (2*pi*angle/360)) drawPolygon :: Float -> Float -> [Char] -> State -> [Point] -> ([Char], Graphic) drawPolygon rotOffset lineLength (c:cs) (angle, (x, y), color) points | c == '}' = (cs, polygon points) | c == 'f' = drawPolygon rotOffset lineLength cs (forward lineLength state) (p : points) | c == '+' = drawPolygon rotOffset lineLength cs (rotate rotOffset state) points | c == '-' = drawPolygon rotOffset lineLength cs (rotate (-rotOffset) state) points | c == '|' = drawPolygon rotOffset lineLength cs (turn state) points where p = (truncate (x+dx), truncate (y+dy)) dx = lineLength * (cos (2*pi*angle/360)) dy = lineLength * (sin (2*pi*angle/360)) state = (angle, (x, y), color) -------------------------------- Hauptprogramm mit Beispielen ----------------------------------------------------- type Config = ([Rule], String, Int, Float, Float, State) sample1, sample2, sample3, sample4, sample5, sample6, sample7, sample8, sample9 :: Config sample1 = ([('F', "FF-[-F+F+F]+[+F-F-F]")], "F", 4, 22.0, 10.0, (-90, (550,700), White)) sample2 = ([('F', "bFF+[g+F-F-gF-F]-[g-F+F+F]")], "gF", 4, 22.0, 10.0, (-90, (450,700), White)) sample3 = ([('F', "F+F-")], "F+F", 12, 90.0, 4.0, (0, (750,450), White)) sample4 = ([('F', "FF+F+F+F+FF")], "F+F+F+F", 4, 90.0, 5.0, (0, (300,150), White)) sample5 = ([('X', "X+YF+"),('Y', "-FX-Y")], "X", 12, 90.0, 6.0, (-90, (400,200), White)) sample6 = ([('X', "XF-F+F-XF+F+XF-F+F-X")], "F+XF+F+XF", 5, 90.0, 4.0, (-90, (250,400), White)) sample7 = ([('A', "----[FBA]+++++[FBA]++[FBA]"), ('F', "S+F"), ('S', "FB"), ('B', "[{-f+f+f-|-f+f+f}]")], "A", 4, 12.0, 10.0, (-90, (350,350), White)) sample8 = ([('F', "F+f-FF+F+FF+Ff+FF-f+FF-F-FF-Ff-FFF"),('f', "fffff")], "F+F+F+F", 2, 90.0, 5.0, (-90, (350,450), White)) sample9 = ([('X', "+YrF-XgFX-rFY+"),('Y', "-XrF+YgFY+rFX-")], "X", 6, 90.0, 6.0, (-90, (350,550), White)) -- sample7 muss noch überarbeitet werden - eigentlich sollte ein Busch mit Blättern dabei rauskommen... main :: Config -> IO () main (rules, start, numSteps, rotOffset, lineLength, initState) = runGraphics (do w <- openWindow "Lindenmayer" (1024, 768) let str = doSubstitutions rules start numSteps graphics = evaluate rotOffset lineLength str initState createStack [] setGraphic w (overGraphics graphics) k <- getKey w closeWindow w ) -- main sample1 -- main sample2 -- main sample3 -- main sample4 -- main sample5 -- main sample6 -- main sample7 -- main sample8 -- main sample9