Browse Source

Added unfinished hvif2svg program

Getty Ritter 7 years ago
parent
commit
6cbff64581
2 changed files with 49 additions and 0 deletions
  1. 8 0
      hvif.cabal
  2. 41 0
      hvif2svg/Main.hs

+ 8 - 0
hvif.cabal

@@ -21,3 +21,11 @@ library
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings,
                        ScopedTypeVariables
+
+executable hvif2svg
+  hs-source-dirs: hvif2svg
+  main-is: Main.hs
+  build-depends: base >=4.7 && <4.9
+               , hvif
+               , bytestring
+               , containers

+ 41 - 0
hvif2svg/Main.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE PatternGuards #-}
+
+module Main where
+
+import           Control.Monad (forM_)
+import qualified Data.ByteString as BS
+import           Data.Sequence (Seq, ViewL(..))
+import qualified Data.Sequence as S
+import           Graphics.HVIF
+
+main :: IO ()
+main = do
+  contents <- BS.getContents
+  case decodeFile contents of
+    Left err -> putStrLn err
+    Right hvif -> do
+      putStrLn "<svg width=\"200\" height=\"200\" xmlns=\"http://www.w3.org/2000/svg\">"
+      forM_ (hvifPaths hvif) $ \path -> do
+        putStr "<path d=\""
+        drawPoints True 0.0 0.0 (pathPoints path)
+        putStrLn "stroke=\"black\"/>"
+      putStrLn "</svg>"
+
+drawPoints :: Bool -> Float -> Float -> Seq Command -> IO ()
+drawPoints first lx ly seq
+  | cmd :< xs <- S.viewl seq = do
+      let dir = if first then "M" else "L"
+      case cmd of
+        CmdLine (Point x y) -> do
+          putStr $ unwords [dir, show (floor x), show (floor y)]
+          drawPoints False x y xs
+        CmdHLine x -> do
+          putStr $ unwords [dir, show (floor x), show (floor ly)]
+          drawPoints False x ly xs
+        CmdVLine y -> do
+          putStr $ unwords [dir, show (floor lx), show (floor y)]
+          drawPoints False lx y xs
+        CmdCurve (Point x y) _ _ -> do
+          putStr $ unwords [dir, show (floor x), show (floor y)]
+          drawPoints False x y xs
+  | otherwise = putStr "Z\" "