{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | Abstract identifiers for the main types in the engine. This is imported
-- by modules that don't need to know the internal structure
-- of the types. As a side effect, this prevents mutual dependencies
-- among modules.
module Game.LambdaHack.Common.Types
  ( ItemId, FactionId, LevelId, ActorId
  , Container(..)
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Data.Binary
import Data.Hashable
import GHC.Generics (Generic)

import Game.LambdaHack.Common.Point
import Game.LambdaHack.Definition.Defs

-- | A unique identifier of an item in the dungeon.
newtype ItemId = ItemId Int
  deriving (Int -> ItemId -> ShowS
[ItemId] -> ShowS
ItemId -> String
(Int -> ItemId -> ShowS)
-> (ItemId -> String) -> ([ItemId] -> ShowS) -> Show ItemId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemId] -> ShowS
$cshowList :: [ItemId] -> ShowS
show :: ItemId -> String
$cshow :: ItemId -> String
showsPrec :: Int -> ItemId -> ShowS
$cshowsPrec :: Int -> ItemId -> ShowS
Show, ItemId -> ItemId -> Bool
(ItemId -> ItemId -> Bool)
-> (ItemId -> ItemId -> Bool) -> Eq ItemId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemId -> ItemId -> Bool
$c/= :: ItemId -> ItemId -> Bool
== :: ItemId -> ItemId -> Bool
$c== :: ItemId -> ItemId -> Bool
Eq, Eq ItemId
Eq ItemId
-> (ItemId -> ItemId -> Ordering)
-> (ItemId -> ItemId -> Bool)
-> (ItemId -> ItemId -> Bool)
-> (ItemId -> ItemId -> Bool)
-> (ItemId -> ItemId -> Bool)
-> (ItemId -> ItemId -> ItemId)
-> (ItemId -> ItemId -> ItemId)
-> Ord ItemId
ItemId -> ItemId -> Bool
ItemId -> ItemId -> Ordering
ItemId -> ItemId -> ItemId
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 :: ItemId -> ItemId -> ItemId
$cmin :: ItemId -> ItemId -> ItemId
max :: ItemId -> ItemId -> ItemId
$cmax :: ItemId -> ItemId -> ItemId
>= :: ItemId -> ItemId -> Bool
$c>= :: ItemId -> ItemId -> Bool
> :: ItemId -> ItemId -> Bool
$c> :: ItemId -> ItemId -> Bool
<= :: ItemId -> ItemId -> Bool
$c<= :: ItemId -> ItemId -> Bool
< :: ItemId -> ItemId -> Bool
$c< :: ItemId -> ItemId -> Bool
compare :: ItemId -> ItemId -> Ordering
$ccompare :: ItemId -> ItemId -> Ordering
$cp1Ord :: Eq ItemId
Ord, Int -> ItemId
ItemId -> Int
ItemId -> [ItemId]
ItemId -> ItemId
ItemId -> ItemId -> [ItemId]
ItemId -> ItemId -> ItemId -> [ItemId]
(ItemId -> ItemId)
-> (ItemId -> ItemId)
-> (Int -> ItemId)
-> (ItemId -> Int)
-> (ItemId -> [ItemId])
-> (ItemId -> ItemId -> [ItemId])
-> (ItemId -> ItemId -> [ItemId])
-> (ItemId -> ItemId -> ItemId -> [ItemId])
-> Enum ItemId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ItemId -> ItemId -> ItemId -> [ItemId]
$cenumFromThenTo :: ItemId -> ItemId -> ItemId -> [ItemId]
enumFromTo :: ItemId -> ItemId -> [ItemId]
$cenumFromTo :: ItemId -> ItemId -> [ItemId]
enumFromThen :: ItemId -> ItemId -> [ItemId]
$cenumFromThen :: ItemId -> ItemId -> [ItemId]
enumFrom :: ItemId -> [ItemId]
$cenumFrom :: ItemId -> [ItemId]
fromEnum :: ItemId -> Int
$cfromEnum :: ItemId -> Int
toEnum :: Int -> ItemId
$ctoEnum :: Int -> ItemId
pred :: ItemId -> ItemId
$cpred :: ItemId -> ItemId
succ :: ItemId -> ItemId
$csucc :: ItemId -> ItemId
Enum, Get ItemId
[ItemId] -> Put
ItemId -> Put
(ItemId -> Put) -> Get ItemId -> ([ItemId] -> Put) -> Binary ItemId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ItemId] -> Put
$cputList :: [ItemId] -> Put
get :: Get ItemId
$cget :: Get ItemId
put :: ItemId -> Put
$cput :: ItemId -> Put
Binary)

-- | A unique identifier of a faction in a game. It's assigned in the order
-- from game mode roster, starting from one. We keep the @FactionId@
-- and @TeamContinuity@ types separate mostly to let @FactionId@ reflect
-- the order, which influences starting faction positions, etc.
-- We use @TeamContinuity@ for dictionaries containing teams that may
-- or may not be active factions in the current game, while @FactionId@ are
-- used only for factions in the game (in particular, because they vary
-- depending on order in game mode roster, while @TeamContinuity@ are stable).
newtype FactionId = FactionId Int
  deriving (Int -> FactionId -> ShowS
[FactionId] -> ShowS
FactionId -> String
(Int -> FactionId -> ShowS)
-> (FactionId -> String)
-> ([FactionId] -> ShowS)
-> Show FactionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FactionId] -> ShowS
$cshowList :: [FactionId] -> ShowS
show :: FactionId -> String
$cshow :: FactionId -> String
showsPrec :: Int -> FactionId -> ShowS
$cshowsPrec :: Int -> FactionId -> ShowS
Show, FactionId -> FactionId -> Bool
(FactionId -> FactionId -> Bool)
-> (FactionId -> FactionId -> Bool) -> Eq FactionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FactionId -> FactionId -> Bool
$c/= :: FactionId -> FactionId -> Bool
== :: FactionId -> FactionId -> Bool
$c== :: FactionId -> FactionId -> Bool
Eq, Eq FactionId
Eq FactionId
-> (FactionId -> FactionId -> Ordering)
-> (FactionId -> FactionId -> Bool)
-> (FactionId -> FactionId -> Bool)
-> (FactionId -> FactionId -> Bool)
-> (FactionId -> FactionId -> Bool)
-> (FactionId -> FactionId -> FactionId)
-> (FactionId -> FactionId -> FactionId)
-> Ord FactionId
FactionId -> FactionId -> Bool
FactionId -> FactionId -> Ordering
FactionId -> FactionId -> FactionId
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 :: FactionId -> FactionId -> FactionId
$cmin :: FactionId -> FactionId -> FactionId
max :: FactionId -> FactionId -> FactionId
$cmax :: FactionId -> FactionId -> FactionId
>= :: FactionId -> FactionId -> Bool
$c>= :: FactionId -> FactionId -> Bool
> :: FactionId -> FactionId -> Bool
$c> :: FactionId -> FactionId -> Bool
<= :: FactionId -> FactionId -> Bool
$c<= :: FactionId -> FactionId -> Bool
< :: FactionId -> FactionId -> Bool
$c< :: FactionId -> FactionId -> Bool
compare :: FactionId -> FactionId -> Ordering
$ccompare :: FactionId -> FactionId -> Ordering
$cp1Ord :: Eq FactionId
Ord, Int -> FactionId
FactionId -> Int
FactionId -> [FactionId]
FactionId -> FactionId
FactionId -> FactionId -> [FactionId]
FactionId -> FactionId -> FactionId -> [FactionId]
(FactionId -> FactionId)
-> (FactionId -> FactionId)
-> (Int -> FactionId)
-> (FactionId -> Int)
-> (FactionId -> [FactionId])
-> (FactionId -> FactionId -> [FactionId])
-> (FactionId -> FactionId -> [FactionId])
-> (FactionId -> FactionId -> FactionId -> [FactionId])
-> Enum FactionId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FactionId -> FactionId -> FactionId -> [FactionId]
$cenumFromThenTo :: FactionId -> FactionId -> FactionId -> [FactionId]
enumFromTo :: FactionId -> FactionId -> [FactionId]
$cenumFromTo :: FactionId -> FactionId -> [FactionId]
enumFromThen :: FactionId -> FactionId -> [FactionId]
$cenumFromThen :: FactionId -> FactionId -> [FactionId]
enumFrom :: FactionId -> [FactionId]
$cenumFrom :: FactionId -> [FactionId]
fromEnum :: FactionId -> Int
$cfromEnum :: FactionId -> Int
toEnum :: Int -> FactionId
$ctoEnum :: Int -> FactionId
pred :: FactionId -> FactionId
$cpred :: FactionId -> FactionId
succ :: FactionId -> FactionId
$csucc :: FactionId -> FactionId
Enum, Eq FactionId
Eq FactionId
-> (Int -> FactionId -> Int)
-> (FactionId -> Int)
-> Hashable FactionId
Int -> FactionId -> Int
FactionId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FactionId -> Int
$chash :: FactionId -> Int
hashWithSalt :: Int -> FactionId -> Int
$chashWithSalt :: Int -> FactionId -> Int
$cp1Hashable :: Eq FactionId
Hashable, Get FactionId
[FactionId] -> Put
FactionId -> Put
(FactionId -> Put)
-> Get FactionId -> ([FactionId] -> Put) -> Binary FactionId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FactionId] -> Put
$cputList :: [FactionId] -> Put
get :: Get FactionId
$cget :: Get FactionId
put :: FactionId -> Put
$cput :: FactionId -> Put
Binary)

-- | Abstract level identifiers.
newtype LevelId = LevelId Int
  deriving (Int -> LevelId -> ShowS
[LevelId] -> ShowS
LevelId -> String
(Int -> LevelId -> ShowS)
-> (LevelId -> String) -> ([LevelId] -> ShowS) -> Show LevelId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LevelId] -> ShowS
$cshowList :: [LevelId] -> ShowS
show :: LevelId -> String
$cshow :: LevelId -> String
showsPrec :: Int -> LevelId -> ShowS
$cshowsPrec :: Int -> LevelId -> ShowS
Show, LevelId -> LevelId -> Bool
(LevelId -> LevelId -> Bool)
-> (LevelId -> LevelId -> Bool) -> Eq LevelId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LevelId -> LevelId -> Bool
$c/= :: LevelId -> LevelId -> Bool
== :: LevelId -> LevelId -> Bool
$c== :: LevelId -> LevelId -> Bool
Eq, Eq LevelId
Eq LevelId
-> (LevelId -> LevelId -> Ordering)
-> (LevelId -> LevelId -> Bool)
-> (LevelId -> LevelId -> Bool)
-> (LevelId -> LevelId -> Bool)
-> (LevelId -> LevelId -> Bool)
-> (LevelId -> LevelId -> LevelId)
-> (LevelId -> LevelId -> LevelId)
-> Ord LevelId
LevelId -> LevelId -> Bool
LevelId -> LevelId -> Ordering
LevelId -> LevelId -> LevelId
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 :: LevelId -> LevelId -> LevelId
$cmin :: LevelId -> LevelId -> LevelId
max :: LevelId -> LevelId -> LevelId
$cmax :: LevelId -> LevelId -> LevelId
>= :: LevelId -> LevelId -> Bool
$c>= :: LevelId -> LevelId -> Bool
> :: LevelId -> LevelId -> Bool
$c> :: LevelId -> LevelId -> Bool
<= :: LevelId -> LevelId -> Bool
$c<= :: LevelId -> LevelId -> Bool
< :: LevelId -> LevelId -> Bool
$c< :: LevelId -> LevelId -> Bool
compare :: LevelId -> LevelId -> Ordering
$ccompare :: LevelId -> LevelId -> Ordering
$cp1Ord :: Eq LevelId
Ord, Eq LevelId
Eq LevelId
-> (Int -> LevelId -> Int) -> (LevelId -> Int) -> Hashable LevelId
Int -> LevelId -> Int
LevelId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: LevelId -> Int
$chash :: LevelId -> Int
hashWithSalt :: Int -> LevelId -> Int
$chashWithSalt :: Int -> LevelId -> Int
$cp1Hashable :: Eq LevelId
Hashable, Get LevelId
[LevelId] -> Put
LevelId -> Put
(LevelId -> Put)
-> Get LevelId -> ([LevelId] -> Put) -> Binary LevelId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [LevelId] -> Put
$cputList :: [LevelId] -> Put
get :: Get LevelId
$cget :: Get LevelId
put :: LevelId -> Put
$cput :: LevelId -> Put
Binary)

instance Enum LevelId where
  fromEnum :: LevelId -> Int
fromEnum (LevelId Int
n) = Int
n
  toEnum :: Int -> LevelId
toEnum = Int -> LevelId
LevelId  -- picks the main branch of the dungeon

-- | A unique identifier of an actor in the dungeon.
newtype ActorId = ActorId Int
  deriving (Int -> ActorId -> ShowS
[ActorId] -> ShowS
ActorId -> String
(Int -> ActorId -> ShowS)
-> (ActorId -> String) -> ([ActorId] -> ShowS) -> Show ActorId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActorId] -> ShowS
$cshowList :: [ActorId] -> ShowS
show :: ActorId -> String
$cshow :: ActorId -> String
showsPrec :: Int -> ActorId -> ShowS
$cshowsPrec :: Int -> ActorId -> ShowS
Show, ActorId -> ActorId -> Bool
(ActorId -> ActorId -> Bool)
-> (ActorId -> ActorId -> Bool) -> Eq ActorId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActorId -> ActorId -> Bool
$c/= :: ActorId -> ActorId -> Bool
== :: ActorId -> ActorId -> Bool
$c== :: ActorId -> ActorId -> Bool
Eq, Eq ActorId
Eq ActorId
-> (ActorId -> ActorId -> Ordering)
-> (ActorId -> ActorId -> Bool)
-> (ActorId -> ActorId -> Bool)
-> (ActorId -> ActorId -> Bool)
-> (ActorId -> ActorId -> Bool)
-> (ActorId -> ActorId -> ActorId)
-> (ActorId -> ActorId -> ActorId)
-> Ord ActorId
ActorId -> ActorId -> Bool
ActorId -> ActorId -> Ordering
ActorId -> ActorId -> ActorId
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 :: ActorId -> ActorId -> ActorId
$cmin :: ActorId -> ActorId -> ActorId
max :: ActorId -> ActorId -> ActorId
$cmax :: ActorId -> ActorId -> ActorId
>= :: ActorId -> ActorId -> Bool
$c>= :: ActorId -> ActorId -> Bool
> :: ActorId -> ActorId -> Bool
$c> :: ActorId -> ActorId -> Bool
<= :: ActorId -> ActorId -> Bool
$c<= :: ActorId -> ActorId -> Bool
< :: ActorId -> ActorId -> Bool
$c< :: ActorId -> ActorId -> Bool
compare :: ActorId -> ActorId -> Ordering
$ccompare :: ActorId -> ActorId -> Ordering
$cp1Ord :: Eq ActorId
Ord, Int -> ActorId
ActorId -> Int
ActorId -> [ActorId]
ActorId -> ActorId
ActorId -> ActorId -> [ActorId]
ActorId -> ActorId -> ActorId -> [ActorId]
(ActorId -> ActorId)
-> (ActorId -> ActorId)
-> (Int -> ActorId)
-> (ActorId -> Int)
-> (ActorId -> [ActorId])
-> (ActorId -> ActorId -> [ActorId])
-> (ActorId -> ActorId -> [ActorId])
-> (ActorId -> ActorId -> ActorId -> [ActorId])
-> Enum ActorId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ActorId -> ActorId -> ActorId -> [ActorId]
$cenumFromThenTo :: ActorId -> ActorId -> ActorId -> [ActorId]
enumFromTo :: ActorId -> ActorId -> [ActorId]
$cenumFromTo :: ActorId -> ActorId -> [ActorId]
enumFromThen :: ActorId -> ActorId -> [ActorId]
$cenumFromThen :: ActorId -> ActorId -> [ActorId]
enumFrom :: ActorId -> [ActorId]
$cenumFrom :: ActorId -> [ActorId]
fromEnum :: ActorId -> Int
$cfromEnum :: ActorId -> Int
toEnum :: Int -> ActorId
$ctoEnum :: Int -> ActorId
pred :: ActorId -> ActorId
$cpred :: ActorId -> ActorId
succ :: ActorId -> ActorId
$csucc :: ActorId -> ActorId
Enum, Get ActorId
[ActorId] -> Put
ActorId -> Put
(ActorId -> Put)
-> Get ActorId -> ([ActorId] -> Put) -> Binary ActorId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ActorId] -> Put
$cputList :: [ActorId] -> Put
get :: Get ActorId
$cget :: Get ActorId
put :: ActorId -> Put
$cput :: ActorId -> Put
Binary)

-- | Item container type.
data Container =
    CFloor LevelId Point
  | CEmbed LevelId Point
  | CActor ActorId CStore
  | CTrunk FactionId LevelId Point   -- ^ for bootstrapping actor bodies
  deriving (Int -> Container -> ShowS
[Container] -> ShowS
Container -> String
(Int -> Container -> ShowS)
-> (Container -> String)
-> ([Container] -> ShowS)
-> Show Container
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Container] -> ShowS
$cshowList :: [Container] -> ShowS
show :: Container -> String
$cshow :: Container -> String
showsPrec :: Int -> Container -> ShowS
$cshowsPrec :: Int -> Container -> ShowS
Show, Container -> Container -> Bool
(Container -> Container -> Bool)
-> (Container -> Container -> Bool) -> Eq Container
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Container -> Container -> Bool
$c/= :: Container -> Container -> Bool
== :: Container -> Container -> Bool
$c== :: Container -> Container -> Bool
Eq, Eq Container
Eq Container
-> (Container -> Container -> Ordering)
-> (Container -> Container -> Bool)
-> (Container -> Container -> Bool)
-> (Container -> Container -> Bool)
-> (Container -> Container -> Bool)
-> (Container -> Container -> Container)
-> (Container -> Container -> Container)
-> Ord Container
Container -> Container -> Bool
Container -> Container -> Ordering
Container -> Container -> Container
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 :: Container -> Container -> Container
$cmin :: Container -> Container -> Container
max :: Container -> Container -> Container
$cmax :: Container -> Container -> Container
>= :: Container -> Container -> Bool
$c>= :: Container -> Container -> Bool
> :: Container -> Container -> Bool
$c> :: Container -> Container -> Bool
<= :: Container -> Container -> Bool
$c<= :: Container -> Container -> Bool
< :: Container -> Container -> Bool
$c< :: Container -> Container -> Bool
compare :: Container -> Container -> Ordering
$ccompare :: Container -> Container -> Ordering
$cp1Ord :: Eq Container
Ord, (forall x. Container -> Rep Container x)
-> (forall x. Rep Container x -> Container) -> Generic Container
forall x. Rep Container x -> Container
forall x. Container -> Rep Container x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Container x -> Container
$cfrom :: forall x. Container -> Rep Container x
Generic)

instance Binary Container