htiled 0.0.3 → 0.1.0
raw patch · 3 files changed
+38/−17 lines, 3 filesdep ~base64-bytestringdep ~bytestringdep ~containersPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base64-bytestring, bytestring, containers, hxt
API changes (from Hackage documentation)
+ Data.Tiled.Types: ImageLayer :: String -> Float -> Bool -> Properties -> Image -> Layer
+ Data.Tiled.Types: layerImage :: Layer -> Image
+ Data.Tiled.Types: tileIsDiagFlipped :: Tile -> Bool
- Data.Tiled.Types: Tile :: Word32 -> Bool -> Bool -> Tile
+ Data.Tiled.Types: Tile :: Word32 -> Bool -> Bool -> Bool -> Tile
Files
- htiled.cabal +4/−4
- src/Data/Tiled/Load.hs +21/−12
- src/Data/Tiled/Types.hs +13/−1
htiled.cabal view
@@ -1,5 +1,5 @@ Name: htiled-Version: 0.0.3+Version: 0.1.0 Synopsis: Import from the Tiled map editor. Description: Import maps from the .tmx map format generated by Tiled, <http://www.mapeditor.org>.@@ -18,7 +18,7 @@ Library Hs-Source-Dirs: src Exposed-Modules: Data.Tiled, Data.Tiled.Types, Data.Tiled.Load- Build-depends: base ==4.*, zlib ==0.5.*, bytestring ==0.9.*- , hxt >9.1 && <9.3, base64-bytestring ==0.1.*- , containers ==0.4.*, filepath+ Build-depends: base ==4.*, zlib ==0.5.*, bytestring >=0.9 && <=0.11+ , hxt == 9.3.*, base64-bytestring ==1.0.*+ , containers ==0.5.*, filepath Ghc-Options: -Wall
src/Data/Tiled/Load.hs view
@@ -51,7 +51,7 @@ returnA ⤙ TiledMap {..} layers ∷ IOSArrow (XmlTree, (Int, Int)) [Layer]-layers = listA (first (getChildren >>> isElem) >>> doObjectGroup <+> doLayer)+layers = listA (first (getChildren >>> isElem) >>> doObjectGroup <+> doLayer <+> doImageLayer) where doObjectGroup = arr fst >>> hasName "objectgroup" >>> id &&& (listA object >>> arr Right) >>> common @@ -83,6 +83,13 @@ x = read x' y = read y' + doImageLayer = arr fst >>> hasName "imagelayer" >>> id &&& image >>> proc (l, layerImage) → do+ layerName ← getAttrValue "name" ⤙ l+ layerOpacity ← arr (fromMaybe 1 . listToMaybe) . listA (getAttrR "opacity") ⤙ l+ layerIsVisible ← arr (isNothing . listToMaybe) . listA (getAttrValue "visible") ⤙ l+ layerProperties ← properties ⤙ l+ returnA ⤙ ImageLayer{..}+ doLayer = first (hasName "layer") >>> arr fst &&& (doData >>> arr Left) >>> common doData = first (getChildren >>> isElem >>> hasName "data")@@ -108,9 +115,10 @@ bytesToTiles (a:b:c:d:xs) = Tile { .. } : bytesToTiles xs where n = f a + f b * 256 + f c * 65536 + f d * 16777216 f = fromIntegral . fromEnum ∷ Char → Word32- tileGid = n `clearBit` 30 `clearBit` 31+ tileGid = n `clearBit` 30 `clearBit` 31 `clearBit` 29 tileIsVFlipped = n `testBit` 30 tileIsHFlipped = n `testBit` 31+ tileIsDiagFlipped = n `testBit` 29 bytesToTiles [] = [] bytesToTiles _ = error "number of bytes not a multiple of 4." @@ -139,15 +147,16 @@ tileProperties = getChildren >>> isElem >>> hasName "tile" >>> getAttrR "id" &&& properties - images = listA (getChildren >>> isElem >>> hasName "image" >>>- proc image → do- iSource ← getAttrValue "source" ⤙ image- iTrans ← arr (fmap colorToTriplet . listToMaybe)- . listA (getAttrValue0 "trans") ⤙ image- iWidth ← getAttrR "width" ⤙ image- iHeight ← getAttrR "height" ⤙ image- returnA ⤙ Image {..})+ images = listA (getChildren >>> image) +image ∷ IOSArrow XmlTree Image+image = isElem >>> hasName "image" >>> proc img → do+ iSource ← getAttrValue "source" ⤙ img+ iTrans ← arr (fmap colorToTriplet . listToMaybe) . listA (getAttrValue0 "trans") ⤙ img+ iWidth ← getAttrR "width" ⤙ img+ iHeight ← getAttrR "height" ⤙ img+ returnA ⤙ Image {..}+ where colorToTriplet x = (h x, h $ drop 2 x, h $ drop 4 x)- where h (y:z:_) = fromIntegral $ digitToInt y * 16 + digitToInt z- h _ = error "invalid color in an <image ...> somewhere."+ where h (y:z:_) = fromIntegral $ digitToInt y * 16 + digitToInt z+ h _ = error "invalid color in an <image ...> somewhere."
src/Data/Tiled/Types.hs view
@@ -71,11 +71,18 @@ , layerIsVisible ∷ Bool , layerProperties ∷ Properties , layerObjects ∷ [Object]+ }+ | ImageLayer+ { layerName ∷ String+ , layerOpacity ∷ Float+ , layerIsVisible ∷ Bool+ , layerProperties ∷ Properties+ , layerImage ∷ Image } deriving Eq -- | A single tile as is stored in a layer. data Tile = Tile { tileGid ∷ Word32- , tileIsVFlipped, tileIsHFlipped ∷ Bool+ , tileIsVFlipped, tileIsHFlipped, tileIsDiagFlipped ∷ Bool } deriving (Show, Eq, Ord) @@ -90,4 +97,9 @@ ", layerIsVisible = " ++ show layerIsVisible ++ ", layerProperties = " ++ show layerProperties ++ ", layerObjects = " ++ show layerObjects ++ " }"+ show ImageLayer {..} = "ObjectLayer { layerName = " ++ show layerName +++ ", layerOpacity = " ++ show layerOpacity +++ ", layerIsVisible = " ++ show layerIsVisible +++ ", layerProperties = " ++ show layerProperties +++ ", layerImage = " ++ show layerImage ++ " }"