13 import qualified Codec.Compression.Zlib as Z |
13 import qualified Codec.Compression.Zlib as Z |
14 |
14 |
15 data LineType = Solid | Erasing |
15 data LineType = Solid | Erasing |
16 deriving Eq |
16 deriving Eq |
17 |
17 |
18 data Chunk = Line LineType Word8 [(Int16, Int16)] |
18 data Chunk = SpecialPoints [(Int16, Int16)] |
|
19 | Line LineType Word8 [(Int16, Int16)] |
|
20 |
|
21 transform :: ((Int16, Int16) -> (Int16, Int16)) -> [Chunk] -> [Chunk] |
|
22 transform f = map tf |
|
23 where |
|
24 tf (SpecialPoints p) = SpecialPoints $ map f p |
|
25 tf (Line t r p) = Line t r $ map f p |
|
26 |
|
27 scale f = transform (\(a, b) -> (a * f, b * f)) |
|
28 mirror = transform (\(a, b) -> (4095 - a, b)) |
|
29 translate dx dy = transform (\(a, b) -> (a + dx, b + dy)) |
19 |
30 |
20 instance Binary Chunk where |
31 instance Binary Chunk where |
|
32 put (SpecialPoints p) = do |
|
33 forM_ p $ \(x, y) -> do |
|
34 put x |
|
35 put y |
|
36 putWord8 0 |
21 put (Line lt r ((x1, y1):ps)) = do |
37 put (Line lt r ((x1, y1):ps)) = do |
22 let flags = r .|. (if lt == Solid then 0 else (1 `shift` 6)) |
38 let flags = r .|. (if lt == Solid then 0 else (1 `shift` 6)) |
23 put x1 |
39 put x1 |
24 put y1 |
40 put y1 |
25 putWord8 $ flags .|. (1 `shift` 7) |
41 putWord8 $ flags .|. (1 `shift` 7) |
33 compressWithLength b = BL.drop 8 . encode . runPut $ do |
49 compressWithLength b = BL.drop 8 . encode . runPut $ do |
34 put $ ((fromIntegral $ BL.length b)::Word32) |
50 put $ ((fromIntegral $ BL.length b)::Word32) |
35 mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b |
51 mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b |
36 |
52 |
37 mapString :: B.ByteString |
53 mapString :: B.ByteString |
38 mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap |
54 mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap01 |
39 |
55 |
40 main = B.writeFile "out.hwmap" mapString |
56 main = B.writeFile "out.hwmap" mapString |
41 |
57 |
42 drawnMap = [ |
58 drawnMap01 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base |
43 Line Solid 7 [(0, 0), (2048, 1024), (1024, 768)] |
59 where |
44 ] |
60 sp = translate 128 128 . scale 256 $ [SpecialPoints [ |
|
61 (6, 0) |
|
62 , (1, 4) |
|
63 , (4, 7) |
|
64 , (7, 5) |
|
65 ]] |
|
66 base = scale 256 $ [ |
|
67 l [(5, 0), (5, 1)] |
|
68 , l [(7, 0), (7, 1)] |
|
69 , l [(8, 1), (6, 1), (6, 4)] |
|
70 , l [(8, 1), (8, 6), (6, 6), (6, 7), (8, 7)] |
|
71 , l [(7, 2), (7, 5), (5, 5)] |
|
72 , l [(5, 3), (5, 8)] |
|
73 , l [(6, 2), (4, 2)] |
|
74 , l [(1, 1), (4, 1), (4, 7)] |
|
75 , l [(3, 5), (3, 7), (2, 7), (2, 8)] |
|
76 , l [(2, 1), (2, 2)] |
|
77 , l [(0, 2), (1, 2), (1, 3), (3, 3), (3, 2)] |
|
78 , l [(0, 5), (1, 5)] |
|
79 , l [(1, 4), (4, 4)] |
|
80 , l [(2, 4), (2, 6), (1, 6), (1, 7)] |
|
81 , l [(0, 8), (8, 8)] |
|
82 ] |
|
83 l = Line Solid 0 |
|
84 |