module Game.LambdaHack.Client.UI.DisplayAtomicM
( displayRespUpdAtomicUI, displayRespSfxAtomicUI
#ifdef EXPOSE_INTERNAL
, updateItemSlot, markDisplayNeeded, updateItemSlotSide, lookAtMove
, actorVerbMU, aidVerbMU, itemVerbMU, itemAidVerbMU, msgDuplicateScrap
, createActorUI, destroyActorUI, spotItem, moveActor, displaceActorUI
, moveItemUI, quitFactionUI, discover, ppSfxMsg, setLastSlot, strike
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Key (mapWithKeyM_)
import qualified Data.Map.Strict as M
import Data.Tuple
import GHC.Exts (inline)
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.ActorUI
import Game.LambdaHack.Client.UI.Animation
import Game.LambdaHack.Client.UI.FrameM
import Game.LambdaHack.Client.UI.HandleHelperM
import Game.LambdaHack.Client.UI.ItemDescription
import Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.MsgM
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Client.UI.Slideshow
import Game.LambdaHack.Client.UI.SlideshowM
import Game.LambdaHack.Client.UI.UIOptions
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import qualified Game.LambdaHack.Common.Color as Color
import qualified Game.LambdaHack.Common.Dice as Dice
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Flavour
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.ReqFailure
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Content.TileKind as TK
displayRespUpdAtomicUI :: MonadClientUI m => Bool -> UpdAtomic -> m ()
{-# INLINE displayRespUpdAtomicUI #-}
displayRespUpdAtomicUI verbose cmd = case cmd of
UpdCreateActor aid body _ -> createActorUI True aid body
UpdDestroyActor aid body _ -> destroyActorUI True aid body
UpdCreateItem iid _ kit c -> do
case c of
CActor aid store -> do
slastSlot <- updateItemSlotSide store aid iid
case store of
COrgan -> do
bag <- getsState $ getContainerBag c
let more = case EM.lookup iid bag of
Nothing -> False
Just kit2 -> fst kit2 /= fst kit
verb = MU.Text $
"become" <+> case fst kit of
1 -> if more then "more" else ""
k -> if more then "additionally" else ""
<+> tshow k <> "-fold"
itemAidVerbMU aid verb iid (Left Nothing) COrgan
_ -> do
ownerFun <- partActorLeaderFun
let wown = ppContainerWownW ownerFun True c
itemVerbMU iid kit (MU.Text $ makePhrase $ "appear" : wown) c
mleader <- getsClient sleader
when (Just aid == mleader) $
modifySession $ \sess -> sess {slastSlot}
CEmbed lid _ -> markDisplayNeeded lid
CFloor lid _ -> do
void $ updateItemSlot CGround Nothing iid
itemVerbMU iid kit (MU.Text $ "appear" <+> ppContainer c) c
markDisplayNeeded lid
CTrunk{} -> error $ "" `showFailure` c
stopPlayBack
UpdDestroyItem iid _ kit c -> do
itemVerbMU iid kit "disappear" c
lid <- getsState $ lidFromC c
markDisplayNeeded lid
UpdSpotActor aid body _ -> createActorUI False aid body
UpdLoseActor aid body _ -> destroyActorUI False aid body
UpdSpotItem verbose2 iid _ kit c -> spotItem verbose2 iid kit c
UpdLoseItem{} -> return ()
UpdSpotItemBag c bag _ ->
mapWithKeyM_ (\iid kit -> spotItem True iid kit c) bag
UpdLoseItemBag{} -> return ()
UpdMoveActor aid source target -> moveActor aid source target
UpdWaitActor aid _ -> when verbose $ aidVerbMU aid "wait"
UpdDisplaceActor source target -> displaceActorUI source target
UpdMoveItem iid k aid c1 c2 -> moveItemUI iid k aid c1 c2
UpdRefillHP _ 0 -> return ()
UpdRefillHP aid n -> do
when verbose $
aidVerbMU aid $ MU.Text $ (if n > 0 then "heal" else "lose")
<+> tshow (abs n `divUp` oneM) <> "HP"
b <- getsState $ getActorBody aid
bUI <- getsSession $ getActorUI aid
arena <- getArenaUI
side <- getsClient sside
if | bproj b && (length (beqp b) == 0 || isNothing (btrajectory b)) ->
return ()
| bhp b <= 0 && n < 0
&& (bfid b == side && not (bproj b) || arena == blid b) -> do
let (firstFall, hurtExtra) = case (bfid b == side, bproj b) of
(True, True) -> ("drop down", "tumble down")
(True, False) -> ("fall down", "fall to pieces")
(False, True) -> ("plummet", "crash")
(False, False) -> ("collapse", "be reduced to a bloody pulp")
verbDie = if alreadyDeadBefore then hurtExtra else firstFall
alreadyDeadBefore = bhp b - n <= 0
subject <- partActorLeader aid bUI
let msgDie = makeSentence [MU.SubjectVerbSg subject verbDie]
msgAdd msgDie
let deathAct | alreadyDeadBefore =
twirlSplash (bpos b, bpos b) Color.Red Color.Red
| bfid b == side = deathBody (bpos b)
| otherwise = shortDeathBody (bpos b)
unless (bproj b) $ animate (blid b) deathAct
| otherwise -> do
when (n >= bhp b && bhp b > 0) $
actorVerbMU aid bUI "return from the brink of death"
mleader <- getsClient sleader
when (Just aid == mleader) $ do
ar <- getsState $ getActorAspect aid
when (bhp b >= xM (aMaxHP ar) && bhp b - n < xM (aMaxHP ar)) $ do
actorVerbMU aid bUI "recover your health fully"
stopPlayBack
UpdRefillCalm aid calmDelta ->
when (calmDelta == minusM) $ do
side <- getsClient sside
fact <- getsState $ (EM.! side) . sfactionD
body <- getsState $ getActorBody aid
when (bfid body == side) $ do
let closeFoe b =
blid b == blid body
&& chessDist (bpos b) (bpos body) <= 3
&& not (waitedLastTurn b)
&& inline isAtWar fact (bfid b)
anyCloseFoes <- getsState $ any closeFoe . EM.elems . sactorD
unless anyCloseFoes $ do
aidVerbMU aid "hear something"
duplicated <- msgDuplicateScrap
unless duplicated stopPlayBack
UpdTrajectory{} -> return ()
UpdQuitFaction fid _ toSt -> quitFactionUI fid toSt
UpdLeadFaction fid (Just source) (Just target) -> do
fact <- getsState $ (EM.! fid) . sfactionD
lidV <- viewedLevelUI
when (isAIFact fact) $ markDisplayNeeded lidV
when (noRunWithMulti fact) stopPlayBack
actorD <- getsState sactorD
case EM.lookup source actorD of
Just sb | bhp sb <= 0 -> assert (not $ bproj sb) $ do
sbUI <- getsSession $ getActorUI source
tbUI <- getsSession $ getActorUI target
let subject = partActor tbUI
object = partActor sbUI
msgAdd $ makeSentence [ MU.SubjectVerbSg subject "take command"
, "from", object ]
_ -> return ()
lookAtMove target
UpdLeadFaction _ Nothing (Just target) -> lookAtMove target
UpdLeadFaction{} -> return ()
UpdDiplFaction fid1 fid2 _ toDipl -> do
name1 <- getsState $ gname . (EM.! fid1) . sfactionD
name2 <- getsState $ gname . (EM.! fid2) . sfactionD
let showDipl Unknown = "unknown to each other"
showDipl Neutral = "in neutral diplomatic relations"
showDipl Alliance = "allied"
showDipl War = "at war"
msgAdd $ name1 <+> "and" <+> name2 <+> "are now" <+> showDipl toDipl <> "."
UpdTacticFaction{} -> return ()
UpdAutoFaction fid b -> do
side <- getsClient sside
lidV <- viewedLevelUI
markDisplayNeeded lidV
when (fid == side) $ setFrontAutoYes b
UpdRecordKill{} -> return ()
UpdAlterTile lid p fromTile toTile -> do
markDisplayNeeded lid
Kind.COps{cotile=Kind.Ops{okind}} <- getsState scops
let feats = TK.tfeature $ okind fromTile
toAlter feat =
case feat of
TK.OpenTo tgroup -> Just tgroup
TK.CloseTo tgroup -> Just tgroup
TK.ChangeTo tgroup -> Just tgroup
_ -> Nothing
groupsToAlterTo = mapMaybe toAlter feats
freq = map fst $ filter (\(_, q) -> q > 0) $ TK.tfreq $ okind toTile
when (null $ intersect freq groupsToAlterTo) $ do
let subject = ""
verb = "turn into"
msg = makeSentence [ "the", MU.Text $ TK.tname $ okind fromTile
, "at position", MU.Text $ tshow p
, "suddenly"
, MU.SubjectVerbSg subject verb
, MU.AW $ MU.Text $ TK.tname $ okind toTile ]
msgAdd msg
UpdAlterExplorable{} -> return ()
UpdSearchTile aid _p toTile -> do
Kind.COps{cotile = cotile@Kind.Ops{okind}} <- getsState scops
subject <- partAidLeader aid
let fromTile = fromJust $ Tile.hideAs cotile toTile
subject2 = MU.Text $ TK.tname $ okind fromTile
object = MU.Text $ TK.tname $ okind toTile
let msg = makeSentence [ MU.SubjectVerbSg subject "reveal"
, "that the"
, MU.SubjectVerbSg subject2 "be"
, MU.AW object ]
unless (subject2 == object) $ msgAdd msg
UpdHideTile{} -> return ()
UpdSpotTile{} -> return ()
UpdLoseTile{} -> return ()
UpdAlterSmell{} -> return ()
UpdSpotSmell{} -> return ()
UpdLoseSmell{} -> return ()
UpdTimeItem{} -> return ()
UpdAgeGame{} -> do
sdisplayNeeded <- getsSession sdisplayNeeded
when sdisplayNeeded pushFrame
UpdUnAgeGame{} -> return ()
UpdDiscover c iid _ _ -> discover c iid
UpdCover{} -> return ()
UpdDiscoverKind{} -> return ()
UpdCoverKind{} -> return ()
UpdDiscoverSeed{} -> return ()
UpdCoverSeed{} -> return ()
UpdDiscoverServer{} -> error "server command leaked to client"
UpdCoverServer{} -> error "server command leaked to client"
UpdPerception{} -> return ()
UpdRestart fid _ _ _ _ -> do
sstart <- getsSession sstart
when (sstart == 0) resetSessionStart
history <- getsSession shistory
when (lengthHistory history == 0) $ do
Kind.COps{corule} <- getsState scops
let title = rtitle $ Kind.stdRuleset corule
msgAdd $ "Welcome to" <+> title <> "!"
sUIOptions <- getsSession sUIOptions
shistory <- defaultHistory $ uHistoryMax sUIOptions
modifySession $ \sess -> sess {shistory}
lid <- getArenaUI
lvl <- getLevel lid
mode <- getGameMode
curChal <- getsClient scurChal
fact <- getsState $ (EM.! fid) . sfactionD
let loneMode = case ginitial fact of
[] -> True
[(_, 1, _)] -> True
_ -> False
msgAdd $ "New game started in" <+> mname mode <+> "mode."
<+> mdesc mode <+> ldesc lvl
<+> if cwolf curChal && not loneMode
then "Being a lone wolf, you start without companions."
else ""
when (lengthHistory history > 1) $ fadeOutOrIn False
setFrontAutoYes $ isAIFact fact
when (isAIFact fact) $ do
slides <- reportToSlideshow []
void $ getConfirms ColorFull [K.spaceKM, K.escKM] slides
UpdRestartServer{} -> return ()
UpdResume fid _ -> do
resetSessionStart
fact <- getsState $ (EM.! fid) . sfactionD
setFrontAutoYes $ isAIFact fact
unless (isAIFact fact) $ do
lid <- getArenaUI
lvl <- getLevel lid
mode <- getGameMode
promptAdd $ "Continuing" <+> mname mode <> "."
<+> mdesc mode <+> ldesc lvl
<+> "Are you up for the challenge?"
slides <- reportToSlideshow [K.spaceKM, K.escKM]
km <- getConfirms ColorFull [K.spaceKM, K.escKM] slides
if km == K.escKM then addPressedEsc else promptAdd "Prove yourself!"
UpdResumeServer{} -> return ()
UpdKillExit{} -> frontendShutdown
UpdWriteSave -> when verbose $ promptAdd "Saving backup."
updateItemSlot :: MonadClientUI m
=> CStore -> Maybe ActorId -> ItemId -> m SlotChar
updateItemSlot store maid iid = do
slots@(ItemSlots itemSlots organSlots) <- getsSession sslots
let onlyOrgans = store == COrgan
lSlots = if onlyOrgans then organSlots else itemSlots
incrementPrefix m l iid2 = EM.insert l iid2 $
case EM.lookup l m of
Nothing -> m
Just iidOld ->
let lNew = SlotChar (slotPrefix l + 1) (slotChar l)
in incrementPrefix m lNew iidOld
case lookup iid $ map swap $ EM.assocs lSlots of
Nothing -> do
side <- getsClient sside
item <- getsState $ getItemBody iid
lastSlot <- getsSession slastSlot
mb <- maybe (return Nothing) (fmap Just . getsState . getActorBody) maid
l <- getsState $ assignSlot store item side mb slots lastSlot
let newSlots | onlyOrgans = ItemSlots
itemSlots
(incrementPrefix organSlots l iid)
| otherwise = ItemSlots
(incrementPrefix itemSlots l iid)
organSlots
modifySession $ \sess -> sess {sslots = newSlots}
return l
Just l -> return l
markDisplayNeeded :: MonadClientUI m => LevelId -> m ()
markDisplayNeeded lid = do
lidV <- viewedLevelUI
when (lidV == lid) $ modifySession $ \sess -> sess {sdisplayNeeded = True}
updateItemSlotSide :: MonadClientUI m
=> CStore -> ActorId -> ItemId -> m SlotChar
updateItemSlotSide store aid iid = do
side <- getsClient sside
b <- getsState $ getActorBody aid
if bfid b == side
then updateItemSlot store (Just aid) iid
else updateItemSlot store Nothing iid
lookAtMove :: MonadClientUI m => ActorId -> m ()
lookAtMove aid = do
body <- getsState $ getActorBody aid
side <- getsClient sside
aimMode <- getsSession saimMode
when (not (bproj body)
&& bfid body == side
&& isNothing aimMode) $ do
lookMsg <- lookAt False "" True (bpos body) aid ""
msgAdd lookMsg
fact <- getsState $ (EM.! bfid body) . sfactionD
adjacentAssocs <- getsState $ actorAdjacentAssocs body
if not (bproj body) && side == bfid body then do
let foe (_, b2) = isAtWar fact (bfid b2)
adjFoes = filter foe adjacentAssocs
unless (null adjFoes) stopPlayBack
else when (isAtWar fact side) $ do
let our (_, b2) = not (bproj b2) && bfid b2 == side
adjOur = filter our adjacentAssocs
unless (null adjOur) stopPlayBack
actorVerbMU :: MonadClientUI m => ActorId -> ActorUI -> MU.Part -> m ()
actorVerbMU aid bUI verb = do
subject <- partActorLeader aid bUI
msgAdd $ makeSentence [MU.SubjectVerbSg subject verb]
aidVerbMU :: MonadClientUI m => ActorId -> MU.Part -> m ()
aidVerbMU aid verb = do
bUI <- getsSession $ getActorUI aid
actorVerbMU aid bUI verb
itemVerbMU :: MonadClientUI m
=> ItemId -> ItemQuant -> MU.Part -> Container -> m ()
itemVerbMU iid kit@(k, _) verb c = assert (k > 0) $ do
lid <- getsState $ lidFromC c
localTime <- getsState $ getLocalTime lid
itemToF <- getsState itemToFull
side <- getsClient sside
factionD <- getsState sfactionD
let subject = partItemWs side factionD
k (storeFromC c) localTime (itemToF iid kit)
msg | k > 1 = makeSentence [MU.SubjectVerb MU.PlEtc MU.Yes subject verb]
| otherwise = makeSentence [MU.SubjectVerbSg subject verb]
msgAdd msg
itemAidVerbMU :: MonadClientUI m
=> ActorId -> MU.Part
-> ItemId -> Either (Maybe Int) Int -> CStore
-> m ()
itemAidVerbMU aid verb iid ek cstore = do
body <- getsState $ getActorBody aid
bag <- getsState $ getBodyStoreBag body cstore
side <- getsClient sside
factionD <- getsState sfactionD
case iid `EM.lookup` bag of
Nothing -> error $ "" `showFailure` (aid, verb, iid, cstore)
Just kit@(k, _) -> do
itemToF <- getsState itemToFull
let lid = blid body
localTime <- getsState $ getLocalTime lid
subject <- partAidLeader aid
let itemFull = itemToF iid kit
object = case ek of
Left (Just n) ->
assert (n <= k `blame` (aid, verb, iid, cstore))
$ partItemWs side factionD n cstore localTime itemFull
Left Nothing ->
let (_, _, name, stats) =
partItem side factionD cstore localTime itemFull
in MU.Phrase [name, stats]
Right n ->
assert (n <= k `blame` (aid, verb, iid, cstore))
$ let (_, _, name1, stats) =
partItemShort side factionD cstore localTime itemFull
name = if n == 1 then name1 else MU.CarWs n name1
in MU.Phrase ["the", name, stats]
msg = makeSentence [MU.SubjectVerbSg subject verb, object]
msgAdd msg
msgDuplicateScrap :: MonadClientUI m => m Bool
msgDuplicateScrap = do
report <- getsSession sreport
history <- getsSession shistory
let (lastMsg, repRest) = lastMsgOfReport report
repLast = lastReportOfHistory history
case incrementInReport (== lastMsg) repRest of
Just repIncr -> do
modifySession $ \sess -> sess {_sreport = repIncr}
return True
Nothing -> case incrementInReport (== lastMsg) repLast of
Just repIncr -> do
let historyIncr = replaceLastReportOfHistory repIncr history
modifySession $ \sess -> sess { _sreport = repRest
, shistory = historyIncr }
return True
Nothing -> return False
createActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
createActorUI born aid body = do
side <- getsClient sside
fact <- getsState $ (EM.! bfid body) . sfactionD
globalTime <- getsState stime
localTime <- getsState $ getLocalTime $ blid body
mbUI <- getsSession $ EM.lookup aid . sactorUI
bUI <- case mbUI of
Just bUI -> return bUI
Nothing -> do
trunk <- getsState $ getItemBody $ btrunk body
UIOptions{uHeroNames} <- getsSession sUIOptions
let isBlast = actorTrunkIsBlast trunk
baseColor = flavourToColor $ jflavour trunk
basePronoun | not (bproj body) && fhasGender (gplayer fact) = "he"
| otherwise = "it"
nameFromNumber fn k = if k == 0
then makePhrase [MU.Ws $ MU.Text fn, "Captain"]
else fn <+> tshow k
heroNamePronoun k =
if gcolor fact /= Color.BrWhite
then (nameFromNumber (fname $ gplayer fact) k, "he")
else fromMaybe (nameFromNumber (fname $ gplayer fact) k, "he")
$ lookup k uHeroNames
(n, bsymbol) <-
if | bproj body -> return (0, if isBlast then jsymbol trunk else '*')
| baseColor /= Color.BrWhite -> return (0, jsymbol trunk)
| otherwise -> do
sactorUI <- getsSession sactorUI
let hasNameK k bUI = bname bUI == fst (heroNamePronoun k)
&& bcolor bUI == gcolor fact
findHeroK k = isJust $ find (hasNameK k) (EM.elems sactorUI)
mhs = map findHeroK [0..]
n = fromJust $ elemIndex False mhs
return (n, if 0 < n && n < 10 then Char.intToDigit n else '@')
factionD <- getsState sfactionD
let (bname, bpronoun) =
if | bproj body ->
let adj | length (btrajectory body) < 5 = "falling"
| otherwise = "flying"
(_, _, object1, object2) =
partItem (bfid body) factionD CInv localTime
(itemNoDisco (trunk, 1))
in ( makePhrase [MU.AW $ MU.Text adj, object1, object2]
, basePronoun )
| baseColor /= Color.BrWhite -> (jname trunk, basePronoun)
| otherwise -> heroNamePronoun n
bcolor | bproj body = if isBlast then baseColor else Color.BrWhite
| baseColor == Color.BrWhite = gcolor fact
| otherwise = baseColor
bUI = ActorUI{..}
modifySession $ \sess ->
sess {sactorUI = EM.insert aid bUI $ sactorUI sess}
return bUI
let verb = MU.Text $
if born
then if globalTime == timeZero
then "be here"
else "appear" <+> if bfid body == side then "" else "suddenly"
else "be spotted"
mapM_ (\(iid, store) -> void $ updateItemSlotSide store aid iid)
(getCarriedIidCStore body)
when (bfid body /= side) $ do
when (not (bproj body) && isAtWar fact side) $
modifySession $ \sess -> sess {sxhair = TEnemy aid False}
stopPlayBack
lastLost <- getsSession slastLost
if ES.member aid lastLost || bproj body then
markDisplayNeeded (blid body)
else do
actorVerbMU aid bUI verb
animate (blid body) $ actorX (bpos body)
destroyActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
destroyActorUI destroy aid b = do
trunk <- getsState $ getItemBody $ btrunk b
let baseColor = flavourToColor $ jflavour trunk
unless (baseColor == Color.BrWhite) $
modifySession $ \sess -> sess {sactorUI = EM.delete aid $ sactorUI sess}
let affect tgt = case tgt of
TEnemy a permit | a == aid ->
if destroy then
TPoint TAny (blid b) (bpos b)
else
TPoint (TEnemyPos a permit) (blid b) (bpos b)
_ -> tgt
modifySession $ \sess -> sess {sxhair = affect $ sxhair sess}
when (isNothing $ btrajectory b) $
modifySession $ \sess -> sess {slastLost = ES.insert aid $ slastLost sess}
side <- getsClient sside
fact <- getsState $ (EM.! side) . sfactionD
let gameOver = isJust $ gquit fact
unless gameOver $ do
when (bfid b == side && not (bproj b)) $ do
stopPlayBack
let upd = ES.delete aid
modifySession $ \sess -> sess {sselected = upd $ sselected sess}
when destroy $ do
displayMore ColorBW "Alas!"
mleader <- getsClient sleader
when (isJust mleader)
clearAimMode
markDisplayNeeded (blid b)
spotItem :: MonadClientUI m
=> Bool -> ItemId -> ItemQuant -> Container -> m ()
spotItem verbose iid kit c = do
ItemSlots itemSlots _ <- getsSession sslots
case lookup iid $ map swap $ EM.assocs itemSlots of
Nothing ->
case c of
CActor aid store ->
void $ updateItemSlotSide store aid iid
CEmbed{} -> return ()
CFloor lid p -> do
void $ updateItemSlot CGround Nothing iid
sxhairOld <- getsSession sxhair
case sxhairOld of
TEnemy{} -> return ()
TPoint TEnemyPos{} _ _ -> return ()
_ -> do
lidV <- viewedLevelUI
when (lid == lidV) $ do
bag <- getsState $ getFloorBag lid p
modifySession $ \sess ->
sess {sxhair = TPoint (TItem bag) lidV p}
itemVerbMU iid kit "be spotted" c
stopPlayBack
CTrunk{} -> return ()
_ -> return ()
when verbose $ case c of
CActor aid store | store `elem` [CEqp, CInv, CGround, CSha] -> do
bUI <- getsSession $ getActorUI aid
subject <- partActorLeader aid bUI
let ownW = ppCStoreWownW False store subject
verb = MU.Text $ makePhrase $ "be added to" : ownW
itemVerbMU iid kit verb c
_ -> return ()
moveActor :: MonadClientUI m => ActorId -> Point -> Point -> m ()
moveActor aid source target = do
body <- getsState $ getActorBody aid
if adjacent source target
then markDisplayNeeded (blid body)
else do
let ps = (source, target)
animate (blid body) $ teleport ps
lookAtMove aid
displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI source target = do
sb <- getsState $ getActorBody source
sbUI <- getsSession $ getActorUI source
tb <- getsState $ getActorBody target
tbUI <- getsSession $ getActorUI target
spart <- partActorLeader source sbUI
tpart <- partActorLeader target tbUI
let msg = makeSentence [MU.SubjectVerbSg spart "displace", tpart]
msgAdd msg
when (bfid sb /= bfid tb) $ do
lookAtMove source
lookAtMove target
let ps = (bpos tb, bpos sb)
animate (blid sb) $ swapPlaces ps
moveItemUI :: MonadClientUI m
=> ItemId -> Int -> ActorId -> CStore -> CStore
-> m ()
moveItemUI iid k aid cstore1 cstore2 = do
let verb = verbCStore cstore2
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
let underAI = isAIFact fact
mleader <- getsClient sleader
ItemSlots itemSlots _ <- getsSession sslots
case lookup iid $ map swap $ EM.assocs itemSlots of
Just slastSlot -> do
when (Just aid == mleader) $ modifySession $ \sess -> sess {slastSlot}
if cstore1 == CGround && Just aid == mleader && not underAI then
itemAidVerbMU aid (MU.Text verb) iid (Right k) cstore2
else when (not (bproj b) && bhp b > 0) $
itemAidVerbMU aid (MU.Text verb) iid (Left $ Just k) cstore2
Nothing -> error $
"" `showFailure` (iid, k, aid, cstore1, cstore2, itemSlots)
quitFactionUI :: MonadClientUI m => FactionId -> Maybe Status -> m ()
quitFactionUI fid toSt = do
Kind.COps{coitem=Kind.Ops{okind, ouniqGroup}} <- getsState scops
fact <- getsState $ (EM.! fid) . sfactionD
let fidName = MU.Text $ gname fact
person = if fhasGender $ gplayer fact then MU.PlEtc else MU.Sg3rd
horror = isHorrorFact fact
side <- getsClient sside
when (side == fid && maybe False ((/= Camping) . stOutcome) toSt) $ do
let won = case toSt of
Just Status{stOutcome=Conquer} -> True
Just Status{stOutcome=Escape} -> True
_ -> False
when won $ do
gameModeId <- getsState sgameModeId
scurChal <- getsClient scurChal
let sing = M.singleton scurChal 1
f = M.unionWith (+)
g = EM.insertWith f gameModeId sing
modifyClient $ \cli -> cli {svictories = g $ svictories cli}
tellGameClipPS
resetGameStart
let msgIfSide _ | fid /= side = Nothing
msgIfSide s = Just s
(startingPart, partingPart) = case toSt of
_ | horror ->
(Nothing, Nothing)
Just Status{stOutcome=Killed} ->
( Just "be eliminated"
, msgIfSide "Let's hope another party can save the day!" )
Just Status{stOutcome=Defeated} ->
( Just "be decisively defeated"
, msgIfSide "Let's hope your new overlords let you live." )
Just Status{stOutcome=Camping} ->
( Just "order save and exit"
, Just $ if fid == side
then "See you soon, stronger and braver!"
else "See you soon, stalwart warrior!" )
Just Status{stOutcome=Conquer} ->
( Just "vanquish all foes"
, msgIfSide "Can it be done in a better style, though?" )
Just Status{stOutcome=Escape} ->
( Just "achieve victory"
, msgIfSide "Can it be done better, though?" )
Just Status{stOutcome=Restart, stNewGame=Just gn} ->
( Just $ MU.Text $ "order mission restart in" <+> tshow gn <+> "mode"
, Just $ if fid == side
then "This time for real."
else "Somebody couldn't stand the heat." )
Just Status{stOutcome=Restart, stNewGame=Nothing} ->
error $ "" `showFailure` (fid, toSt)
Nothing -> (Nothing, Nothing)
case startingPart of
Nothing -> return ()
Just sp -> msgAdd $ makeSentence [MU.SubjectVerb person MU.Yes fidName sp]
case (toSt, partingPart) of
(Just status, Just pp) -> do
isNoConfirms <- isNoConfirmsGame
go <- if isNoConfirms && fmap stOutcome toSt /= Just Camping
then return False
else displaySpaceEsc ColorFull ""
when (side == fid) recordHistory
when go $ do
lidV <- viewedLevelUI
Level{lxsize, lysize} <- getLevel lidV
let store = CGround
currencyName = MU.Text $ IK.iname $ okind $ ouniqGroup "currency"
arena <- getArenaUI
(bag, itemSlides, total) <- do
(bag, tot) <- getsState $ calculateTotal side
if EM.null bag then return (EM.empty, emptySlideshow, 0)
else do
let spoilsMsg = makeSentence [ "Your spoils are worth"
, MU.CarWs tot currencyName ]
promptAdd spoilsMsg
io <- itemOverlay store arena bag
sli <- overlayToSlideshow (lysize + 1) [K.spaceKM, K.escKM] io
return (bag, sli, tot)
localTime <- getsState $ getLocalTime arena
itemToF <- getsState itemToFull
ItemSlots lSlots _ <- getsSession sslots
let keyOfEKM (Left km) = km
keyOfEKM (Right SlotChar{slotChar}) = [K.mkChar slotChar]
allOKX = concatMap snd $ slideshow itemSlides
keys = [K.spaceKM, K.escKM] ++ concatMap (keyOfEKM . fst) allOKX
examItem slot =
case EM.lookup slot lSlots of
Nothing -> error $ "" `showFailure` slot
Just iid -> case EM.lookup iid bag of
Nothing -> error $ "" `showFailure` iid
Just kit@(k, _) -> do
factionD <- getsState sfactionD
let itemFull = itemToF iid kit
attrLine = itemDesc side factionD 0
store localTime itemFull
ov = splitAttrLine lxsize attrLine
worth = itemPrice (itemBase itemFull, 1)
lootMsg = makeSentence $
["This particular loot is worth"]
++ (if k > 1 then [ MU.Cardinal k, "times"] else [])
++ [MU.CarWs worth currencyName]
promptAdd lootMsg
slides <- overlayToSlideshow (lysize + 1)
[K.spaceKM, K.escKM]
(ov, [])
km <- getConfirms ColorFull [K.spaceKM, K.escKM] slides
return $! km == K.spaceKM
viewItems pointer =
if itemSlides == emptySlideshow then return True
else do
(ekm, pointer2) <- displayChoiceScreen ColorFull False pointer
itemSlides keys
case ekm of
Left km | km == K.spaceKM -> return True
Left km | km == K.escKM -> return False
Left _ -> error $ "" `showFailure` ekm
Right slot -> do
go2 <- examItem slot
if go2 then viewItems pointer2 else return True
go3 <- viewItems 2
when go3 $ do
unless isNoConfirms $ do
scoreSlides <- scoreToSlideshow total status
void $ getConfirms ColorFull [K.spaceKM, K.escKM] scoreSlides
promptAdd pp
partingSlide <- reportToSlideshow [K.spaceKM, K.escKM]
void $ getConfirms ColorFull [K.spaceKM, K.escKM] partingSlide
unless (fmap stOutcome toSt == Just Camping) $
fadeOutOrIn True
_ -> return ()
discover :: MonadClientUI m => Container -> ItemId -> m ()
discover c iid = do
let cstore = storeFromC c
lid <- getsState $ lidFromC c
globalTime <- getsState stime
localTime <- getsState $ getLocalTime lid
itemToF <- getsState itemToFull
bag <- getsState $ getContainerBag c
side <- getsClient sside
factionD <- getsState sfactionD
(isOurOrgan, nameWhere) <- case c of
CActor aidOwner storeOwner -> do
bOwner <- getsState $ getActorBody aidOwner
bOwnerUI <- getsSession $ getActorUI aidOwner
let name = if bproj bOwner || bfid bOwner == side
then []
else ppCStoreWownW True storeOwner (partActor bOwnerUI)
return (bfid bOwner == side && storeOwner == COrgan, name)
_ -> return (False, [])
let kit = EM.findWithDefault (1, []) iid bag
itemFull = itemToF iid kit
knownName = partItemMediumAW side factionD cstore localTime itemFull
itemSecret = itemNoDisco (itemBase itemFull, itemK itemFull)
(_, _, secretName, secretAEText) =
partItem side factionD cstore localTime itemSecret
namePhrase = MU.Phrase $ [secretName, secretAEText] ++ nameWhere
msg = makeSentence
["the", MU.SubjectVerbSg namePhrase "turn out to be", knownName]
unless (globalTime == timeZero
|| isOurOrgan) $
msgAdd msg
displayRespSfxAtomicUI :: MonadClientUI m => Bool -> SfxAtomic -> m ()
{-# INLINE displayRespSfxAtomicUI #-}
displayRespSfxAtomicUI verbose sfx = case sfx of
SfxStrike source target iid store ->
strike False source target iid store
SfxRecoil source target _ _ -> do
spart <- partAidLeader source
tpart <- partAidLeader target
msgAdd $ makeSentence [MU.SubjectVerbSg spart "shrink away from", tpart]
SfxSteal source target iid store ->
strike True source target iid store
SfxRelease source target _ _ -> do
spart <- partAidLeader source
tpart <- partAidLeader target
msgAdd $ makeSentence [MU.SubjectVerbSg spart "release", tpart]
SfxProject aid iid cstore -> do
setLastSlot aid iid cstore
itemAidVerbMU aid "fling" iid (Left $ Just 1) cstore
SfxReceive aid iid cstore ->
itemAidVerbMU aid "receive" iid (Left $ Just 1) cstore
SfxApply aid iid cstore -> do
setLastSlot aid iid cstore
itemAidVerbMU aid "apply" iid (Left $ Just 1) cstore
SfxCheck aid iid cstore ->
itemAidVerbMU aid "deapply" iid (Left $ Just 1) cstore
SfxTrigger aid _p ->
when verbose $ aidVerbMU aid "trigger"
SfxShun aid _p ->
when verbose $ aidVerbMU aid "shun"
SfxEffect fidSource aid effect hpDelta -> do
b <- getsState $ getActorBody aid
bUI <- getsSession $ getActorUI aid
side <- getsClient sside
let fid = bfid b
isOurCharacter = fid == side && not (bproj b)
isOurAlive = isOurCharacter && bhp b > 0
case effect of
IK.ELabel{} -> return ()
IK.EqpSlot{} -> return ()
IK.Burn{} -> do
if isOurAlive
then actorVerbMU aid bUI "feel burned"
else actorVerbMU aid bUI "look burned"
let ps = (bpos b, bpos b)
animate (blid b) $ twirlSplash ps Color.BrRed Color.Brown
IK.Explode{} -> return ()
IK.RefillHP p | p == 1 -> return ()
IK.RefillHP p | p == -1 -> return ()
IK.RefillHP{} | hpDelta > 0 -> do
if isOurAlive then
actorVerbMU aid bUI "feel healthier"
else
actorVerbMU aid bUI "look healthier"
let ps = (bpos b, bpos b)
animate (blid b) $ twirlSplash ps Color.BrGreen Color.Green
IK.RefillHP{} -> do
if isOurAlive then
actorVerbMU aid bUI "feel wounded"
else
actorVerbMU aid bUI "look wounded"
let ps = (bpos b, bpos b)
animate (blid b) $ twirlSplash ps Color.BrRed Color.Red
IK.RefillCalm p | p == 1 -> return ()
IK.RefillCalm p | p > 0 ->
if isOurAlive then
actorVerbMU aid bUI "feel calmer"
else
actorVerbMU aid bUI "look calmer"
IK.RefillCalm _ ->
if isOurAlive then
actorVerbMU aid bUI "feel agitated"
else
actorVerbMU aid bUI "look agitated"
IK.Dominate -> do
let subject = partActor bUI
if fid /= fidSource then do
if | bcalm b == 0 ->
aidVerbMU aid $ MU.Text "yield, under extreme pressure"
| isOurAlive ->
aidVerbMU aid $ MU.Text "black out, dominated by foes"
| otherwise ->
aidVerbMU aid $ MU.Text "decide abrubtly to switch allegiance"
fidName <- getsState $ gname . (EM.! fid) . sfactionD
let verb = "be no longer controlled by"
msgAdd $ makeSentence
[MU.SubjectVerbSg subject verb, MU.Text fidName]
when isOurAlive $ displayMoreKeep ColorFull ""
else do
fidSourceName <- getsState $ gname . (EM.! fidSource) . sfactionD
let verb = "be now under"
msgAdd $ makeSentence
[MU.SubjectVerbSg subject verb, MU.Text fidSourceName, "control"]
stopPlayBack
IK.Impress -> actorVerbMU aid bUI "be awestruck"
IK.Summon grp p -> do
let verb = if bproj b then "lure" else "summon"
object = (if p == 1
then MU.AW
else MU.Ws) $ MU.Text $ tshow grp
actorVerbMU aid bUI $ MU.Phrase [verb, object]
IK.Ascend True -> do
actorVerbMU aid bUI "find a way upstairs"
(lid, _) <- getsState $ whereTo (blid b) (bpos b) (Just True)
. sdungeon
lvl <- getLevel lid
msgAdd $ ldesc lvl
IK.Ascend False -> do
actorVerbMU aid bUI "find a way downstairs"
(lid, _) <- getsState $ whereTo (blid b) (bpos b) (Just False)
. sdungeon
lvl <- getLevel lid
msgAdd $ ldesc lvl
IK.Escape{} -> return ()
IK.Paralyze{} -> actorVerbMU aid bUI "be paralyzed"
IK.InsertMove{} -> actorVerbMU aid bUI "act with extreme speed"
IK.Teleport t | Dice.maxDice t <= 9 -> actorVerbMU aid bUI "blink"
IK.Teleport{} -> actorVerbMU aid bUI "teleport"
IK.CreateItem{} -> return ()
IK.DropItem _ _ COrgan _ -> return ()
IK.DropItem{} -> actorVerbMU aid bUI "be stripped"
IK.PolyItem -> do
localTime <- getsState $ getLocalTime $ blid b
allAssocs <- getsState $ fullAssocs aid [CGround]
case allAssocs of
[] -> return ()
(_, ItemFull{..}) : _ -> do
subject <- partActorLeader aid bUI
factionD <- getsState sfactionD
let itemSecret = itemNoDisco (itemBase, itemK)
(_, _, secretName, secretAEText) =
partItem side factionD CGround localTime itemSecret
verb = "repurpose"
store = MU.Text $ ppCStoreIn CGround
msgAdd $ makeSentence
[ MU.SubjectVerbSg subject verb
, "the", secretName, secretAEText, store ]
IK.Identify -> do
allAssocs <- getsState $ fullAssocs aid [CGround]
case allAssocs of
[] -> return ()
(_, ItemFull{..}) : _ -> do
subject <- partActorLeader aid bUI
let verb = "inspect"
store = MU.Text $ ppCStoreIn CGround
msgAdd $ makeSentence
[ MU.SubjectVerbSg subject verb
, "an item", store ]
IK.Detect{} -> do
subject <- partActorLeader aid bUI
let verb = "perceive nearby area"
displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
IK.DetectActor{} -> do
subject <- partActorLeader aid bUI
let verb = "detect nearby actors"
displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
IK.DetectItem{} -> do
subject <- partActorLeader aid bUI
let verb = "detect nearby items"
displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
IK.DetectExit{} -> do
subject <- partActorLeader aid bUI
let verb = "detect nearby exits"
displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
IK.DetectHidden{} -> do
subject <- partActorLeader aid bUI
let verb = "detect nearby secrets"
displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
IK.SendFlying{} -> actorVerbMU aid bUI "be sent flying"
IK.PushActor{} -> actorVerbMU aid bUI "be pushed"
IK.PullActor{} -> actorVerbMU aid bUI "be pulled"
IK.DropBestWeapon -> actorVerbMU aid bUI "be disarmed"
IK.ActivateInv{} -> return ()
IK.ApplyPerfume ->
msgAdd "The fragrance quells all scents in the vicinity."
IK.OneOf{} -> return ()
IK.OnSmash{} -> error $ "" `showFailure` sfx
IK.Recharging{} -> error $ "" `showFailure` sfx
IK.Temporary t -> actorVerbMU aid bUI $ MU.Text t
IK.Unique -> error $ "" `showFailure` sfx
IK.Periodic -> error $ "" `showFailure` sfx
IK.Composite{} -> error $ "" `showFailure` sfx
SfxMsgFid _ sfxMsg -> do
mleader <- getsClient sleader
case mleader of
Just{} -> return ()
Nothing -> do
lidV <- viewedLevelUI
markDisplayNeeded lidV
recordHistory
msg <- ppSfxMsg sfxMsg
msgAdd msg
SfxSortSlots -> do
side <- getsClient sside
sortSlots side Nothing
ppSfxMsg :: MonadClientUI m => SfxMsg -> m Text
ppSfxMsg sfxMsg = case sfxMsg of
SfxUnexpected reqFailure -> return $!
"Unexpected problem:" <+> showReqFailure reqFailure <> "."
SfxLoudUpd local cmd -> do
Kind.COps{coTileSpeedup} <- getsState scops
let sound = case cmd of
UpdDestroyActor{} -> "shriek"
UpdCreateItem{} -> "clatter"
UpdTrajectory{} ->
"thud"
UpdAlterTile _ _ fromTile _ ->
if Tile.isDoor coTileSpeedup fromTile
then "creaking sound"
else "rumble"
UpdAlterExplorable _ k -> if k > 0 then "grinding noise"
else "fizzing noise"
_ -> error $ "" `showFailure` cmd
distant = if local then [] else ["distant"]
msg = makeSentence [ "you hear"
, MU.AW $ MU.Phrase $ distant ++ [sound] ]
return $! msg
SfxLoudStrike local ik distance -> do
Kind.COps{coitem=Kind.Ops{okind}} <- getsState scops
let verb = IK.iverbHit $ okind ik
adverb = if | distance < 5 -> "loudly"
| distance < 10 -> "distinctly"
| distance < 40 -> ""
| distance < 45 -> "faintly"
| otherwise -> "barely"
distant = if local then [] else ["far away"]
msg = makeSentence $
[ "you", adverb, "hear something", verb, "someone"] ++ distant
return $! msg
SfxLoudSummon isProj grp p -> do
let verb = if isProj then "something lure" else "somebody summon"
object = if p == 1
then MU.Text $ tshow grp
else MU.Ws $ MU.Text $ tshow grp
return $! makeSentence ["you hear", verb, object]
SfxFizzles -> return "It flashes and fizzles."
SfxNothingHappens -> return "Nothing happens."
SfxVoidDetection -> return "Nothing new detected."
SfxSummonLackCalm aid -> do
msbUI <- getsSession $ EM.lookup aid . sactorUI
case msbUI of
Nothing -> return ""
Just sbUI -> do
let subject = partActor sbUI
verb = "lack Calm to summon"
return $! makeSentence [MU.SubjectVerbSg subject verb]
SfxLevelNoMore -> return "No more levels in this direction."
SfxLevelPushed -> return "You notice somebody pushed to another level."
SfxBracedImmune aid -> do
msbUI <- getsSession $ EM.lookup aid . sactorUI
case msbUI of
Nothing -> return ""
Just sbUI -> do
let subject = partActor sbUI
verb = "be braced and so immune to translocation"
return $! makeSentence [MU.SubjectVerbSg subject verb]
SfxEscapeImpossible -> return "This faction doesn't want to escape outside."
SfxTransImpossible -> return "Translocation not possible."
SfxIdentifyNothing -> return "Nothing to identify."
SfxPurposeNothing store -> return $!
"The purpose of repurpose cannot be availed without an item"
<+> ppCStoreIn store <> "."
SfxPurposeTooFew maxCount itemK -> return $!
"The purpose of repurpose is served by" <+> tshow maxCount
<+> "pieces of this item, not by" <+> tshow itemK <> "."
SfxPurposeUnique -> return "Unique items can't be repurposed."
SfxColdFish -> return "Healing attempt from another faction is thwarted by your cold fish attitude."
SfxTimerExtended aid iid cstore -> do
b <- getsState $ getActorBody aid
bUI <- getsSession $ getActorUI aid
aidPhrase <- partActorLeader aid bUI
factionD <- getsState sfactionD
localTime <- getsState $ getLocalTime (blid b)
itemToF <- getsState itemToFull
let itemFull = itemToF iid (1, [])
(_, _, name, stats) =
partItem (bfid b) factionD cstore localTime itemFull
storeOwn = ppCStoreWownW True cstore aidPhrase
cond = ["condition" | jsymbol (itemBase itemFull) == '+']
return $! makeSentence $
["the", name, stats] ++ cond ++ storeOwn ++ ["will now last longer"]
setLastSlot :: MonadClientUI m => ActorId -> ItemId -> CStore -> m ()
setLastSlot aid iid cstore = do
mleader <- getsClient sleader
when (Just aid == mleader) $ do
ItemSlots itemSlots _ <- getsSession sslots
case lookup iid $ map swap $ EM.assocs itemSlots of
Just slastSlot -> modifySession $ \sess -> sess {slastSlot}
Nothing -> error $ "" `showFailure` (iid, cstore, aid)
strike :: MonadClientUI m
=> Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
strike catch source target iid cstore = assert (source /= target) $ do
tb <- getsState $ getActorBody target
tbUI <- getsSession $ getActorUI target
sourceSeen <- getsState $ memActor source (blid tb)
(ps, hurtMult) <-
if sourceSeen then do
hurtMult <- getsState $ armorHurtBonus source target
itemToF <- getsState itemToFull
sb <- getsState $ getActorBody source
sbUI <- getsSession $ getActorUI source
spart <- partActorLeader source sbUI
tpart <- partActorLeader target tbUI
spronoun <- partPronounLeader source sbUI
localTime <- getsState $ getLocalTime (blid tb)
bag <- getsState $ getBodyStoreBag sb cstore
side <- getsClient sside
factionD <- getsState sfactionD
let kit = EM.findWithDefault (1, []) iid bag
itemFull = itemToF iid kit
verb = case itemDisco itemFull of
_ | catch -> "catch"
Nothing -> "hit"
Just ItemDisco{itemKind} -> IK.iverbHit itemKind
isOrgan = iid `EM.member` borgan sb
partItemChoice =
if isOrgan
then partItemShortWownW side factionD spronoun COrgan localTime
else partItemShortAW side factionD cstore localTime
msg | bhp tb <= 0
|| hurtMult > 90
|| jdamage (itemBase itemFull) == 0 = makeSentence $
[MU.SubjectVerbSg spart verb, tpart]
++ if bproj sb
then []
else ["with", partItemChoice itemFull]
| otherwise =
let sActs = if bproj sb
then [ MU.SubjectVerbSg spart "connect" ]
else [ MU.SubjectVerbSg spart verb, tpart
, "with", partItemChoice itemFull ]
actionPhrase =
MU.SubjectVerbSg tpart
$ if bproj sb
then if braced tb
then "deflect it"
else "fend it off"
else if braced tb
then "block"
else "dodge"
butEvenThough = if catch then ", even though" else ", but"
in makeSentence
[ MU.Phrase sActs <> butEvenThough
, actionPhrase
, if | hurtMult >= 50 ->
"partly"
| hurtMult > 1 ->
if braced tb then "doggedly" else "nonchalantly"
| otherwise ->
"almost completely"
]
msgAdd msg
return ((bpos tb, bpos sb), hurtMult)
else return ((bpos tb, bpos tb), 100)
let anim | hurtMult > 90 = twirlSplash ps Color.BrRed Color.Red
| hurtMult > 1 = blockHit ps Color.BrRed Color.Red
| otherwise = blockMiss ps
animate (blid tb) anim