diff -r cf410db21c80 -r 7a905f0070ce tools/hwmap.hs --- a/tools/hwmap.hs Wed Jul 15 00:27:12 2015 +0200 +++ b/tools/hwmap.hs Thu Jul 16 08:39:35 2015 -0400 @@ -1,164 +1,164 @@ -module Main where - -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString as BW -import qualified Data.ByteString.Lazy as BL -import qualified Codec.Binary.Base64 as Base64 -import Data.Word -import Data.Int -import Data.Binary -import Data.Binary.Put -import Data.Bits -import Control.Monad -import qualified Codec.Compression.Zlib as Z - -data LineType = Solid | Erasing - deriving Eq - -data Chunk = SpecialPoints [(Int16, Int16)] - | Line LineType Word8 [(Int16, Int16)] - -transform :: ((Int16, Int16) -> (Int16, Int16)) -> [Chunk] -> [Chunk] -transform f = map tf - where - tf (SpecialPoints p) = SpecialPoints $ map f p - tf (Line t r p) = Line t r $ map f p - -scale f = transform (\(a, b) -> (a * f, b * f)) -mirror = transform (\(a, b) -> (4095 - a, b)) -flip' = transform (\(a, b) -> (a, 2047 - b)) -translate dx dy = transform (\(a, b) -> (a + dx, b + dy)) - -instance Binary Chunk where - put (SpecialPoints p) = do - forM_ p $ \(x, y) -> do - put x - put y - putWord8 0 - put (Line lt r ((x1, y1):ps)) = do - let flags = r .|. (if lt == Solid then 0 else (1 `shift` 6)) - put x1 - put y1 - putWord8 $ flags .|. (1 `shift` 7) - forM_ ps $ \(x, y) -> do - put x - put y - putWord8 flags - get = undefined - -compressWithLength :: BL.ByteString -> BL.ByteString -compressWithLength b = BL.drop 8 . encode . runPut $ do - put $ ((fromIntegral $ BL.length b)::Word32) - mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b - -mapString :: B.ByteString -mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap05 - -main = B.writeFile "out.hwmap" mapString - -drawnMap01 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base - where - sp = translate 128 128 . scale 256 $ [SpecialPoints [ - (6, 0) - , (1, 4) - , (4, 7) - , (7, 5) - ]] - base = scale 256 $ [ - l [(5, 0), (5, 1)] - , l [(7, 0), (7, 1)] - , l [(8, 1), (6, 1), (6, 4)] - , l [(8, 1), (8, 6), (6, 6), (6, 7), (8, 7)] - , l [(7, 2), (7, 5), (5, 5)] - , l [(5, 3), (5, 8)] - , l [(6, 2), (4, 2)] - , l [(1, 1), (4, 1), (4, 7)] - , l [(3, 5), (3, 7), (2, 7), (2, 8)] - , l [(2, 1), (2, 2)] - , l [(0, 2), (1, 2), (1, 3), (3, 3), (3, 2)] - , l [(0, 5), (1, 5)] - , l [(1, 4), (4, 4)] - , l [(2, 4), (2, 6), (1, 6), (1, 7)] - , l [(0, 8), (8, 8)] - ] - l = Line Solid 0 - -drawnMap02 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base - where - sp = translate 128 128 . scale 256 $ [SpecialPoints [ - (7, 0) - , (7, 7) - ]] - base = scale 256 $ [ - l [(8, 0), (8, 1), (1, 1)] - , l [(2, 1), (2, 2), (3, 2), (3, 3), (4, 3), (4, 4), (5, 4), (5, 5), (6, 5), (6, 6), (7, 6), (7, 7), (7, 1)] - , l [(0, 2), (1, 2), (1, 3), (2, 3), (2, 4), (3, 4), (3, 5), (4, 5), (4, 6), (5, 6), (5, 7), (6, 7), (6, 8), (8, 8), (8, 2)] - ] - l = Line Solid 0 - - -drawnMap03 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base - where - sp = translate 128 128 . scale 256 $ [SpecialPoints [ - (3, 1) - , (2, 4) - ]] - base = scale 256 $ [ - l [(6, 0), (6, 1)] - , l [(1, 1), (5, 1)] - , l [(4, 1), (4, 2), (3, 2)] - , l [(0, 2), (1, 2), (1, 4)] - , l [(0, 4), (3, 4), (3, 3), (5, 3), (5, 2), (7, 2)] - , l [(7, 1), (7, 3)] - , l [(8, 0), (8, 4), (4, 4), (4, 5), (1, 5), (1, 6)] - , l [(6, 3), (6, 4)] - , l [(0, 8), (8, 8)] - , l [(1, 7), (1, 8)] - , l [(2, 7), (2, 5)] - , l [(3, 6), (3, 5)] - , l [(3, 7), (3, 8)] - , l [(4, 6), (4, 8)] - , l [(5, 4), (5, 6)] - , l [(5, 7), (5, 8)] - , l [(6, 5), (6, 8)] - , l [(7, 4), (7, 6)] - , l [(7, 7), (7, 8)] - , l [(8, 5), (8, 8)] - ] - l = Line Solid 0 - -drawnMap04 = translate (-3) (-3) $ sp ++ fm sp ++ base ++ fm base - where - sp = translate 128 128 . scale 256 $ [SpecialPoints [ - (7, 7) --- , (6, 6) - , (3, 3) - , (0, 6) - , (3, 6) - ]] - base = scale 256 $ [ - l [(1, 2), (3, 2), (3, 1), (4, 1), (4, 2), (6, 2), (6, 4), (7, 4), (7, 5), (8, 5), (8, 8)] - , l [(0, 0), (16, 0)] - , l [(1, 5), (3, 5), (3, 7), (1, 7), (1, 5)] - , l [(4, 5), (6, 5), (6, 7), (4, 7), (4, 5)] - , l [(0, 4), (2, 4), (2, 3), (5, 3), (5, 4)] - , l [(6, 1), (6, 2), (7, 2)] - , l [(7, 1), (8, 1)] - , l [(7, 3), (8, 3)] - , l [(3, 4), (4, 4)] - , l [(7, 6), (7, 8)] - , l [(2, 0), (2, 1)] - , l [(5, 0), (5, 1)] - ] - l = Line Solid 0 - fm = flip' . mirror - -drawnMap05 = sp ++ fullFill ++ lW - where - w = 320 - sh = 420 - basePoints = [(w, w), (1024 + w `div` 2, 2048 - w), (2048, w), (3072 - w `div` 2, 2048 - w), (4096 - w, w)] - lW = [Line Erasing 60 basePoints] - sp = [SpecialPoints $ basePoints ++ [(1024 + w `div` 2, 2048 - w - sh), (3072 - w `div` 2, 2048 - w - sh), (2048, w + sh)]] - -fullFill = scale 256 $ [Line Solid 63 [(0, 1), (16, 1), (16, 3), (0, 3), (0, 5), (16, 5), (16, 7), (0, 7)]] +module Main where + +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString as BW +import qualified Data.ByteString.Lazy as BL +import qualified Codec.Binary.Base64 as Base64 +import Data.Word +import Data.Int +import Data.Binary +import Data.Binary.Put +import Data.Bits +import Control.Monad +import qualified Codec.Compression.Zlib as Z + +data LineType = Solid | Erasing + deriving Eq + +data Chunk = SpecialPoints [(Int16, Int16)] + | Line LineType Word8 [(Int16, Int16)] + +transform :: ((Int16, Int16) -> (Int16, Int16)) -> [Chunk] -> [Chunk] +transform f = map tf + where + tf (SpecialPoints p) = SpecialPoints $ map f p + tf (Line t r p) = Line t r $ map f p + +scale f = transform (\(a, b) -> (a * f, b * f)) +mirror = transform (\(a, b) -> (4095 - a, b)) +flip' = transform (\(a, b) -> (a, 2047 - b)) +translate dx dy = transform (\(a, b) -> (a + dx, b + dy)) + +instance Binary Chunk where + put (SpecialPoints p) = do + forM_ p $ \(x, y) -> do + put x + put y + putWord8 0 + put (Line lt r ((x1, y1):ps)) = do + let flags = r .|. (if lt == Solid then 0 else (1 `shift` 6)) + put x1 + put y1 + putWord8 $ flags .|. (1 `shift` 7) + forM_ ps $ \(x, y) -> do + put x + put y + putWord8 flags + get = undefined + +compressWithLength :: BL.ByteString -> BL.ByteString +compressWithLength b = BL.drop 8 . encode . runPut $ do + put $ ((fromIntegral $ BL.length b)::Word32) + mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b + +mapString :: B.ByteString +mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap05 + +main = B.writeFile "out.hwmap" mapString + +drawnMap01 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base + where + sp = translate 128 128 . scale 256 $ [SpecialPoints [ + (6, 0) + , (1, 4) + , (4, 7) + , (7, 5) + ]] + base = scale 256 $ [ + l [(5, 0), (5, 1)] + , l [(7, 0), (7, 1)] + , l [(8, 1), (6, 1), (6, 4)] + , l [(8, 1), (8, 6), (6, 6), (6, 7), (8, 7)] + , l [(7, 2), (7, 5), (5, 5)] + , l [(5, 3), (5, 8)] + , l [(6, 2), (4, 2)] + , l [(1, 1), (4, 1), (4, 7)] + , l [(3, 5), (3, 7), (2, 7), (2, 8)] + , l [(2, 1), (2, 2)] + , l [(0, 2), (1, 2), (1, 3), (3, 3), (3, 2)] + , l [(0, 5), (1, 5)] + , l [(1, 4), (4, 4)] + , l [(2, 4), (2, 6), (1, 6), (1, 7)] + , l [(0, 8), (8, 8)] + ] + l = Line Solid 0 + +drawnMap02 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base + where + sp = translate 128 128 . scale 256 $ [SpecialPoints [ + (7, 0) + , (7, 7) + ]] + base = scale 256 $ [ + l [(8, 0), (8, 1), (1, 1)] + , l [(2, 1), (2, 2), (3, 2), (3, 3), (4, 3), (4, 4), (5, 4), (5, 5), (6, 5), (6, 6), (7, 6), (7, 7), (7, 1)] + , l [(0, 2), (1, 2), (1, 3), (2, 3), (2, 4), (3, 4), (3, 5), (4, 5), (4, 6), (5, 6), (5, 7), (6, 7), (6, 8), (8, 8), (8, 2)] + ] + l = Line Solid 0 + + +drawnMap03 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base + where + sp = translate 128 128 . scale 256 $ [SpecialPoints [ + (3, 1) + , (2, 4) + ]] + base = scale 256 $ [ + l [(6, 0), (6, 1)] + , l [(1, 1), (5, 1)] + , l [(4, 1), (4, 2), (3, 2)] + , l [(0, 2), (1, 2), (1, 4)] + , l [(0, 4), (3, 4), (3, 3), (5, 3), (5, 2), (7, 2)] + , l [(7, 1), (7, 3)] + , l [(8, 0), (8, 4), (4, 4), (4, 5), (1, 5), (1, 6)] + , l [(6, 3), (6, 4)] + , l [(0, 8), (8, 8)] + , l [(1, 7), (1, 8)] + , l [(2, 7), (2, 5)] + , l [(3, 6), (3, 5)] + , l [(3, 7), (3, 8)] + , l [(4, 6), (4, 8)] + , l [(5, 4), (5, 6)] + , l [(5, 7), (5, 8)] + , l [(6, 5), (6, 8)] + , l [(7, 4), (7, 6)] + , l [(7, 7), (7, 8)] + , l [(8, 5), (8, 8)] + ] + l = Line Solid 0 + +drawnMap04 = translate (-3) (-3) $ sp ++ fm sp ++ base ++ fm base + where + sp = translate 128 128 . scale 256 $ [SpecialPoints [ + (7, 7) +-- , (6, 6) + , (3, 3) + , (0, 6) + , (3, 6) + ]] + base = scale 256 $ [ + l [(1, 2), (3, 2), (3, 1), (4, 1), (4, 2), (6, 2), (6, 4), (7, 4), (7, 5), (8, 5), (8, 8)] + , l [(0, 0), (16, 0)] + , l [(1, 5), (3, 5), (3, 7), (1, 7), (1, 5)] + , l [(4, 5), (6, 5), (6, 7), (4, 7), (4, 5)] + , l [(0, 4), (2, 4), (2, 3), (5, 3), (5, 4)] + , l [(6, 1), (6, 2), (7, 2)] + , l [(7, 1), (8, 1)] + , l [(7, 3), (8, 3)] + , l [(3, 4), (4, 4)] + , l [(7, 6), (7, 8)] + , l [(2, 0), (2, 1)] + , l [(5, 0), (5, 1)] + ] + l = Line Solid 0 + fm = flip' . mirror + +drawnMap05 = sp ++ fullFill ++ lW + where + w = 320 + sh = 420 + basePoints = [(w, w), (1024 + w `div` 2, 2048 - w), (2048, w), (3072 - w `div` 2, 2048 - w), (4096 - w, w)] + lW = [Line Erasing 60 basePoints] + sp = [SpecialPoints $ basePoints ++ [(1024 + w `div` 2, 2048 - w - sh), (3072 - w `div` 2, 2048 - w - sh), (2048, w + sh)]] + +fullFill = scale 256 $ [Line Solid 63 [(0, 1), (16, 1), (16, 3), (0, 3), (0, 5), (16, 5), (16, 7), (0, 7)]]