tools/hwmap.hs
 changeset 10369 5adc765da26b parent 10366 b451b8f69f44 child 10885 3ea36d8d4636
equal inserted replaced
`    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`