gdritter repos hvif / 6cbff64
Added unfinished hvif2svg program Getty Ritter 8 years ago
2 changed file(s) with 49 addition(s) and 0 deletion(s). Collapse all Expand all
+8
-0
hvif.cabal less more
2121 default-language: Haskell2010
2222 default-extensions: OverloadedStrings,
2323 ScopedTypeVariables
24
25 executable hvif2svg
26 hs-source-dirs: hvif2svg
27 main-is: Main.hs
28 build-depends: base >=4.7 && <4.9
29 , hvif
30 , bytestring
31 , containers⏎
+41
-0
hvif2svg/Main.hs less more
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\" "