gdritter repos image-vk / master vk2svg / Main.hs
master

Tree @master (Download .tar.gz)

Main.hs @master — raw · history · blame 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
module Main where

import qualified Data.ByteString.Lazy as BS
import Image.VK

mkImage :: VKImage -> IO ()
mkImage img = do
  let VKMeta (w, h) = vkMeta img
  putStr "<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\""
  putStrLn $ concat [" width=\"", show w, "\" height=\"", show h, "\">" ]
  mapM_ pLine (vkLines img)
  putStrLn "</svg>"
  where pLine [] = return ()
        pLine [x] = return ()
        pLine ((x,y):a@(x',y'):as) = do
          putStrLn $ concat [ "<line x1=\""
                            , show x
                            , "\" y1=\""
                            , show y
                            , "\" x2=\""
                            , show x'
                            , "\" y2=\""
                            , show y'
                            , "\" stroke=\"black\" stroke-width=\"2\" />"
                            ]
          pLine (a:as)

main :: IO ()
main = do
  cs <- BS.getContents
  case decode cs of
    Left err -> putStrLn err
    Right vk -> mkImage vk