1 module Main where |
1 module Main where |
2 |
2 |
|
3 import qualified Data.ByteString.Char8 as B |
|
4 import qualified Data.ByteString as BW |
3 import qualified Data.ByteString.Lazy as BL |
5 import qualified Data.ByteString.Lazy as BL |
|
6 import qualified Codec.Binary.Base64 as Base64 |
4 import Data.Word |
7 import Data.Word |
5 import Data.Int |
8 import Data.Int |
6 import Data.Binary |
9 import Data.Binary |
|
10 import Data.Binary.Put |
7 import Data.Bits |
11 import Data.Bits |
8 import Control.Monad |
12 import Control.Monad |
|
13 import qualified Codec.Compression.Zlib as Z |
9 |
14 |
10 data LineType = Solid | Erasing |
15 data LineType = Solid | Erasing |
11 deriving Eq |
16 deriving Eq |
12 |
17 |
13 data Chunk = Line LineType Word8 [(Int16, Int16)] |
18 data Chunk = Line LineType Word8 [(Int16, Int16)] |
14 |
19 |
15 instance Binary Chunk where |
20 instance Binary Chunk where |
16 put (Line lt r ((x1, y1):ps)) = do |
21 put (Line lt r ((x1, y1):ps)) = do |
17 let flags = r .|. (if lt == Solid then 0 else (1 `shift` 6)) |
22 let flags = r .|. (if lt == Solid then 0 else (1 `shift` 6)) |
18 putWord8 $ flags .|. (1 `shift` 7) |
|
19 put x1 |
23 put x1 |
20 put y1 |
24 put y1 |
|
25 putWord8 $ flags .|. (1 `shift` 7) |
21 forM_ ps $ \(x, y) -> do |
26 forM_ ps $ \(x, y) -> do |
22 putWord8 flags |
|
23 put x |
27 put x |
24 put y |
28 put y |
|
29 putWord8 flags |
25 get = undefined |
30 get = undefined |
26 |
31 |
27 mapString = BL.drop 8 . encode $ |
32 compressWithLength :: BL.ByteString -> BL.ByteString |
28 [ |
33 compressWithLength b = BL.drop 8 . encode . runPut $ do |
|
34 put $ ((fromIntegral $ BL.length b)::Word32) |
|
35 mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b |
|
36 |
|
37 mapString :: B.ByteString |
|
38 mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap |
|
39 |
|
40 main = B.writeFile "out.hwmap" mapString |
|
41 |
|
42 drawnMap = [ |
29 Line Solid 7 [(0, 0), (2048, 1024), (1024, 768)] |
43 Line Solid 7 [(0, 0), (2048, 1024), (1024, 768)] |
30 ] |
44 ] |
31 |
|
32 main = BL.writeFile "out.hwmap" mapString |
|