module Game.LambdaHack.Common.Effect
( Effect(..), effectTrav, effectToSuffix
) where
import qualified Control.Monad.State as St
import Data.Binary
import qualified Data.Hashable as Hashable
import Data.Text (Text)
import GHC.Generics (Generic)
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Random
import Control.Exception.Assert.Sugar
data Effect a =
NoEffect
| Heal !Int
| Hurt !RollDice !a
| Mindprobe !Int
| Dominate
| CallFriend !Int
| Summon !Int
| CreateItem !Int
| ApplyPerfume
| Regeneration !a
| Searching !a
| Ascend !Int
| Escape
deriving (Show, Read, Eq, Ord, Generic, Functor)
instance Hashable.Hashable a => Hashable.Hashable (Effect a)
instance Binary a => Binary (Effect a)
effectTrav :: Effect a -> (a -> St.State s b) -> St.State s (Effect b)
effectTrav NoEffect _ = return NoEffect
effectTrav (Heal p) _ = return $ Heal p
effectTrav (Hurt dice a) f = do
b <- f a
return $ Hurt dice b
effectTrav (Mindprobe x) _ = return $ Mindprobe x
effectTrav Dominate _ = return Dominate
effectTrav (CallFriend p) _ = return $ CallFriend p
effectTrav (Summon p) _ = return $ Summon p
effectTrav (CreateItem p) _ = return $ CreateItem p
effectTrav ApplyPerfume _ = return ApplyPerfume
effectTrav (Regeneration a) f = do
b <- f a
return $ Regeneration b
effectTrav (Searching a) f = do
b <- f a
return $ Searching b
effectTrav (Ascend p) _ = return $ Ascend p
effectTrav Escape _ = return Escape
effectToSuff :: Show a => Effect a -> (a -> Text) -> Text
effectToSuff effect f =
case St.evalState (effectTrav effect $ return . f) () of
NoEffect -> ""
Heal p | p > 0 -> "of healing" <> affixBonus p
Heal 0 -> "of bloodletting"
Heal p -> "of wounding" <> affixBonus p
Hurt dice t -> "(" <> showT dice <> ")" <> t
Mindprobe{} -> "of soul searching"
Dominate -> "of domination"
CallFriend p -> "of aid calling" <> affixPower p
Summon p -> "of summoning" <> affixPower p
CreateItem p -> "of item creation" <> affixPower p
ApplyPerfume -> "of rose water"
Regeneration t -> "of regeneration" <> t
Searching t -> "of searching" <> t
Ascend p | p > 0 -> "of ascending" <> affixPower p
Ascend p | p < 0 -> "of descending" <> affixPower ( p)
Ascend{} -> assert `failure` effect
Escape -> "of escaping"
effectToSuffix :: Effect Int -> Text
effectToSuffix effect = effectToSuff effect affixBonus
affixPower :: Int -> Text
affixPower p = case compare p 1 of
EQ -> ""
LT -> assert `failure` "power less than 1" `twith` p
GT -> " (+" <> showT p <> ")"
affixBonus :: Int -> Text
affixBonus p = case compare p 0 of
EQ -> ""
LT -> " (" <> showT p <> ")"
GT -> " (+" <> showT p <> ")"