module Rattletrap.Type.Attribute.GameMode where

import qualified Data.Word as Word
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

data GameMode = GameMode
  { -- | This field is guaranteed to be small. In other words, it won't overflow.
    -- It's stored as a regular 'Int' rather than something more precise like an
    -- 'Int8' because it just gets passed to functions that expect 'Int's.
    -- There's no reason to do a bunch of conversions.
    GameMode -> Int
numBits :: Int,
    GameMode -> Word8
word :: Word.Word8
  }
  deriving (GameMode -> GameMode -> Bool
(GameMode -> GameMode -> Bool)
-> (GameMode -> GameMode -> Bool) -> Eq GameMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GameMode -> GameMode -> Bool
== :: GameMode -> GameMode -> Bool
$c/= :: GameMode -> GameMode -> Bool
/= :: GameMode -> GameMode -> Bool
Eq, Int -> GameMode -> ShowS
[GameMode] -> ShowS
GameMode -> String
(Int -> GameMode -> ShowS)
-> (GameMode -> String) -> ([GameMode] -> ShowS) -> Show GameMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GameMode -> ShowS
showsPrec :: Int -> GameMode -> ShowS
$cshow :: GameMode -> String
show :: GameMode -> String
$cshowList :: [GameMode] -> ShowS
showList :: [GameMode] -> ShowS
Show)

instance Json.FromJSON GameMode where
  parseJSON :: Value -> Parser GameMode
parseJSON = String -> (Object -> Parser GameMode) -> Value -> Parser GameMode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"GameMode" ((Object -> Parser GameMode) -> Value -> Parser GameMode)
-> (Object -> Parser GameMode) -> Value -> Parser GameMode
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Int
numBits <- Object -> String -> Parser Int
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"num_bits"
    Word8
word <- Object -> String -> Parser Word8
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"word"
    GameMode -> Parser GameMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GameMode {Int
numBits :: Int
numBits :: Int
numBits, Word8
word :: Word8
word :: Word8
word}

instance Json.ToJSON GameMode where
  toJSON :: GameMode -> Value
toJSON GameMode
x =
    [(Key, Value)] -> Value
Json.object [String -> Int -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"num_bits" (Int -> (Key, Value)) -> Int -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ GameMode -> Int
numBits GameMode
x, String -> Word8 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"word" (Word8 -> (Key, Value)) -> Word8 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ GameMode -> Word8
word GameMode
x]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-game-mode" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"num_bits" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.integer, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"word" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.integer, Bool
True)
      ]

bitPut :: GameMode -> BitPut.BitPut
bitPut :: GameMode -> BitPut
bitPut GameMode
gameModeAttribute = do
  Int -> Word8 -> BitPut
forall a. Bits a => Int -> a -> BitPut
BitPut.bits (GameMode -> Int
numBits GameMode
gameModeAttribute) (GameMode -> Word8
word GameMode
gameModeAttribute)

bitGet :: Version.Version -> BitGet.BitGet GameMode
bitGet :: Version -> BitGet GameMode
bitGet Version
version = String -> BitGet GameMode -> BitGet GameMode
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"GameMode" (BitGet GameMode -> BitGet GameMode)
-> BitGet GameMode -> BitGet GameMode
forall a b. (a -> b) -> a -> b
$ do
  let numBits :: Int
numBits = if Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
12 Int
0 Version
version then Int
8 else Int
2 :: Int
  Word8
word <- String -> BitGet Word8 -> BitGet Word8
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"word" (BitGet Word8 -> BitGet Word8) -> BitGet Word8 -> BitGet Word8
forall a b. (a -> b) -> a -> b
$ Int -> BitGet Word8
forall a. Bits a => Int -> BitGet a
BitGet.bits Int
numBits
  GameMode -> BitGet GameMode
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GameMode {Int
numBits :: Int
numBits :: Int
numBits, Word8
word :: Word8
word :: Word8
word}