10323

1 
module Main where


2 

10329

3 
import qualified Data.ByteString.Char8 as B


4 
import qualified Data.ByteString as BW

10323

5 
import qualified Data.ByteString.Lazy as BL

10329

6 
import qualified Codec.Binary.Base64 as Base64

10323

7 
import Data.Word


8 
import Data.Int


9 
import Data.Binary

10329

10 
import Data.Binary.Put

10323

11 
import Data.Bits


12 
import Control.Monad

10329

13 
import qualified Codec.Compression.Zlib as Z

10323

14 


15 
data LineType = Solid  Erasing


16 
deriving Eq


17 

10335

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))

10323

30 


31 
instance Binary Chunk where

10335

32 
put (SpecialPoints p) = do


33 
forM_ p $ \(x, y) > do


34 
put x


35 
put y


36 
putWord8 0

10323

37 
put (Line lt r ((x1, y1):ps)) = do


38 
let flags = r .. (if lt == Solid then 0 else (1 `shift` 6))


39 
put x1


40 
put y1

10329

41 
putWord8 $ flags .. (1 `shift` 7)

10323

42 
forM_ ps $ \(x, y) > do


43 
put x


44 
put y

10329

45 
putWord8 flags

10323

46 
get = undefined


47 

10329

48 
compressWithLength :: BL.ByteString > BL.ByteString


49 
compressWithLength b = BL.drop 8 . encode . runPut $ do


50 
put $ ((fromIntegral $ BL.length b)::Word32)


51 
mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b


52 


53 
mapString :: B.ByteString

10365

54 
mapString = B.pack . Base64.encode . BW.unpack . BL.toStrict . compressWithLength . BL.drop 8 . encode $ drawnMap02

10329

55 


56 
main = B.writeFile "out.hwmap" mapString


57 

10335

58 
drawnMap01 = translate (3) (3) $ sp ++ mirror sp ++ base ++ mirror base


59 
where


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

10365

84 


85 
drawnMap02 = translate (3) (3) $ sp ++ mirror sp ++ base ++ mirror base


86 
where


87 
sp = translate 128 128 . scale 256 $ [SpecialPoints [


88 
(7, 0)


89 
, (7, 7)


90 
]]


91 
base = scale 256 $ [


92 
l [(8, 0), (8, 1), (1, 1)]


93 
, 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)]


94 
, 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)]


95 
]


96 
l = Line Solid 0
