blob: 5a5b7c094875bc1e408bd5c7a5ff492d628a4958 (
plain)
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
|
{-# LANGUAGE OverloadedStrings #-}
module Data.Tiled.Abstract where
import Universum
import qualified Data.Vector as V
import Data.Tiled (GlobalId, Layer (..), Object (..), Property (..),
PropertyValue (..), Tile (..), Tiledmap (..),
Tileset (..), mkTiledId)
import Util (showText)
class HasProperties a where
getProperties :: a -> [Property]
adjustProperties :: ([Property] -> Maybe [Property]) -> a -> a
instance HasProperties Layer where
getProperties = maybeToMonoid . layerProperties
adjustProperties f layer = layer
{ layerProperties = f (getProperties layer) }
instance HasProperties Tileset where
getProperties = maybeToMonoid . tilesetProperties
adjustProperties f tileset = tileset
{ tilesetProperties = f (getProperties tileset) }
instance HasProperties Tile where
getProperties = V.toList . maybeToMonoid . tileProperties
adjustProperties f tile = tile
{ tileProperties = (fmap V.fromList . f) (getProperties tile) }
instance HasProperties Object where
getProperties = V.toList . maybeToMonoid . objectProperties
adjustProperties f obj = obj
{ objectProperties = (fmap V.fromList . f) (getProperties obj) }
instance HasProperties Tiledmap where
getProperties = maybeToMonoid . tiledmapProperties
adjustProperties f tiledmap = tiledmap
{ tiledmapProperties = f (getProperties tiledmap) }
class HasData a where
getData :: a -> Maybe (Vector GlobalId)
instance HasData Layer where
getData = layerData
instance HasData Tile where
getData _ = Nothing
class HasTypeName a where
typeName :: Proxy a -> Text
instance HasTypeName Layer where
typeName _ = "layer"
instance HasTypeName Tileset where
typeName _ = "tileset"
instance HasTypeName Property where
typeName _ = "property"
class HasName a where
getName :: a -> Text
instance HasName Layer where
getName = layerName
instance HasName Tileset where
getName = tilesetName
instance HasName Property where
getName (Property n _) = n
instance HasName Tile where
getName tile = "[tile with global id " <> showText (tileId tile) <> "]"
class IsProperty a where
asProperty :: a -> PropertyValue
instance IsProperty PropertyValue where
asProperty = id
{-# INLINE asProperty #-}
instance IsProperty Text where
asProperty = StrProp
{-# INLINE asProperty #-}
layerIsEmpty :: HasData a => a -> Bool
layerIsEmpty layer = case getData layer of
Nothing -> True
Just d -> all ((==) $ mkTiledId 0) d
|
