1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
module Game.Map
( Map,
load,
render,
isBlocked,
)
where
import Control.Monad
import qualified Game.Utils as U
import qualified SDL
import Text.JSON
import Text.JSON.Types
data Tileset = Tileset
{ tsCols :: Int,
tsWidth :: Int,
tsHeight :: Int,
tsFirstGid :: Int
}
deriving (Show)
data TileLayer = TileLayer
{ tlName :: String,
tlTiles :: [Int]
}
deriving (Show)
data MapData = MapData
{ mWidth :: Int,
mHeight :: Int,
mTileset :: Tileset,
mLayers :: [TileLayer]
}
deriving (Show)
data Map = Map MapData SDL.Texture
instance JSON Tileset where
showJSON = undefined
readJSON (JSArray [JSObject obj]) = do
Tileset
<$> valFromObj "columns" obj
<*> valFromObj "tilewidth" obj
<*> valFromObj "tileheight" obj
<*> valFromObj "firstgid" obj
readJSON _ = mzero
instance JSON TileLayer where
showJSON = undefined
readJSON (JSObject obj) =
case get_field obj "type" of
Just "tilelayer" ->
TileLayer
<$> valFromObj "name" obj
<*> valFromObj "data" obj
_ -> Error "unsupported layer type"
readJSON _ = mzero
instance JSON MapData where
showJSON = undefined
readJSON (JSObject obj) =
MapData
<$> valFromObj "width" obj
<*> valFromObj "height" obj
<*> valFromObj "tilesets" obj
<*> valFromObj "layers" obj
readJSON _ = mzero
-- | Loads a map from a JSON file.
load :: String -> SDL.Texture -> IO Map
load filename tex = do
d <- readFile filename
case decode d :: Result MapData of
Ok s -> pure $ Map s tex
Error e -> error e
-- | Check for collision detection vs "Blocked" TileLayer that MUST be last layer.
-- x and y in pixels.
isBlocked :: Map -> Int -> Int -> Bool
isBlocked (Map (MapData width _ ts layers) _) x y =
tiles !! ((x `div` tw) + (y `div` th) * width) >= firstgid
where
tiles = tlTiles (last layers)
tw = tsWidth ts
th = tsHeight ts
firstgid = tsFirstGid ts
-- | Renders a map.
render :: SDL.Renderer -> Map -> IO ()
render renderer (Map mapData tex) = do
mapM_
( \layer ->
mapM_
( \(x, y) ->
renderTile x y $ tlTiles layer !! (x + (y * mWidth mapData))
)
index
)
(init $ mLayers mapData)
where
mw = mWidth mapData
mh = mHeight mapData
index = [(x, y) | x <- [0 .. mw - 1], y <- [0 .. mh - 1]]
ts = mTileset mapData
firstgid = tsFirstGid ts
cols = tsCols ts
tileWidth = tsWidth ts
tileHeight = tsHeight ts
renderTile :: Int -> Int -> Int -> IO ()
renderTile x y tile
| tile < firstgid = pure ()
| otherwise = do
let tx = (tile - firstgid) `rem` cols
ty = (tile - firstgid) `div` cols
src = U.rect (tx * tileWidth) (ty * tileHeight) tileWidth tileHeight
dst = U.rect (x * tileWidth) (y * tileHeight) tileWidth tileHeight
SDL.copy renderer tex (Just src) (Just dst)
|
