module Rattletrap.Decode.ProductAttribute
  ( decodeProductAttributesBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.CompressedWord
import Rattletrap.Decode.Word32le
import Rattletrap.Decode.Word8le
import Rattletrap.Decode.Str
import Rattletrap.Type.Common
import Rattletrap.Type.ProductAttribute
import Rattletrap.Type.Str
import Rattletrap.Type.Word32le
import Rattletrap.Type.Word8le

import qualified Control.Monad as Monad
import qualified Data.Map as Map

decodeProductAttributesBits
  :: (Int, Int, Int) -> Map Word32le Str -> DecodeBits [ProductAttribute]
decodeProductAttributesBits :: (Int, Int, Int)
-> Map Word32le Str -> DecodeBits [ProductAttribute]
decodeProductAttributesBits (Int, Int, Int)
version Map Word32le Str
objectMap = do
  Word8le
size <- DecodeBits Word8le
decodeWord8leBits
  Int -> BitGet ProductAttribute -> DecodeBits [ProductAttribute]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM
    (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8le -> Word8
word8leValue Word8le
size))
    ((Int, Int, Int) -> Map Word32le Str -> BitGet ProductAttribute
decodeProductAttributeBits (Int, Int, Int)
version Map Word32le Str
objectMap)

decodeProductAttributeBits
  :: (Int, Int, Int) -> Map Word32le Str -> DecodeBits ProductAttribute
decodeProductAttributeBits :: (Int, Int, Int) -> Map Word32le Str -> BitGet ProductAttribute
decodeProductAttributeBits (Int, Int, Int)
version Map Word32le Str
objectMap = do
  Bool
flag <- BitGet Bool
getBool
  Word32le
objectId <- DecodeBits Word32le
decodeWord32leBits
  let maybeObjectName :: Maybe Str
maybeObjectName = Word32le -> Map Word32le Str -> Maybe Str
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word32le
objectId Map Word32le Str
objectMap
  ProductAttributeValue
value <- case Str -> String
fromStr (Str -> String) -> Maybe Str -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Str
maybeObjectName of
    Just String
"TAGame.ProductAttribute_Painted_TA" -> (Int, Int, Int) -> BitGet ProductAttributeValue
decodePainted (Int, Int, Int)
version
    Just String
"TAGame.ProductAttribute_SpecialEdition_TA" -> BitGet ProductAttributeValue
decodeSpecialEdition
    Just String
"TAGame.ProductAttribute_TeamEdition_TA" -> (Int, Int, Int) -> BitGet ProductAttributeValue
decodeTeamEdition (Int, Int, Int)
version
    Just String
"TAGame.ProductAttribute_TitleID_TA" -> BitGet ProductAttributeValue
decodeTitle
    Just String
"TAGame.ProductAttribute_UserColor_TA" -> (Int, Int, Int) -> BitGet ProductAttributeValue
decodeColor (Int, Int, Int)
version
    Just String
objectName -> String -> BitGet ProductAttributeValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      (String
"[RT05] unknown object name "
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
objectName
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" for ID "
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32le -> String
forall a. Show a => a -> String
show Word32le
objectId
      )
    Maybe String
Nothing -> String -> BitGet ProductAttributeValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RT06] missing object name for ID " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32le -> String
forall a. Show a => a -> String
show Word32le
objectId)
  ProductAttribute -> BitGet ProductAttribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
-> Word32le
-> Maybe Str
-> ProductAttributeValue
-> ProductAttribute
ProductAttribute Bool
flag Word32le
objectId Maybe Str
maybeObjectName ProductAttributeValue
value)

decodeSpecialEdition :: DecodeBits ProductAttributeValue
decodeSpecialEdition :: BitGet ProductAttributeValue
decodeSpecialEdition = Word32 -> ProductAttributeValue
ProductAttributeValueSpecialEdition (Word32 -> ProductAttributeValue)
-> BitGet Word32 -> BitGet ProductAttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BitGet Word32
forall a. Bits a => Int -> BitGet a
getBitsLE Int
31

decodePainted :: (Int, Int, Int) -> DecodeBits ProductAttributeValue
decodePainted :: (Int, Int, Int) -> BitGet ProductAttributeValue
decodePainted (Int, Int, Int)
version = if (Int, Int, Int)
version (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
868, Int
18, Int
0)
  then Word32 -> ProductAttributeValue
ProductAttributeValuePaintedNew (Word32 -> ProductAttributeValue)
-> BitGet Word32 -> BitGet ProductAttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BitGet Word32
forall a. Bits a => Int -> BitGet a
getBitsLE Int
31
  else CompressedWord -> ProductAttributeValue
ProductAttributeValuePaintedOld (CompressedWord -> ProductAttributeValue)
-> BitGet CompressedWord -> BitGet ProductAttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> BitGet CompressedWord
decodeCompressedWordBits Word
13

decodeTeamEdition :: (Int, Int, Int) -> DecodeBits ProductAttributeValue
decodeTeamEdition :: (Int, Int, Int) -> BitGet ProductAttributeValue
decodeTeamEdition (Int, Int, Int)
version = if (Int, Int, Int)
version (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
868, Int
18, Int
0)
  then Word32 -> ProductAttributeValue
ProductAttributeValueTeamEditionNew (Word32 -> ProductAttributeValue)
-> BitGet Word32 -> BitGet ProductAttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BitGet Word32
forall a. Bits a => Int -> BitGet a
getBitsLE Int
31
  else CompressedWord -> ProductAttributeValue
ProductAttributeValueTeamEditionOld (CompressedWord -> ProductAttributeValue)
-> BitGet CompressedWord -> BitGet ProductAttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> BitGet CompressedWord
decodeCompressedWordBits Word
13

decodeColor :: (Int, Int, Int) -> DecodeBits ProductAttributeValue
decodeColor :: (Int, Int, Int) -> BitGet ProductAttributeValue
decodeColor (Int, Int, Int)
version = if (Int, Int, Int)
version (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
868, Int
23, Int
8)
  then Word32le -> ProductAttributeValue
ProductAttributeValueUserColorNew (Word32le -> ProductAttributeValue)
-> DecodeBits Word32le -> BitGet ProductAttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeBits Word32le
decodeWord32leBits
  else do
    Bool
hasValue <- BitGet Bool
getBool
    Maybe Word32 -> ProductAttributeValue
ProductAttributeValueUserColorOld (Maybe Word32 -> ProductAttributeValue)
-> BitGet (Maybe Word32) -> BitGet ProductAttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> BitGet Word32 -> BitGet (Maybe Word32)
forall (m :: * -> *) (f :: * -> *) a.
(Applicative m, Alternative f) =>
Bool -> m a -> m (f a)
decodeWhen Bool
hasValue (Int -> BitGet Word32
forall a. Bits a => Int -> BitGet a
getBitsLE Int
31)

decodeTitle :: DecodeBits ProductAttributeValue
decodeTitle :: BitGet ProductAttributeValue
decodeTitle = Str -> ProductAttributeValue
ProductAttributeValueTitleId (Str -> ProductAttributeValue)
-> BitGet Str -> BitGet ProductAttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Str
decodeStrBits