{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.Content
  ( Content(..)
  , defaultContent
  )
where

import Rattletrap.Type.Cache
import Rattletrap.Type.ClassMapping
import Rattletrap.Type.Common
import Rattletrap.Type.Frame
import Rattletrap.Type.KeyFrame
import Rattletrap.Type.List
import Rattletrap.Type.Mark
import Rattletrap.Type.Message
import Rattletrap.Type.Str
import Rattletrap.Type.Word32le

-- | Contains low-level game data about a 'Rattletrap.Replay.Replay'.
data Content = Content
  { Content -> List Str
contentLevels :: List Str
  -- ^ This typically only has one element, like @stadium_oob_audio_map@.
  , Content -> List KeyFrame
contentKeyFrames :: List KeyFrame
  -- ^ A list of which frames are key frames. Although they aren't necessary
  -- for replay, key frames are frames that replicate every actor. They
  -- typically happen once every 10 seconds.
  , Content -> Word32le
contentStreamSize :: Word32le
  -- ^ The size of the stream in bytes. This is only really necessary because
  -- the stream has some arbitrary amount of padding at the end.
  , Content -> [Frame]
contentFrames :: [Frame]
  -- ^ The actual game data. This is where all the interesting information is.
  , Content -> List Message
contentMessages :: List Message
  -- ^ Debugging messages. In newer replays, this is always empty.
  , Content -> List Mark
contentMarks :: List Mark
  -- ^ Tick marks shown on the scrubber when watching a replay.
  , Content -> List Str
contentPackages :: List Str
  -- ^ A list of @.upk@ files to load, like
  -- @..\\..\\TAGame\\CookedPCConsole\\Stadium_P.upk@.
  , Content -> List Str
contentObjects :: List Str
  -- ^ Objects in the stream. Used for the
  -- 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
  , Content -> List Str
contentNames :: List Str
  -- ^ It's not clear what these are used for. This list is usually not empty,
  -- but appears unused otherwise.
  , Content -> List ClassMapping
contentClassMappings :: List ClassMapping
  -- ^ A mapping between classes and their ID in the stream. Used for the
  -- 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
  , Content -> List Cache
contentCaches :: List Cache
  -- ^ A list of classes along with their parent classes and attributes. Used
  -- for the 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
  , Content -> [Word8]
contentUnknown :: [Word8]
  } deriving (Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c== :: Content -> Content -> Bool
Eq, Eq Content
Eq Content
-> (Content -> Content -> Ordering)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Content)
-> (Content -> Content -> Content)
-> Ord Content
Content -> Content -> Bool
Content -> Content -> Ordering
Content -> Content -> Content
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Content -> Content -> Content
$cmin :: Content -> Content -> Content
max :: Content -> Content -> Content
$cmax :: Content -> Content -> Content
>= :: Content -> Content -> Bool
$c>= :: Content -> Content -> Bool
> :: Content -> Content -> Bool
$c> :: Content -> Content -> Bool
<= :: Content -> Content -> Bool
$c<= :: Content -> Content -> Bool
< :: Content -> Content -> Bool
$c< :: Content -> Content -> Bool
compare :: Content -> Content -> Ordering
$ccompare :: Content -> Content -> Ordering
$cp1Ord :: Eq Content
Ord, Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> String
$cshow :: Content -> String
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show)

$(deriveJson ''Content)

defaultContent :: Content
defaultContent :: Content
defaultContent = Content :: List Str
-> List KeyFrame
-> Word32le
-> [Frame]
-> List Message
-> List Mark
-> List Str
-> List Str
-> List Str
-> List ClassMapping
-> List Cache
-> [Word8]
-> Content
Content
  { contentLevels :: List Str
contentLevels = [Str] -> List Str
forall a. [a] -> List a
List []
  , contentKeyFrames :: List KeyFrame
contentKeyFrames = [KeyFrame] -> List KeyFrame
forall a. [a] -> List a
List []
  , contentStreamSize :: Word32le
contentStreamSize = Word32 -> Word32le
Word32le Word32
0
  , contentFrames :: [Frame]
contentFrames = []
  , contentMessages :: List Message
contentMessages = [Message] -> List Message
forall a. [a] -> List a
List []
  , contentMarks :: List Mark
contentMarks = [Mark] -> List Mark
forall a. [a] -> List a
List []
  , contentPackages :: List Str
contentPackages = [Str] -> List Str
forall a. [a] -> List a
List []
  , contentObjects :: List Str
contentObjects = [Str] -> List Str
forall a. [a] -> List a
List []
  , contentNames :: List Str
contentNames = [Str] -> List Str
forall a. [a] -> List a
List []
  , contentClassMappings :: List ClassMapping
contentClassMappings = [ClassMapping] -> List ClassMapping
forall a. [a] -> List a
List []
  , contentCaches :: List Cache
contentCaches = [Cache] -> List Cache
forall a. [a] -> List a
List []
  , contentUnknown :: [Word8]
contentUnknown = []
  }