module Game.LambdaHack.Client.HumanCmd
( HumanCmd(..), Trigger(..)
, majorHumanCmd, minorHumanCmd, noRemoteHumanCmd, cmdDescription
) where
import Data.Binary
import Data.Text (Text)
import GHC.Generics (Generic)
import qualified NLP.Miniutter.English as MU
import Control.Exception.Assert.Sugar
import qualified Game.LambdaHack.Common.Feature as F
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.VectorXY
data HumanCmd =
Move !VectorXY
| Run !VectorXY
| Wait
| Pickup
| Drop
| Project ![Trigger]
| Apply ![Trigger]
| AlterDir ![Trigger]
| TriggerTile ![Trigger]
| GameRestart !Text
| GameExit
| GameSave
| SelectHero !Int
| MemberCycle
| MemberBack
| Inventory
| TgtFloor
| TgtEnemy
| TgtAscend !Int
| EpsIncr !Bool
| Cancel
| Accept
| Clear
| History
| MarkVision
| MarkSmell
| MarkSuspect
| Help
deriving (Show, Read, Eq, Ord, Generic)
instance Binary HumanCmd
data Trigger =
ApplyItem {verb :: !MU.Part, object :: !MU.Part, symbol :: !Char}
| AlterFeature {verb :: !MU.Part, object :: !MU.Part, feature :: !F.Feature}
| TriggerFeature {verb :: !MU.Part, object :: !MU.Part, feature :: !F.Feature}
deriving (Show, Read, Eq, Ord, Generic)
instance Binary Trigger
majorHumanCmd :: HumanCmd -> Bool
majorHumanCmd cmd = case cmd of
Pickup -> True
Drop -> True
Project{} -> True
Apply{} -> True
AlterDir{} -> True
TriggerTile{} -> True
Inventory -> True
Help -> True
_ -> False
minorHumanCmd :: HumanCmd -> Bool
minorHumanCmd cmd = case cmd of
MemberCycle -> True
MemberBack -> True
TgtFloor -> True
TgtEnemy -> True
TgtAscend{} -> True
EpsIncr{} -> True
Cancel -> True
Accept -> True
History -> True
MarkVision -> True
MarkSmell -> True
MarkSuspect -> True
_ -> False
noRemoteHumanCmd :: HumanCmd -> Bool
noRemoteHumanCmd cmd = case cmd of
Wait -> True
Pickup -> True
Drop -> True
Project{} -> True
Apply{} -> True
AlterDir{} -> True
TriggerTile{} -> True
_ -> False
cmdDescription :: HumanCmd -> Text
cmdDescription cmd = case cmd of
Move{} -> "move"
Run{} -> "run"
Wait -> "wait"
Pickup -> "get an object"
Drop -> "drop an object"
Project ts -> triggerDescription ts
Apply ts -> triggerDescription ts
AlterDir ts -> triggerDescription ts
TriggerTile ts -> triggerDescription ts
GameRestart t -> "new" <+> t <+> "game"
GameExit -> "save and exit"
GameSave -> "save game"
SelectHero{} -> "select hero"
MemberCycle -> "cycle among heroes on the level"
MemberBack -> "cycle among heroes in the dungeon"
Inventory -> "display inventory"
TgtFloor -> "target position"
TgtEnemy -> "target monster"
TgtAscend k | k == 1 -> "target next shallower level"
TgtAscend k | k >= 2 -> "target" <+> showT k <+> "levels shallower"
TgtAscend k | k == 1 -> "target next deeper level"
TgtAscend k | k <= 2 -> "target" <+> showT (k) <+> "levels deeper"
TgtAscend _ ->
assert `failure` "void level change when targeting" `twith` cmd
EpsIncr True -> "swerve targeting line"
EpsIncr False -> "unswerve targeting line"
Cancel -> "cancel action"
Accept -> "accept choice"
Clear -> "clear messages"
History -> "display previous messages"
MarkVision -> "mark visible area"
MarkSmell -> "mark smell"
MarkSuspect -> "mark suspect terrain"
Help -> "display help"
triggerDescription :: [Trigger] -> Text
triggerDescription [] = "trigger a thing"
triggerDescription (t : _) = makePhrase [verb t, MU.AW $ object t]