{- | Global Tile IDs https://doc.mapeditor.org/en/latest/reference/global-tile-ids/ -} module Data.Tiled.GID where import Data.Aeson (FromJSON(..), ToJSON(..)) import Data.Bits (Bits(..), (.&.)) import Data.Bool (bool) import Data.Word (Word8, Word32) import Foreign (Storable(..)) import GHC.Generics (Generic) newtype GID = GID { getGID :: Word32 } deriving (Eq, Show, Generic) deriving newtype (FromJSON, ToJSON, Storable, Bits) pattern FLIPPED_HORIZONTALLY_BIT :: Int pattern FLIPPED_HORIZONTALLY_BIT = 31 pattern FLIPPED_VERTICALLY_BIT :: Int pattern FLIPPED_VERTICALLY_BIT = 30 pattern ROTATED_60_BIT :: Int pattern ROTATED_60_BIT = 29 pattern ROTATED_120_BIT :: Int pattern ROTATED_120_BIT = 28 data Flags = Flags { flippedHorizontally :: Bool , flippedVertically :: Bool , rotated60 :: Bool , rotated120 :: Bool } deriving (Eq, Show, Generic) {-# INLINEABLE flags #-} flags :: GID -> Flags flags = unpack32 . getGID {-# INLINEABLE pack32 #-} pack32 :: Flags -> Word32 pack32 Flags{..} = bool 0 (bit FLIPPED_HORIZONTALLY_BIT) flippedHorizontally .|. bool 0 (bit FLIPPED_VERTICALLY_BIT) flippedVertically .|. bool 0 (bit ROTATED_60_BIT) rotated60 .|. bool 0 (bit ROTATED_120_BIT) rotated120 {-# INLINEABLE unpack32 #-} unpack32 :: Word32 -> Flags unpack32 flags32 = Flags { flippedHorizontally = testBit flags32 FLIPPED_HORIZONTALLY_BIT , flippedVertically = testBit flags32 FLIPPED_VERTICALLY_BIT , rotated60 = testBit flags32 ROTATED_60_BIT , rotated120 = testBit flags32 ROTATED_120_BIT } {-# INLINEABLE pack8 #-} pack8 :: Flags -> Word8 pack8 flags = fromIntegral (pack32 flags `shiftR` 24) {-# INLINEABLE unpack8 #-} unpack8 :: Word8 -> Flags unpack8 bits8 = unpack32 (fromIntegral bits8 `shiftL` 24) noFlags :: Flags noFlags = Flags { flippedHorizontally = False , flippedVertically = False , rotated60 = False , rotated120 = False } flagBits :: Word32 flagBits = bit FLIPPED_HORIZONTALLY_BIT .|. bit FLIPPED_VERTICALLY_BIT .|. bit ROTATED_60_BIT .|. bit ROTATED_120_BIT toLocal :: GID -> Int toLocal (GID bits) = fromIntegral $ bits .&. complement flagBits fromLocal :: Flags -> Int -> GID fromLocal flags localId = GID $ fromIntegral localId .|. pack32 flags