diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,16 @@ +# Change Log + +## [0.0.1.0] - 2022-02-19 + +Package moved to https://github.com/haskell-game/aeson-tiled + +- Fixed frame serialization. +- Updated to match recent Tiled format. +- Maintenance info update. + +## [0.0.0.1] - 2017-10-24 + +Initial release. + +[0.0.1.0]: https://github.com/haskell-game/aeson-tiled/releases/tag/v0.0.1.0 +[0.0.0.1]: https://github.com/haskell-game/aeson-tiled/releases/tag/v0.0.0.1 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,8 +1,10 @@ # aeson-tiled -[![Build Status](https://travis-ci.org/schell/aeson-tiled.svg?branch=master)](https://travis-ci.org/schell/aeson-tiled) + [![Hackage](https://img.shields.io/hackage/v/aeson-tiled.svg)](https://hackage.haskell.org/package/aeson-tiled) -`aeson-tiled` is the spiritual successor to `htiled`. `htiled` uses `hxt` which relies -too heavily on Arrows and is rather hard to work with. Tiled's json export -supports 100% of Tiled's features, so there doesn't seem to be much of a -point to maintaining a large Arrows-based project when writing Aeson instances -for Tiled types is much easier. Hence this project! + +Types and instances for [Tiled](https://www.mapeditor.org/) map editor `.tmj` files. + +> `aeson-tiled` is the spiritual successor to `htiled`. +> `htiled` uses `hxt` which relies too heavily on Arrows and is rather hard to work with. +> Tiled's json export supports 100% of Tiled's features, so there doesn't seem to be much of a point to maintaining a large Arrows-based project when writing Aeson instances for Tiled types is much easier. +> Hence this project! diff --git a/aeson-tiled.cabal b/aeson-tiled.cabal --- a/aeson-tiled.cabal +++ b/aeson-tiled.cabal @@ -1,40 +1,41 @@ name: aeson-tiled -version: 0.0.0.1 +version: 0.0.1.0 synopsis: Aeson instances for the Tiled map editor. -description: The mighty Tiled 2d map editor is an open source +description: The mighty Tiled 2D map editor is an open source app for creating tile based level maps. This package provides types and aeson instances to read Tiled json files. -homepage: https://github.com/schell/aeson-tiled#readme +homepage: https://github.com/haskell-game/aeson-tiled license: BSD3 license-file: LICENSE +maintainer: aenor.realm@gmai.com author: Schell Scivally -maintainer: schell@takt.com -copyright: Copyright: (c) 2017 Schell Scivally -category: Game +copyright: (c) 2017 Schell Scivally +category: Game Engine build-type: Simple -extra-source-files: README.md cabal-version: >=1.10 +extra-source-files: + README.md, + ChangeLog.md + library hs-source-dirs: src exposed-modules: Data.Aeson.Tiled - build-depends: base >= 4.7 && < 5 - , bytestring >= 0.10 - , aeson >= 1.1 - , containers >= 0.5 - , text >= 1.2 - , vector >= 0.12 + build-depends: base >= 4.7 && < 5 + , bytestring >= 0.10 && < 1 + , aeson >= 1.0 && < 3 + , containers >= 0.5 && < 1 + , text >= 1.2 && < 3 + , vector >= 0.11 && < 1 default-language: Haskell2010 -executable aeson-tiled-exe - hs-source-dirs: app - main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , aeson-tiled - default-language: Haskell2010 +flag tests + manual: True + default: False test-suite aeson-tiled-test + if !flag(tests) + buildable: False type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs @@ -42,9 +43,10 @@ , aeson >= 1.1 , aeson-tiled , hspec + , hspec-discover + , bytestring ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 - -source-repository head - type: git - location: https://github.com/schell/aeson-tiled + other-modules: + ParseObjectSpec + RoundTripSpec diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 --- a/app/Main.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main where - -import Data.Aeson.Tiled - -main :: IO () -main = print =<< loadTiledmap "example.json" diff --git a/src/Data/Aeson/Tiled.hs b/src/Data/Aeson/Tiled.hs --- a/src/Data/Aeson/Tiled.hs +++ b/src/Data/Aeson/Tiled.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} @@ -24,8 +25,10 @@ import qualified Data.ByteString.Lazy.Char8 as C8 import Data.Map (Map) import qualified Data.Map as M +import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Vector (Vector) +import GHC.Exts (fromList, toList) import GHC.Generics (Generic) @@ -39,33 +42,68 @@ deriving (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey) +data XYPair a = XYPair a a + +instance FromJSON a => FromJSON (XYPair a) where + parseJSON (A.Object o) = + XYPair <$> o .: "x" + <*> o .: "y" + parseJSON invalid = typeMismatch "Object" invalid + +instance ToJSON a => ToJSON (XYPair a) where + toJSON (XYPair x y) = + object [ "x" .= x + , "y" .= y + ] + +fromXYPair :: XYPair a -> (a, a) +fromXYPair (XYPair x y) = (x, y) + +toXYPair :: (a, a) -> XYPair a +toXYPair (x, y) = XYPair x y + +omitNulls :: Value -> Value +omitNulls (A.Object hs) = A.Object + . fromList + . filter ((/= Null) . snd) + $ toList hs +omitNulls x = x + +#if MIN_VERSION_aeson(2,0,0) +parseDefault :: FromJSON a => A.Object -> A.Key -> a -> Parser a +#else +parseDefault :: FromJSON a => A.Object -> Text -> a -> Parser a +#endif +parseDefault o s d = fromMaybe d <$> o .:? s + + data Object = Object { objectId :: Int -- ^ Incremental id - unique across all objects - , objectWidth :: Int + , objectWidth :: Double -- ^ Width in pixels. Ignored if using a gid. - , objectHeight :: Int + , objectHeight :: Double -- ^ Height in pixels. Ignored if using a gid. - , objectName :: String + , objectName :: Text -- ^ String assigned to name field in editor - , objectType :: String + , objectType :: Text -- ^ String assigned to type field in editor , objectProperties :: Map Text Text -- ^ String key-value pairs , objectVisible :: Bool -- ^ Whether object is shown in editor. - , objectX :: Int + , objectX :: Double -- ^ x coordinate in pixels - , objectY :: Int + , objectY :: Double -- ^ y coordinate in pixels , objectRotation :: Float -- ^ Angle in degrees clockwise - , objectGid :: GlobalId + , objectGid :: Maybe GlobalId -- ^ GID, only if object comes from a Tilemap , objectEllipse :: Bool -- ^ Used to mark an object as an ellipse - , objectPolygon :: Vector (Int, Int) + , objectPolygon :: Maybe (Vector (Double, Double)) -- ^ A list of x,y coordinates in pixels - , objectPolyline :: Vector (Int, Int) + , objectPolyline :: Maybe (Vector (Double, Double)) -- ^ A list of x,y coordinates in pixels , objectText :: Map Text Text -- ^ String key-value pairs @@ -77,50 +115,51 @@ <*> o .: "height" <*> o .: "name" <*> o .: "type" - <*> o .: "properties" + <*> parseDefault o "properties" M.empty <*> o .: "visible" <*> o .: "x" <*> o .: "y" <*> o .: "rotation" - <*> o .: "gid" - <*> o .: "ellipse" - <*> o .: "polygon" - <*> o .: "polyline" - <*> o .: "text" + <*> o .:? "gid" + <*> parseDefault o "ellipse" False + <*> (fmap . fmap . fmap) fromXYPair (o .:? "polygon") + <*> (fmap . fmap . fmap) fromXYPair (o .:? "polyline") + <*> parseDefault o "text" M.empty parseJSON invalid = typeMismatch "Object" invalid instance ToJSON Object where - toJSON Object{..} = object [ "id" .= objectId - , "width" .= objectWidth - , "height" .= objectHeight - , "name" .= objectName - , "type" .= objectType - , "properties" .= objectProperties - , "visible" .= objectVisible - , "x" .= objectX - , "y" .= objectY - , "rotation" .= objectRotation - , "gid" .= objectGid - , "ellipse" .= objectEllipse - , "polygon" .= objectPolygon - , "polyline" .= objectPolyline - , "text" .= objectText - ] + toJSON Object{..} = omitNulls $ + object [ "id" .= objectId + , "width" .= objectWidth + , "height" .= objectHeight + , "name" .= objectName + , "type" .= objectType + , "properties" .= objectProperties + , "visible" .= objectVisible + , "x" .= objectX + , "y" .= objectY + , "rotation" .= objectRotation + , "gid" .= objectGid + , "ellipse" .= objectEllipse + , "polygon" .= (fmap . fmap) toXYPair objectPolygon + , "polyline" .= (fmap . fmap) toXYPair objectPolyline + , "text" .= objectText + ] -data Layer = Layer { layerWidth :: Int +data Layer = Layer { layerWidth :: Double -- ^ Column count. Same as map width for fixed-size maps. - , layerHeight :: Int + , layerHeight :: Double -- ^ Row count. Same as map height for fixed-size maps. - , layerName :: String + , layerName :: Text -- ^ Name assigned to this layer - , layerType :: String + , layerType :: Text -- TODO: LayerType -- ^ “tilelayer”, “objectgroup”, or “imagelayer” , layerVisible :: Bool -- ^ Whether layer is shown or hidden in editor - , layerX :: Int + , layerX :: Double -- ^ Horizontal layer offset in tiles. Always 0. - , layerY :: Int + , layerY :: Double -- ^ Vertical layer offset in tiles. Always 0. , layerData :: Maybe (Vector GlobalId) -- ^ Array of GIDs. tilelayer only. @@ -130,7 +169,7 @@ -- ^ string key-value pairs. , layerOpacity :: Float -- ^ Value between 0 and 1 - , layerDraworder :: String + , layerDraworder :: Text -- TODO: DrawOrder -- ^ “topdown” (default) or “index”. objectgroup only. } deriving (Eq, Generic, Show) @@ -143,29 +182,30 @@ <*> o .: "x" <*> o .: "y" <*> (o .: "data" <|> pure Nothing) - <*> (o .: "objects" <|> pure Nothing) + <*> o .:? "objects" <*> (o .: "properties" <|> pure mempty) <*> o .: "opacity" <*> (o .: "draworder" <|> pure "topdown") parseJSON invalid = typeMismatch "Layer" invalid instance ToJSON Layer where - toJSON Layer{..} = object [ "width" .= layerWidth - , "height" .= layerHeight - , "name" .= layerName - , "type" .= layerType - , "visible" .= layerVisible - , "x" .= layerX - , "y" .= layerY - , "data" .= layerData - , "objects" .= layerObjects - , "properties" .= layerProperties - , "opacity" .= layerOpacity - , "draworder" .= layerDraworder - ] + toJSON Layer{..} = omitNulls $ + object [ "width" .= layerWidth + , "height" .= layerHeight + , "name" .= layerName + , "type" .= layerType + , "visible" .= layerVisible + , "x" .= layerX + , "y" .= layerY + , "data" .= layerData + , "objects" .= layerObjects + , "properties" .= layerProperties + , "opacity" .= layerOpacity + , "draworder" .= layerDraworder + ] -data Terrain = Terrain { terrainName :: String +data Terrain = Terrain { terrainName :: Text -- ^ Name of terrain , terrainTile :: LocalId -- ^ Local ID of tile representing terrain @@ -189,12 +229,12 @@ instance FromJSON Frame where parseJSON (A.Object o) = Frame <$> o .: "duration" - <*> o .: "tileId" + <*> o .: "tileid" parseJSON invalid = typeMismatch "Frame" invalid instance ToJSON Frame where toJSON Frame{..} = object [ "duration" .= frameDuration - , "tileId" .= frameTileId + , "tileid" .= frameTileId ] @@ -222,9 +262,9 @@ data Tileset = Tileset { tilesetFirstgid :: GlobalId -- ^ GID corresponding to the first tile in the set - , tilesetImage :: String + , tilesetImage :: FilePath -- ^ Image used for tiles in this set - , tilesetName :: String + , tilesetName :: Text -- ^ Name given to this tileset , tilesetTilewidth :: Int -- ^ Maximum width of tiles in this set @@ -303,29 +343,65 @@ , "tiles" .= tilesetTiles ] +data Version + = VersionFloat Float + | VersionText Text + deriving (Eq, Ord, Show, Generic) +instance FromJSON Version where + parseJSON v = + fmap VersionFloat (parseJSON v) <|> + fmap VersionText (parseJSON v) + +instance ToJSON Version where + toJSON version = case version of + VersionFloat f -> toJSON f + VersionText t -> toJSON t + +data Orientation + = Orthogonal + | Isometric + | Staggered + | Orientation Text + deriving (Eq, Ord, Show, Generic) + +instance FromJSON Orientation where + parseJSON = withText "Orientation" $ \t -> + case t of + "orthogonal" -> pure Orthogonal + "isometric" -> pure Isometric + "staggered" -> pure Staggered + _otherwise -> pure $ Orientation t + +instance ToJSON Orientation where + toJSON o = toJSON $ case o of + Orthogonal -> "orthogonal" + Isometric -> "isometric" + Staggered -> "staggered" + Orientation t -> t + -- | The full monty. -data Tiledmap = Tiledmap { tiledmapVersion :: Float +data Tiledmap = Tiledmap { tiledmapVersion :: Version -- ^ The JSON format version - , tiledmapTiledversion :: String + , tiledmapTiledversion :: Version -- ^ The Tiled version used to save the file , tiledmapWidth :: Int -- ^ Number of tile columns , tiledmapHeight :: Int -- ^ Number of tile rows - , tiledmapTilewidth :: Int + , tiledmapTilewidth :: Double -- ^ Map grid width. - , tiledmapTileheight :: Int + , tiledmapTileheight :: Double -- ^ Map grid height. - , tiledmapOrientation :: String + , tiledmapOrientation :: Orientation -- ^ Orthogonal, isometric, or staggered , tiledmapLayers :: Vector Layer -- ^ Array of Layers , tiledmapTilesets :: Vector Tileset -- ^ Array of Tilesets - , tiledmapBackgroundcolor :: Maybe String + , tiledmapBackgroundcolor :: Maybe Text -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional) - , tiledmapRenderorder :: String + , tiledmapRenderorder :: Text -- TODO: RenderOrder -- ^ Rendering direction (orthogonal maps only) , tiledmapProperties :: Map Text Text -- ^ String key-value pairs diff --git a/test/ParseObjectSpec.hs b/test/ParseObjectSpec.hs new file mode 100644 --- /dev/null +++ b/test/ParseObjectSpec.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module ParseObjectSpec where + +import Data.Aeson (encode, eitherDecode) +import Test.Hspec +import Data.Either (isRight) +import Control.Monad (forM_) +import qualified Data.ByteString.Lazy.Char8 as C8 + +import Data.Aeson.Tiled + +file :: FilePath +file = "maps/objects/obj1.json" + +spec :: Spec +spec = describe "Obj1" $ do + it "should parse just fine" $ do + eobj <- fmap (eitherDecode @Object) $ C8.readFile file + eobj `shouldSatisfy` isRight + diff --git a/test/RoundTripSpec.hs b/test/RoundTripSpec.hs new file mode 100644 --- /dev/null +++ b/test/RoundTripSpec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE LambdaCase #-} + +module RoundTripSpec where + +import Data.Aeson (encode, eitherDecode) +import Test.Hspec +import Control.Monad (forM_) + +import Data.Aeson.Tiled + +files :: [FilePath] +files = [ "maps/example.json" + , "maps/test1.json" + , "maps/test2.json" + , "maps/test3.json" + , "maps/test4.json" + ] + +spec :: Spec +spec = describe "Round tripping" . forM_ files $ \file -> + it (file ++ " should roundtrip and end up with the same Tiledmap") $ + loadTiledmap file >>= \case + Right tm -> do + let bs = encode tm + eitherDecode bs `shouldBe` Right tm + Left x -> fail x diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,24 +1,1 @@ -{-# LANGUAGE LambdaCase #-} -import Data.Aeson (encode, eitherDecode) -import Test.Hspec -import Control.Monad (forM_) - -import Data.Aeson.Tiled - -files :: [FilePath] -files = [ "maps/example.json" - , "maps/test1.json" - , "maps/test2.json" - , "maps/test3.json" - , "maps/test4.json" - ] - -main :: IO () -main = hspec $ forM_ files $ \file -> - describe ("With " ++ show file) $ - it "loading and encoding and decoding should end up with the same Tiledmap" $ - loadTiledmap file >>= \case - Right tm -> do - let bs = encode tm - eitherDecode bs `shouldBe` Right tm - _ -> fail $ "Could not decode Tiledmap from " ++ show file +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}