module Rattletrap.Type.Attribute.Rotation where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Int8Vector as Int8Vector
import qualified Rattletrap.Utility.Json as Json

newtype Rotation = Rotation
  { Rotation -> Int8Vector
value :: Int8Vector.Int8Vector
  }
  deriving (Rotation -> Rotation -> Bool
(Rotation -> Rotation -> Bool)
-> (Rotation -> Rotation -> Bool) -> Eq Rotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rotation -> Rotation -> Bool
== :: Rotation -> Rotation -> Bool
$c/= :: Rotation -> Rotation -> Bool
/= :: Rotation -> Rotation -> Bool
Eq, Int -> Rotation -> ShowS
[Rotation] -> ShowS
Rotation -> String
(Int -> Rotation -> ShowS)
-> (Rotation -> String) -> ([Rotation] -> ShowS) -> Show Rotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rotation -> ShowS
showsPrec :: Int -> Rotation -> ShowS
$cshow :: Rotation -> String
show :: Rotation -> String
$cshowList :: [Rotation] -> ShowS
showList :: [Rotation] -> ShowS
Show)

instance Json.FromJSON Rotation where
  parseJSON :: Value -> Parser Rotation
parseJSON = (Int8Vector -> Rotation) -> Parser Int8Vector -> Parser Rotation
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8Vector -> Rotation
Rotation (Parser Int8Vector -> Parser Rotation)
-> (Value -> Parser Int8Vector) -> Value -> Parser Rotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Int8Vector
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Rotation where
  toJSON :: Rotation -> Value
toJSON = Int8Vector -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Int8Vector -> Value)
-> (Rotation -> Int8Vector) -> Rotation -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rotation -> Int8Vector
value

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-rotation" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Int8Vector.schema

bitPut :: Rotation -> BitPut.BitPut
bitPut :: Rotation -> BitPut
bitPut = Int8Vector -> BitPut
Int8Vector.bitPut (Int8Vector -> BitPut)
-> (Rotation -> Int8Vector) -> Rotation -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rotation -> Int8Vector
value

bitGet :: BitGet.BitGet Rotation
bitGet :: BitGet Rotation
bitGet = String -> BitGet Rotation -> BitGet Rotation
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Rotation" (BitGet Rotation -> BitGet Rotation)
-> BitGet Rotation -> BitGet Rotation
forall a b. (a -> b) -> a -> b
$ do
  Int8Vector
value <- String -> BitGet Int8Vector -> BitGet Int8Vector
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" BitGet Int8Vector
Int8Vector.bitGet
  Rotation -> BitGet Rotation
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rotation {Int8Vector
value :: Int8Vector
value :: Int8Vector
value}