tools/hwmap.hs
author Wuzzy <almikes@aol.com>
Sun, 08 Oct 2017 20:24:58 +0200
changeset 12676 2e6dcd97f085
parent 11015 7a905f0070ce
permissions -rw-r--r--
No longer jiggle sticky mines if using portable portal device This fixes the sticky mine sound playing when using portal gun while any sticky mine is placed on ground. We decided that placed sticky mines can't be teleported.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
11015
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
     1
module Main where
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
     2
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
     3
import qualified Data.ByteString.Char8 as B
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
     4
import qualified Data.ByteString as BW
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
     5
import qualified Data.ByteString.Lazy as BL
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
     6
import qualified Codec.Binary.Base64 as Base64
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
     7
import Data.Word
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
     8
import Data.Int
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
     9
import Data.Binary
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    10
import Data.Binary.Put
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    11
import Data.Bits
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    12
import Control.Monad
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    13
import qualified Codec.Compression.Zlib as Z
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    14
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    15
data LineType = Solid | Erasing
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    16
    deriving Eq
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    17
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    18
data Chunk = SpecialPoints [(Int16, Int16)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    19
    | Line LineType Word8 [(Int16, Int16)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    20
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    21
transform :: ((Int16, Int16) -> (Int16, Int16)) -> [Chunk] -> [Chunk]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    22
transform f = map tf
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    23
    where
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    24
    tf (SpecialPoints p) = SpecialPoints $ map f p
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    25
    tf (Line t r p) = Line t r $ map f p
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    26
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    27
scale f = transform (\(a, b) -> (a * f, b * f))
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    28
mirror = transform (\(a, b) -> (4095 - a, b))
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    29
flip' = transform (\(a, b) -> (a, 2047 - b))
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    30
translate dx dy = transform (\(a, b) -> (a + dx, b + dy))
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    31
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    32
instance Binary Chunk where
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    33
    put (SpecialPoints p) = do
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    34
        forM_ p $ \(x, y) -> do
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    35
            put x
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    36
            put y
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    37
            putWord8 0
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    38
    put (Line lt r ((x1, y1):ps)) = do
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    39
        let flags = r .|. (if lt == Solid then 0 else (1 `shift` 6))
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    40
        put x1
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    41
        put y1
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    42
        putWord8 $ flags .|. (1 `shift` 7)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    43
        forM_ ps $ \(x, y) -> do
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    44
            put x
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    45
            put y
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    46
            putWord8 flags
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    47
    get = undefined
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    48
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    49
compressWithLength :: BL.ByteString -> BL.ByteString
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    50
compressWithLength b = BL.drop 8 . encode . runPut $ do
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    51
    put $ ((fromIntegral $ BL.length b)::Word32)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    52
    mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    53
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    54
mapString :: B.ByteString
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    55
mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap05
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    56
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    57
main = B.writeFile "out.hwmap" mapString
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    58
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    59
drawnMap01 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    60
    where
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    61
    sp = translate 128 128 . scale 256 $ [SpecialPoints [
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    62
        (6, 0)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    63
        , (1, 4)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    64
        , (4, 7)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    65
        , (7, 5)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    66
        ]]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    67
    base = scale 256 $ [
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    68
        l [(5, 0), (5, 1)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    69
        , l [(7, 0), (7, 1)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    70
        , l [(8, 1), (6, 1), (6, 4)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    71
        , l [(8, 1), (8, 6), (6, 6), (6, 7), (8, 7)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    72
        , l [(7, 2), (7, 5), (5, 5)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    73
        , l [(5, 3), (5, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    74
        , l [(6, 2), (4, 2)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    75
        , l [(1, 1), (4, 1), (4, 7)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    76
        , l [(3, 5), (3, 7), (2, 7), (2, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    77
        , l [(2, 1), (2, 2)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    78
        , l [(0, 2), (1, 2), (1, 3), (3, 3), (3, 2)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    79
        , l [(0, 5), (1, 5)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    80
        , l [(1, 4), (4, 4)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    81
        , l [(2, 4), (2, 6), (1, 6), (1, 7)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    82
        , l [(0, 8), (8, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    83
        ]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    84
    l = Line Solid 0
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    85
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    86
drawnMap02 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    87
    where
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    88
    sp = translate 128 128 . scale 256 $ [SpecialPoints [
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    89
        (7, 0)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    90
        , (7, 7)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    91
        ]]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    92
    base = scale 256 $ [
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    93
        l [(8, 0), (8, 1), (1, 1)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    94
        , 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)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    95
        , 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)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    96
        ]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    97
    l = Line Solid 0
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    98
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
    99
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   100
drawnMap03 = translate (-3) (-3) $ sp ++ mirror sp ++ base ++ mirror base
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   101
    where
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   102
    sp = translate 128 128 . scale 256 $ [SpecialPoints [
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   103
        (3, 1)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   104
        , (2, 4)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   105
        ]]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   106
    base = scale 256 $ [
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   107
        l [(6, 0), (6, 1)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   108
        , l [(1, 1), (5, 1)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   109
        , l [(4, 1), (4, 2), (3, 2)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   110
        , l [(0, 2), (1, 2), (1, 4)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   111
        , l [(0, 4), (3, 4), (3, 3), (5, 3), (5, 2), (7, 2)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   112
        , l [(7, 1), (7, 3)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   113
        , l [(8, 0), (8, 4), (4, 4), (4, 5), (1, 5), (1, 6)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   114
        , l [(6, 3), (6, 4)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   115
        , l [(0, 8), (8, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   116
        , l [(1, 7), (1, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   117
        , l [(2, 7), (2, 5)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   118
        , l [(3, 6), (3, 5)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   119
        , l [(3, 7), (3, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   120
        , l [(4, 6), (4, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   121
        , l [(5, 4), (5, 6)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   122
        , l [(5, 7), (5, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   123
        , l [(6, 5), (6, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   124
        , l [(7, 4), (7, 6)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   125
        , l [(7, 7), (7, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   126
        , l [(8, 5), (8, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   127
        ]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   128
    l = Line Solid 0
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   129
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   130
drawnMap04 = translate (-3) (-3) $ sp ++ fm sp ++ base ++ fm base
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   131
    where
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   132
    sp = translate 128 128 . scale 256 $ [SpecialPoints [
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   133
        (7, 7)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   134
--        , (6, 6)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   135
        , (3, 3)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   136
        , (0, 6)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   137
        , (3, 6)
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   138
        ]]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   139
    base = scale 256 $ [
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   140
        l [(1, 2), (3, 2), (3, 1), (4, 1), (4, 2), (6, 2), (6, 4), (7, 4), (7, 5), (8, 5), (8, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   141
        , l [(0, 0), (16, 0)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   142
        , l [(1, 5), (3, 5), (3, 7), (1, 7), (1, 5)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   143
        , l [(4, 5), (6, 5), (6, 7), (4, 7), (4, 5)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   144
        , l [(0, 4), (2, 4), (2, 3), (5, 3), (5, 4)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   145
        , l [(6, 1), (6, 2), (7, 2)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   146
        , l [(7, 1), (8, 1)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   147
        , l [(7, 3), (8, 3)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   148
        , l [(3, 4), (4, 4)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   149
        , l [(7, 6), (7, 8)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   150
        , l [(2, 0), (2, 1)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   151
        , l [(5, 0), (5, 1)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   152
        ]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   153
    l = Line Solid 0
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   154
    fm = flip' . mirror
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   155
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   156
drawnMap05 = sp ++ fullFill ++ lW
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   157
    where
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   158
        w = 320
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   159
        sh = 420
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   160
        basePoints = [(w, w), (1024 + w `div` 2, 2048 - w), (2048, w), (3072 - w `div` 2, 2048 - w), (4096 - w, w)]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   161
        lW = [Line Erasing 60 basePoints]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   162
        sp = [SpecialPoints $ basePoints ++ [(1024 + w `div` 2, 2048 - w - sh), (3072 - w `div` 2, 2048 - w - sh), (2048, w + sh)]]
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   163
7a905f0070ce CRLF purge
nemo
parents: 10885
diff changeset
   164
fullFill = scale 256 $ [Line Solid 63 [(0, 1), (16, 1), (16, 3), (0, 3), (0, 5), (16, 5), (16, 7), (0, 7)]]