| 1 |
{-# LANGUAGE PatternGuards #-}
|
| 2 |
|
| 3 |
module Main where
|
| 4 |
|
| 5 |
import Control.Monad (forM_)
|
| 6 |
import qualified Data.ByteString as BS
|
| 7 |
import Data.Sequence (Seq, ViewL(..))
|
| 8 |
import qualified Data.Sequence as S
|
| 9 |
import Graphics.HVIF
|
| 10 |
|
| 11 |
main :: IO ()
|
| 12 |
main = do
|
| 13 |
contents <- BS.getContents
|
| 14 |
case decodeFile contents of
|
| 15 |
Left err -> putStrLn err
|
| 16 |
Right hvif -> do
|
| 17 |
putStrLn "<svg width=\"200\" height=\"200\" xmlns=\"http://www.w3.org/2000/svg\">"
|
| 18 |
forM_ (hvifPaths hvif) $ \path -> do
|
| 19 |
putStr "<path d=\""
|
| 20 |
drawPoints True 0.0 0.0 (pathPoints path)
|
| 21 |
putStrLn "stroke=\"black\"/>"
|
| 22 |
putStrLn "</svg>"
|
| 23 |
|
| 24 |
drawPoints :: Bool -> Float -> Float -> Seq Command -> IO ()
|
| 25 |
drawPoints first lx ly seq
|
| 26 |
| cmd :< xs <- S.viewl seq = do
|
| 27 |
let dir = if first then "M" else "L"
|
| 28 |
case cmd of
|
| 29 |
CmdLine (Point x y) -> do
|
| 30 |
putStr $ unwords [dir, show (floor x), show (floor y)]
|
| 31 |
drawPoints False x y xs
|
| 32 |
CmdHLine x -> do
|
| 33 |
putStr $ unwords [dir, show (floor x), show (floor ly)]
|
| 34 |
drawPoints False x ly xs
|
| 35 |
CmdVLine y -> do
|
| 36 |
putStr $ unwords [dir, show (floor lx), show (floor y)]
|
| 37 |
drawPoints False lx y xs
|
| 38 |
CmdCurve (Point x y) _ _ -> do
|
| 39 |
putStr $ unwords [dir, show (floor x), show (floor y)]
|
| 40 |
drawPoints False x y xs
|
| 41 |
| otherwise = putStr "Z\" "
|