tools/hwmap.hs
changeset 10329 e2dba215655a
parent 10323 72e6df962cb6
child 10335 d56b4c109abb
--- a/tools/hwmap.hs	Wed Jun 18 17:23:43 2014 +0200
+++ b/tools/hwmap.hs	Wed Jun 18 23:53:11 2014 +0400
@@ -1,11 +1,16 @@
 module Main where
 
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString as BW
 import qualified Data.ByteString.Lazy as BL
+import qualified Codec.Binary.Base64 as Base64
 import Data.Word
 import Data.Int
 import Data.Binary
+import Data.Binary.Put
 import Data.Bits
 import Control.Monad
+import qualified Codec.Compression.Zlib as Z
 
 data LineType = Solid | Erasing
     deriving Eq
@@ -15,18 +20,25 @@
 instance Binary Chunk where
     put (Line lt r ((x1, y1):ps)) = do
         let flags = r .|. (if lt == Solid then 0 else (1 `shift` 6))
-        putWord8 $ flags .|. (1 `shift` 7)
         put x1
         put y1
+        putWord8 $ flags .|. (1 `shift` 7)
         forM_ ps $ \(x, y) -> do
-            putWord8 flags
             put x
             put y
+            putWord8 flags
     get = undefined
 
-mapString = BL.drop 8 . encode $
-    [
+compressWithLength :: BL.ByteString -> BL.ByteString
+compressWithLength b = BL.drop 8 . encode . runPut $ do
+    put $ ((fromIntegral $ BL.length b)::Word32)
+    mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b
+
+mapString :: B.ByteString
+mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap
+
+main = B.writeFile "out.hwmap" mapString
+
+drawnMap = [
         Line Solid 7 [(0, 0), (2048, 1024), (1024, 768)]
     ]
-
-main = BL.writeFile "out.hwmap" mapString