Projet d'étude. Programme en Haskell affichant une image SVG depuis un "programme" logoskell

logoskell.hs

import Prelude hiding (Left, Right)

data Instruction = Forward Int | Right Int | Left Int | Repeat Int [Instruction] deriving (Show, Read)

{- 
Dépile le programme pour supprimer les instructions Repeat
/!\ Renvoie les instructions dans l'ordre inverse
-}
depiler :: [Instruction] -> [Instruction] -> [Instruction]
depiler [] a = a
depiler (i:reste) a = case i of
    (Repeat x ins)->depiler reste ((concat (replicate x (depiler ins [])) ) ++ a)
    _ ->depiler reste (i:a)

{- Conversion degré -> radian -}
toRadian :: Int -> Float
toRadian ang = (realToFrac ang) * (pi / 180)

{-
Transforme une liste d'instructions (sans Repeat) en une liste de points (x, y)
/!\ Construit la liste de points dans l'ordre inverse
-}
{- executer :: [instructions] -> xinitial -> yinitial -> angleinitial -> [xinitial, yinitial] -> [points] -}
executer :: [Instruction] -> Int -> Int -> Float -> [(Int, Int)] -> [(Int, Int)]
executer   []      x y angle pts = pts
executer (i:is) x y angle pts = case i of
    Forward av   -> (executer is newx newy angle ((newx,newy):pts))
        where   newx = x + round ((realToFrac av) * (cos angle))
                newy = y + round ((realToFrac av) * (sin angle))
    Right tr     -> executer is x y (angle - (toRadian tr)) pts
    Left tg      -> executer is x y (angle + (toRadian tg)) pts

{- 
Prend en paramètres 2 points et renvoie la chaîne de caractères qui correspond
à une ligne rouge tracée entre les 2 points en SVG 
-}
ligneSvg :: (Int, Int) -> (Int, Int) -> String
ligneSvg pta ptb = ("<line x1=\""  ++ (show $ fst pta) ++ "\" y1=\"" ++ (show $ snd pta) 
                    ++ "\" x2=\"" ++ (show $ fst ptb) ++ "\" y2=\"" ++ (show $ snd ptb) 
                    ++ "\" stroke=\"red\" stroke-width=\"1\" />\n")
{-
Prend en paramètres la liste de points et renvoie la chaine de caractères qui correspond
à la figure complète
/!\ Trace les traits dans l'ordre inverse
-}
tracerSvg :: [(Int, Int)] -> String -> String
tracerSvg [] svg = svg
tracerSvg pts svg = if (length pts) > 1
                    then tracerSvg (drop 1 pts) ((ligneSvg (pts!!1) (pts!!0)) ++ svg)
                    else svg

{-
Transforme une suite d'instructions logoskell en figure SVG
-}
logoToXml :: [Instruction] -> String
logoToXml ins = "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
                    ++ "<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\" width=\"200\" height=\"200\">"
                    {- 100 100 et (100, 100) car on commence au milieu du canvas -}
                    ++ (tracerSvg (executer (reverse $ depiler ins [])  100 100 0.0 [(100, 100)]) "")
                    ++ "</svg>"
{-
Programme principal
-}
main = do
    logoString <- getLine
    putStrLn (logoToXml (read logoString :: [Instruction]))