21 transform :: ((Int16, Int16) -> (Int16, Int16)) -> [Chunk] -> [Chunk] |
21 transform :: ((Int16, Int16) -> (Int16, Int16)) -> [Chunk] -> [Chunk] |
22 transform f = map tf |
22 transform f = map tf |
23 where |
23 where |
24 tf (SpecialPoints p) = SpecialPoints $ map f p |
24 tf (SpecialPoints p) = SpecialPoints $ map f p |
25 tf (Line t r p) = Line t r $ map f p |
25 tf (Line t r p) = Line t r $ map f p |
26 |
26 |
27 scale f = transform (\(a, b) -> (a * f, b * f)) |
27 scale f = transform (\(a, b) -> (a * f, b * f)) |
28 mirror = transform (\(a, b) -> (4095 - a, b)) |
28 mirror = transform (\(a, b) -> (4095 - a, b)) |
|
29 flip' = transform (\(a, b) -> (a, 2047 - b)) |
29 translate dx dy = transform (\(a, b) -> (a + dx, b + dy)) |
30 translate dx dy = transform (\(a, b) -> (a + dx, b + dy)) |
30 |
31 |
31 instance Binary Chunk where |
32 instance Binary Chunk where |
32 put (SpecialPoints p) = do |
33 put (SpecialPoints p) = do |
33 forM_ p $ \(x, y) -> do |
34 forM_ p $ \(x, y) -> do |
49 compressWithLength b = BL.drop 8 . encode . runPut $ do |
50 compressWithLength b = BL.drop 8 . encode . runPut $ do |
50 put $ ((fromIntegral $ BL.length b)::Word32) |
51 put $ ((fromIntegral $ BL.length b)::Word32) |
51 mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b |
52 mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b |
52 |
53 |
53 mapString :: B.ByteString |
54 mapString :: B.ByteString |
54 mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap03 |
55 mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap04 |
55 |
56 |
56 main = B.writeFile "out.hwmap" mapString |
57 main = B.writeFile "out.hwmap" mapString |
57 |
58 |
58 drawnMap01 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base |
59 drawnMap01 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base |
59 where |
60 where |
123 , l [(7, 4), (7, 6)] |
124 , l [(7, 4), (7, 6)] |
124 , l [(7, 7), (7, 8)] |
125 , l [(7, 7), (7, 8)] |
125 , l [(8, 5), (8, 8)] |
126 , l [(8, 5), (8, 8)] |
126 ] |
127 ] |
127 l = Line Solid 0 |
128 l = Line Solid 0 |
|
129 |
|
130 drawnMap04 = translate (-3) (-3) $ sp ++ fm sp ++ base ++ fm base |
|
131 where |
|
132 sp = translate 128 128 . scale 256 $ [SpecialPoints [ |
|
133 (7, 7) |
|
134 -- , (6, 6) |
|
135 , (3, 3) |
|
136 , (0, 6) |
|
137 , (3, 6) |
|
138 ]] |
|
139 base = scale 256 $ [ |
|
140 l [(1, 2), (3, 2), (3, 1), (4, 1), (4, 2), (6, 2), (6, 4), (7, 4), (7, 5), (8, 5), (8, 8)] |
|
141 , l [(0, 0), (16, 0)] |
|
142 , l [(1, 5), (3, 5), (3, 7), (1, 7), (1, 5)] |
|
143 , l [(4, 5), (6, 5), (6, 7), (4, 7), (4, 5)] |
|
144 , l [(0, 4), (2, 4), (2, 3), (5, 3), (5, 4)] |
|
145 , l [(6, 1), (6, 2), (7, 2)] |
|
146 , l [(7, 1), (8, 1)] |
|
147 , l [(7, 3), (8, 3)] |
|
148 , l [(3, 4), (4, 4)] |
|
149 , l [(7, 6), (7, 8)] |
|
150 , l [(2, 0), (2, 1)] |
|
151 , l [(5, 0), (5, 1)] |
|
152 ] |
|
153 l = Line Solid 0 |
|
154 fm = flip' . mirror |