{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.Header
  ( Header(..)
  )
where

import Rattletrap.Type.Common
import Rattletrap.Type.Dictionary
import Rattletrap.Type.Property
import Rattletrap.Type.Str
import Rattletrap.Type.Word32le

-- | Contains high-level metadata about a 'Rattletrap.Replay.Replay'.
data Header = Header
  { Header -> Word32le
headerEngineVersion :: Word32le
  -- ^ The "major" ("engine") version number.
  , Header -> Word32le
headerLicenseeVersion :: Word32le
  -- ^ The "minor" ("licensee") version number.
  , Header -> Maybe Word32le
headerPatchVersion :: Maybe Word32le
  -- ^ The "patch" ("net") version number.
  , Header -> Str
headerLabel :: Str
  -- ^ Always @TAGame.Replay_Soccar_TA@.
  , Header -> Dictionary Property
headerProperties :: Dictionary Property
  -- ^ These properties determine how a replay will look in the list of
  -- replays in-game. One element is required for the replay to show up:
  --
  -- - MapName: This is a 'Rattletrap.PropertyValue.NameProperty' with a
  --   case-insensitive map identifier, like @Stadium_P@.
  --
  -- There are many other properties that affect how the replay looks in the
  -- list of replays.
  --
  -- - Date: A 'Rattletrap.PropertyValue.StrProperty' with the format
  --   @YYYY-mm-dd:HH-MM@. Dates are not validated, but the month must be
  --   between 1 and 12 to show up. The hour is shown modulo 12 with AM or PM.
  -- - MatchType: A 'Rattletrap.PropertyValue.NameProperty'. If this is not
  --   one of the expected values, nothing will be shown next to the replay's
  --   map. The expected values are: @Online@, @Offline@, @Private@, and
  --   @Season@.
  -- - NumFrames: This 'Rattletrap.PropertyValue.IntProperty' is used to
  --   calculate the length of the match. There are 30 frames per second,
  --   a typical 5-minute match has about 9,000 frames.
  -- - PrimaryPlayerTeam: This is an 'Rattletrap.PropertyValue.IntProperty'.
  --   It is either 0 (blue) or 1 (orange). Any other value is ignored. If
  --   this would be 0, you don't have to set it at all.
  -- - ReplayName: An optional 'Rattletrap.PropertyValue.StrProperty' with a
  --   user-supplied name for the replay.
  -- - Team0Score: The blue team's score as an
  --   'Rattletrap.PropertyValue.IntProperty'. Can be omitted if the score is
  --   0.
  -- - Team1Score: The orange team's score as an
  --   'Rattletrap.PropertyValue.IntProperty'. Can also be omitted if the
  --   score is 0.
  -- - TeamSize: An 'Rattletrap.PropertyValue.IntProperty' with the number of
  --   players per team. This value is not validated, so you can put absurd
  --   values like 99. To get an "unfair" team size like 1v4, you must set the
  --   bUnfairBots 'Rattletrap.PropertyValue.BoolProperty' to @True@.
  } deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Eq Header
Eq Header
-> (Header -> Header -> Ordering)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Header)
-> (Header -> Header -> Header)
-> Ord Header
Header -> Header -> Bool
Header -> Header -> Ordering
Header -> Header -> Header
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 :: Header -> Header -> Header
$cmin :: Header -> Header -> Header
max :: Header -> Header -> Header
$cmax :: Header -> Header -> Header
>= :: Header -> Header -> Bool
$c>= :: Header -> Header -> Bool
> :: Header -> Header -> Bool
$c> :: Header -> Header -> Bool
<= :: Header -> Header -> Bool
$c<= :: Header -> Header -> Bool
< :: Header -> Header -> Bool
$c< :: Header -> Header -> Bool
compare :: Header -> Header -> Ordering
$ccompare :: Header -> Header -> Ordering
$cp1Ord :: Eq Header
Ord, Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show)

$(deriveJson ''Header)