L-system 手抜きなので気が向けば直したい

Lsystem.hs

import Data.Maybe (fromMaybe)

data Turtle = Turtle { turtleX :: Double
                     , turtleY :: Double
                     , turtleD :: Double
                     , turtleLine :: [(Double,Double,Double,Double)]
                     } deriving Show

moveTurtle a c t
    | c == '+' = turn a t
    | c == '-' = turn (-a) t
    | c == 'F' || c == 'A' || c == 'B' = plus t
    | otherwise = t
turn a t = t { turtleD = a + turtleD t }
plus t@(Turtle x y _ _) = t' { turtleLine = (x,y,x',y'):l' }
    where t'@(Turtle x' y' _ l') = plus' t
plus' t@(Turtle x y d l) = Turtle (cos a + x) (sin a + y) d l
    where a = d * pi / 180

-- http://ja.wikipedia.org/wiki/L-system
koch0 = ("F", [('F',"F+F-F-F+F")], moveTurtle 90)
koch1 = ("F", [('F',"F+F--F+F")], moveTurtle 60)
sierpinski = ("A", [('A',"B-A-B"),('B',"A+B+A")], moveTurtle 60)
-- http://www.ipsj.or.jp/07editj/promenade/4610.pdf
hilbert = ("X", [('X',"+YF-XFX-FY+"),('Y',"-XF+YFY+FX-")], moveTurtle 90)
-- http://hlab.ta.chiba-u.jp/article.php?story=20090206101809509
dragon = ("A", [('A',"A-A+A+AA-A-A+A")], moveTurtle 90)

p t x = fromMaybe [x] $ lookup x t
result' a@(o,t) = o : map (>>=p t) (result' a)

runString f = turtleLine . foldr f (Turtle 1 1 0 [])
foo (o,t,f) = map (runString f) $ result' (o,t)
bar a x = draw x . (foo a!!)
baz = bar koch0

draw x l = "<svg xmlns=\"http://www.w3.org/2000/svg\">\n" 
           ++ foldr f "</svg>" l
    where f (x1,y1,x2,y2) acc = "<line "
              ++ g "x1" x1 ++ g "y1" y1 ++ g "x2" x2 ++ g "y2" y2
              ++ "stroke=\"#000\" />\n" ++ acc
          g s a = s ++ "=\"" ++ show (a*x) ++ "\" "

main = writeFile "a.svg" $ bar sierpinski 4 8