summaryrefslogtreecommitdiff
path: root/lib/TiledAbstract.hs
blob: 0ccf26bc565e3a7ba8674e7f80b257c5f3acef82 (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
86
87
{-# LANGUAGE OverloadedStrings #-}

module TiledAbstract where

import           Data.Maybe  (fromMaybe)
import           Data.Proxy  (Proxy)
import           Data.Text   (Text)
import qualified Data.Vector as V
import           Tiled       (Layer (..), Object (..), Property (..),
                              PropertyValue (..), Tile (..), Tiledmap (..),
                              Tileset (..), mkTiledId, GlobalId)
import Data.Vector (Vector)
import Util (showText)

class HasProperties a where
  getProperties :: a -> [Property]
  adjustProperties :: ([Property] -> Maybe [Property]) -> a -> a

instance HasProperties Layer where
  getProperties = fromMaybe mempty . layerProperties
  adjustProperties f layer = layer
    { layerProperties = f (getProperties layer) }

instance HasProperties Tileset where
  getProperties = fromMaybe mempty . tilesetProperties
  adjustProperties f tileset = tileset
    { tilesetProperties = f (getProperties tileset) }

instance HasProperties Tile where
  getProperties = V.toList . fromMaybe mempty . tileProperties
  adjustProperties f tile = tile
    { tileProperties = (fmap V.fromList . f) (getProperties tile) }

instance HasProperties Object where
  getProperties = V.toList . fromMaybe mempty . objectProperties
  adjustProperties f obj = obj
    { objectProperties = (fmap V.fromList . f) (getProperties obj) }

instance HasProperties Tiledmap where
  getProperties = fromMaybe mempty . 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