merge time. it's been a while
authorsheepluva
Thu, 19 Jun 2014 00:36:11 +0200
changeset 10334 872da9a6a2b0
parent 10333 e1253205eb7e (current diff)
parent 10329 e2dba215655a (diff)
child 10335 d56b4c109abb
merge time. it's been a while
--- a/tools/hwmap.hs	Thu Jun 19 00:23:03 2014 +0200
+++ b/tools/hwmap.hs	Thu Jun 19 00:36:11 2014 +0200
@@ -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