tools/hwmap.hs
author unc0rr
Wed, 18 Jun 2014 23:53:11 +0400
changeset 10329 e2dba215655a
parent 10323 72e6df962cb6
child 10335 d56b4c109abb
permissions -rw-r--r--
Compressing and encoding
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10323
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
     1
module Main where
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
     2
10329
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
     3
import qualified Data.ByteString.Char8 as B
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
     4
import qualified Data.ByteString as BW
10323
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
     5
import qualified Data.ByteString.Lazy as BL
10329
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
     6
import qualified Codec.Binary.Base64 as Base64
10323
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
     7
import Data.Word
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
     8
import Data.Int
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
     9
import Data.Binary
10329
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    10
import Data.Binary.Put
10323
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    11
import Data.Bits
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    12
import Control.Monad
10329
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    13
import qualified Codec.Compression.Zlib as Z
10323
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    14
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    15
data LineType = Solid | Erasing
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    16
    deriving Eq
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    17
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    18
data Chunk = Line LineType Word8 [(Int16, Int16)]
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    19
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    20
instance Binary Chunk where
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    21
    put (Line lt r ((x1, y1):ps)) = do
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    22
        let flags = r .|. (if lt == Solid then 0 else (1 `shift` 6))
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    23
        put x1
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    24
        put y1
10329
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    25
        putWord8 $ flags .|. (1 `shift` 7)
10323
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    26
        forM_ ps $ \(x, y) -> do
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    27
            put x
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    28
            put y
10329
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    29
            putWord8 flags
10323
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    30
    get = undefined
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    31
10329
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    32
compressWithLength :: BL.ByteString -> BL.ByteString
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    33
compressWithLength b = BL.drop 8 . encode . runPut $ do
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    34
    put $ ((fromIntegral $ BL.length b)::Word32)
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    35
    mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    36
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    37
mapString :: B.ByteString
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    38
mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    39
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    40
main = B.writeFile "out.hwmap" mapString
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    41
e2dba215655a Compressing and encoding
unc0rr
parents: 10323
diff changeset
    42
drawnMap = [
10323
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    43
        Line Solid 7 [(0, 0), (2048, 1024), (1024, 768)]
72e6df962cb6 Code drawn map in haskell \o/
unc0rr
parents:
diff changeset
    44
    ]