module Game.LambdaHack.Common.Misc
(
FactionId, LevelId, AbsDepth(..), ActorId
, Container(..), CStore(..), ItemDialogMode(..)
, normalLevelBound, divUp, GroupName, toGroupName, Freqs, breturn
, serverSaveName, Rarity, validateRarity, Tactic(..)
, isRight
) where
import Control.DeepSeq
import Control.Monad
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Function
import Data.Functor
import Data.Hashable
import qualified Data.HashMap.Strict as HM
import Data.Key
import Data.List
import Data.Ord
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Traversable (traverse)
import GHC.Generics (Generic)
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Common.Point
serverSaveName :: String
serverSaveName = "server.sav"
normalLevelBound :: (Int, Int)
normalLevelBound = (79, 20)
infixl 7 `divUp`
divUp :: Integral a => a -> a -> a
divUp n k = (n + k 1) `div` k
newtype GroupName a = GroupName Text
deriving (Eq, Ord, Read, Hashable, Binary, Generic)
instance IsString (GroupName a) where
fromString = GroupName . T.pack
instance Show (GroupName a) where
show (GroupName gn) = T.unpack gn
instance NFData (GroupName a)
toGroupName :: Text -> GroupName a
toGroupName = GroupName
type Freqs a = [(GroupName a, Int)]
type Rarity = [(Double, Int)]
validateRarity :: Rarity -> [Text]
validateRarity rarity =
let sortedRarity = sortBy (comparing fst) rarity
in [ "rarity not sorted" | sortedRarity /= rarity ]
++ [ "rarity depth thresholds not unique"
| nubBy ((==) `on` fst) sortedRarity /= sortedRarity ]
++ [ "rarity depth not between 0 and 10"
| case (sortedRarity, reverse sortedRarity) of
((lowest, _) : _, (highest, _) : _) ->
lowest <= 0 || highest > 10
_ -> False ]
breturn :: MonadPlus m => Bool -> a -> m a
breturn True a = return a
breturn False _ = mzero
data Container =
CFloor !LevelId !Point
| CEmbed !LevelId !Point
| CActor !ActorId !CStore
| CTrunk !FactionId !LevelId !Point
deriving (Show, Eq, Ord, Generic)
instance Binary Container
data CStore =
CGround
| COrgan
| CEqp
| CInv
| CSha
deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
instance Binary CStore
instance Hashable CStore
instance NFData CStore
data ItemDialogMode = MStore CStore | MOwned | MStats
deriving (Show, Read, Eq, Ord, Generic)
instance NFData ItemDialogMode
newtype FactionId = FactionId Int
deriving (Show, Eq, Ord, Enum, Binary)
newtype LevelId = LevelId Int
deriving (Show, Eq, Ord, Enum, Hashable, Binary)
newtype AbsDepth = AbsDepth Int
deriving (Show, Eq, Ord, Hashable, Binary)
newtype ActorId = ActorId Int
deriving (Show, Eq, Ord, Enum, Binary)
data Tactic =
TBlock
| TFollow
| TExplore
| TRoam
| TPatrol
deriving (Eq, Ord, Enum, Bounded, Generic)
instance Show Tactic where
show TBlock = "block and wait"
show TFollow = "follow leader's target or position"
show TExplore = "explore unknown, chase targets"
show TRoam = "roam freely, chase targets"
show TPatrol = "find and patrol an area (TODO)"
instance Binary Tactic
instance Hashable Tactic
isRight :: Either a b -> Bool
isRight e = case e of
Right{} -> True
Left{} -> False
instance (Enum k, Binary k, Binary e) => Binary (EM.EnumMap k e) where
put m = put (EM.size m) >> mapM_ put (EM.toAscList m)
get = liftM EM.fromDistinctAscList get
instance (Enum k, Binary k) => Binary (ES.EnumSet k) where
put m = put (ES.size m) >> mapM_ put (ES.toAscList m)
get = liftM ES.fromDistinctAscList get
instance (Binary k, Binary v, Eq k, Hashable k) => Binary (HM.HashMap k v) where
put ir = put $ HM.toList ir
get = fmap HM.fromList get
type instance Key (EM.EnumMap k) = k
instance Zip (EM.EnumMap k) where
zipWith = EM.intersectionWith
instance Enum k => ZipWithKey (EM.EnumMap k) where
zipWithKey = EM.intersectionWithKey
instance Enum k => Keyed (EM.EnumMap k) where
mapWithKey = EM.mapWithKey
instance Enum k => FoldableWithKey (EM.EnumMap k) where
foldrWithKey = EM.foldrWithKey
instance Enum k => TraversableWithKey (EM.EnumMap k) where
traverseWithKey f = fmap EM.fromDistinctAscList
. traverse (\(k, v) -> (,) k <$> f k v) . EM.toAscList
instance Enum k => Indexable (EM.EnumMap k) where
index = (EM.!)
instance Enum k => Lookup (EM.EnumMap k) where
lookup = EM.lookup
instance Enum k => Adjustable (EM.EnumMap k) where
adjust = EM.adjust
instance (Enum k, Hashable k, Hashable e) => Hashable (EM.EnumMap k e) where
hashWithSalt s x = hashWithSalt s (EM.toAscList x)
instance NFData MU.Part
instance NFData MU.Person
instance NFData MU.Polarity