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
|
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
{ cols :: Int,
width :: Int,
height :: Int,
firstGid :: Int
}
deriving (Show)
data TileLayer = TileLayer
{ name :: String,
tiles :: [Int]
}
deriving (Show)
data MapData = MapData
{ width :: Int,
height :: Int,
tileset :: Tileset,
layers :: [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 mapWidth _ ts ls) _) x y =
blocked !! ((x `div` ts.width) + (y `div` ts.height) * mapWidth) >= ts.firstGid
where
blocked = (last ls).tiles
-- | Renders a map.
render :: SDL.Renderer -> Map -> IO ()
render renderer (Map mapData tex) = do
mapM_
( \layer ->
mapM_
( \(x, y) ->
renderTile x y $ layer.tiles !! (x + (y * mapData.width))
)
index
)
(init $ mapData.layers)
where
index = [(x, y) | x <- [0 .. mapData.width - 1], y <- [0 .. mapData.height - 1]]
columns = mapData.tileset.cols
firstgid = mapData.tileset.firstGid
tileWidth = mapData.tileset.width
tileHeight = mapData.tileset.height
renderTile :: Int -> Int -> Int -> IO ()
renderTile x y tile
| tile < firstgid = pure ()
| otherwise = do
let tx = (tile - firstgid) `rem` columns
ty = (tile - firstgid) `div` columns
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)
|
