summaryrefslogtreecommitdiff
path: root/tiled/Data/Tiled
diff options
context:
space:
mode:
Diffstat (limited to 'tiled/Data/Tiled')
-rw-r--r--tiled/Data/Tiled/Abstract.hs85
1 files changed, 85 insertions, 0 deletions
diff --git a/tiled/Data/Tiled/Abstract.hs b/tiled/Data/Tiled/Abstract.hs
new file mode 100644
index 0000000..5a5b7c0
--- /dev/null
+++ b/tiled/Data/Tiled/Abstract.hs
@@ -0,0 +1,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