λ見ていて思いついたフラクタル いまいちな見た目 L-systemのを書いた時のコードを使った 今見ると挙動がバグっぽい

a.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

lambda = ("A", [('A',"A++B+++A+A"),('B',"BB")], moveTurtle 60)

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

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

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 lambda 4 8