diff --git a/antisplice.cabal b/antisplice.cabal --- a/antisplice.cabal +++ b/antisplice.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.12.1.0 +version: 0.12.3.0 -- A short (one-line) description of the package. synopsis: An engine for text-based dungeons. @@ -57,7 +57,7 @@ other-extensions: TemplateHaskell, QuasiQuotes, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, UndecidableInstances, RankNTypes, TypeFamilies, FunctionalDependencies -- Other library packages from which modules are imported. - build-depends: base >=4.6 && <4.7, chatty >=0.5.1 && <0.6, text >=0.11 && <0.12, template-haskell >=2.8 && <2.9, mtl >=2.1 && <2.2, transformers >=0.3 && <0.4, haskeline >= 0.7 && < 0.8, time >= 1.4 && < 1.5 + build-depends: base >=4.6 && <4.7, chatty >=0.5.4 && <0.6, text >=0.11 && <0.12, template-haskell >=2.8 && <2.9, mtl >=2.1 && <2.2, transformers >=0.3 && <0.4, haskeline >= 0.7 && < 0.8, time >= 1.4 && < 1.5 -- Directories containing source files. hs-source-dirs: src diff --git a/src/Game/Antisplice/Errors.hs b/src/Game/Antisplice/Errors.hs --- a/src/Game/Antisplice/Errors.hs +++ b/src/Game/Antisplice/Errors.hs @@ -38,6 +38,8 @@ | WhereToEquipError -- ^ "Where?" | CantCastThatNowError -- ^ "Sorry, I can't cast that now. Check you health, mana and cooldowns." | CantWalkThereError -- ^ "I can't walk there." + | CantAcquireThatError -- ^ "I can't take that." + | WontHitThatError -- ^ "I won't hit that." deriving Show -- | Alias for 'FailT' 'SplErr' diff --git a/src/Game/Antisplice/Events.hs b/src/Game/Antisplice/Events.hs --- a/src/Game/Antisplice/Events.hs +++ b/src/Game/Antisplice/Events.hs @@ -24,7 +24,8 @@ -- | Provides setters for the various events module Game.Antisplice.Events ( OnEnter(..), OnFirstEnter(..), OnLook(..), OnAnnounce(..), OnSight(..), OnFirstSight(..), OnAcquire(..), OnFirstAcquire(..), - OnInspection(..), OnFirstInspection(..), OnLookInto(..), OnRead(..), OnRoomEnter(..), OnRoomLeave(..) + OnInspection(..), OnFirstInspection(..), OnLookInto(..), OnRead(..), OnRoomEnter(..), OnRoomLeave(..), OnTakeDamage(..), + OnDie(..) ) where import Game.Antisplice.Monad @@ -82,6 +83,12 @@ objectOnAnnounce :: MonadObject m => Handler -> m () objectOnAnnounce t = modifyObjectState $ \s -> s{objectTriggerOnAnnounceOf=t} +objectOnDie :: MonadObject m => Handler -> m () +objectOnDie t = modifyObjectState $ \s -> s{objectTriggerOnDieOf=t} + +objectOnTakeDamage :: MonadObject m => Handler -> m () +objectOnTakeDamage t = modifyObjectState $ \s -> s{objectTriggerOnTakeDamageOf=t} + -- | Triggered when the user enters a room or object. class OnEnter e where onEnter :: Handler -> e () instance Monad m => OnEnter (RoomT m) where onEnter = roomOnEachEnter @@ -140,3 +147,11 @@ -- | Triggered when the object (e.g. a mob with a route) leaves the room of the user. class OnRoomLeave e where onRoomLeave :: Handler -> e () instance Monad m => OnRoomLeave (ObjectT m) where onRoomLeave = objectOnRoomLeave + +-- | Triggered when the object takes damage. +class OnTakeDamage e where onTakeDamage :: Handler -> e () +instance Monad m => OnTakeDamage (ObjectT m) where onTakeDamage = objectOnTakeDamage + +-- | Triggered when the object dies. +class OnDie e where onDie :: Handler -> e () +instance Monad m => OnDie (ObjectT m) where onDie = objectOnDie diff --git a/src/Game/Antisplice/Monad.hs b/src/Game/Antisplice/Monad.hs --- a/src/Game/Antisplice/Monad.hs +++ b/src/Game/Antisplice/Monad.hs @@ -45,6 +45,7 @@ import Text.Chatty.Channel.Broadcast import Text.Chatty.Extended.HTML import Text.Chatty.Extended.ANSI +import Text.Chatty.Printer --import Language.Haskell.TH import System.IO @@ -57,7 +58,8 @@ mkInteractor ''VocabT mkChatty (mkFail ''SplErr) mkCounter mkDungeon mkRoom mkAtoms mkPlayer (mkChannelPrinter ''PlayerId) mkInteractor ''AtomStoreT mkChatty (mkFail ''SplErr) mkDungeon mkRoom mkVocab mkPlayer (mkChannelPrinter ''PlayerId) mkInteractor ''PlayerFilterT mkArchiver mkVocab mkAtoms mkCounter -liftM concat $ forM [''AnsiPrinterT,''HtmlPrinterT,''ExpanderT,''NullExpanderT] $ mkChannelPrinter ''PlayerId +liftM concat $ forM [''AnsiPrinterT,''HtmlPrinterT,''ExpanderT,''NullExpanderT,''RecorderT] $ \s -> + mkInteractor s (mkChannelPrinter ''PlayerId) mkDungeon mkPlayer mkRoom (mkFail ''SplErr) instance ChannelPrinter PlayerId m => Broadcaster PlayerId (DungeonT m) where bprint c str = do diff --git a/src/Game/Antisplice/Monad/Dungeon.hs b/src/Game/Antisplice/Monad/Dungeon.hs --- a/src/Game/Antisplice/Monad/Dungeon.hs +++ b/src/Game/Antisplice/Monad/Dungeon.hs @@ -321,6 +321,18 @@ instance None SkillParam where none = SkillParam Nothing Nothing Nothing +-- | A quest type +data Quest = Quest { + questTitleOf :: !String, + questDescOf :: !String, + questPreconditionOf :: Prerequisite, + questFinishConditionOf :: Prerequisite, + questTriggerOnFinishOf :: Handler + } + +-- | The player's relation to a quest +data QuestRel = Completed | InProgress | Locked deriving (Ord,Eq) + -- | State type for PlayerT data PlayerState = PlayerState { playerIdOf :: !PlayerId, @@ -333,7 +345,8 @@ playerReputationOf :: AVL (Atom Faction,Int), playerCurrenciesOf :: AVL (CurrencyId,Int), playerCooldownsOf :: AVL CooldownId, - playerOpponentOf :: !ObjectId + playerOpponentOf :: !ObjectId, + playerActiveQuestsOf :: AVL (Atom Quest,QuestRel) } instance Indexable PlayerState PlayerId PlayerState where diff --git a/src/Game/Antisplice/Prototypes.hs b/src/Game/Antisplice/Prototypes.hs --- a/src/Game/Antisplice/Prototypes.hs +++ b/src/Game/Antisplice/Prototypes.hs @@ -48,16 +48,16 @@ ctorRoom t d = do setRoomTitle t addRoomDesc d - onAnnounce $ getRoomTitle >>= eprintLn (Dull Magenta) + onAnnounce $ enomaskLn (Dull Magenta) =<< expand =<< getRoomTitle onLook $ do rs <- getRoomState - eprintLn (Dull Green) =<< expand =<< getRoomDesc + enomaskLn (Dull Green) =<< expand =<< getRoomDesc sequence_ $ avlInorder $ flip fmap (roomObjectsOf rs) $ \os -> objectTriggerOnAnnounceOf os -- | Construct a sign from a text and some attributes. ctorSign :: (MonadAtoms m,MonadVocab m,MonadError SplErr m) => String -> [String] -> ObjectT m () ctorSign t as = do - onRead $ eprintLn (Vivid White) =<< expand t + onRead $ enomaskLn (Vivid White) =<< expand t lookCountA <- newAtom putAtom lookCountA 0 onLook $ do @@ -81,10 +81,20 @@ ctorMob :: MonadVocab m => String -> [String] -> String -> [String] -> ObjectT m () ctorMob t ns d as = do onLook $ mprintLn d - onRoomEnter $ mprintLn $ printf "%s has entered the room." t - onRoomLeave $ mprintLn $ printf "%s has left the room." t - onAnnounce $ eprintLn (Dull Cyan) $ printf " %s is here." t - setObjectIsMob True + onRoomEnter $ mnomaskLn =<< expand (printf "%s has entered the room." t) + onRoomLeave $ mnomaskLn =<< expand (printf "%s has left the room." t) + onAnnounce $ enomaskLn (Dull Cyan) =<< expand (printf " %s is here." t) + onDie $ do + mnomaskLn =<< expand (printf "%s dies." t) + void $ addRoomObject $ do + setObjectTitle $ pack $ printf "corpse of %s" t + setObjectDesc $ pack $ printf "Looks like %s is dead." t + addDescSeg $ printf "The corpse of %s lies here." t + insertVocab "corpse" Noun + insertVocab "dead" Adj + forM_ ("corpse":ns) addObjectName + forM_ ("dead":as) addObjectAttr + forM_ [Damagable, Mobile] addFeature setObjectTitle t setObjectDesc d forM_ ns addObjectName diff --git a/src/Game/Antisplice/Rooms.hs b/src/Game/Antisplice/Rooms.hs --- a/src/Game/Antisplice/Rooms.hs +++ b/src/Game/Antisplice/Rooms.hs @@ -107,7 +107,7 @@ import Control.Monad import Control.Monad.Error import Control.Monad.Trans.Class -import Data.Text (pack) +import Data.Text (pack,unpack) import Data.Maybe import Data.List import Data.Time.Clock @@ -156,7 +156,7 @@ rs0 <- getRoomState roomTriggerOnLeaveOf rs0 s <- getDungeonState - modifyPlayerState $ \p -> p{playerRoomOf=n} + modifyPlayerState $ \p -> p{playerRoomOf=n,playerOpponentOf=FalseObject} let marked = nodeMarked $ getNode' n $ roomsOf s rs <- getRoomState unless marked $ do @@ -327,7 +327,7 @@ s <- getDungeonState i <- liftM PlayerId countOn let r = rootNode $ roomsOf s - (_,a) <- runPlayerT m $ PlayerState i r 100 none none none none none (avlInsert (Health,100) none) none none + (_,a) <- runPlayerT m $ PlayerState i r 100 none none none none none (avlInsert (Health,100) none) none none none putDungeonState s{playersOf=anyBstInsert a $ playersOf s} -- | Move the current player to the given room, but don't trigger anything. @@ -377,9 +377,8 @@ let (n:rs) = objectRouteOf o withRoom n $ insertRoomObject o{objectRouteOf=rs++[n]} guardVisible n $ objectTriggerOnRoomEnterOf o + modifyPlayerState $ \s -> if playerOpponentOf s == i then s{playerOpponentOf=FalseObject} else s return () - [] -> throwError CantSeeOneError - _ -> throwError WhichOneError -- | Only run the given function if the player is inside the also given room. guardVisible :: MonadDungeon m => NodeId -> m () -> m () @@ -397,8 +396,12 @@ rs <- roomOfObject i case rs of [r] -> do - o <- withRoom r $ removeRoomObject i - modifyPlayerState $ \s -> s{playerInventoryOf=avlInsert o $ playerInventoryOf s} + s <- withObject i getObjectState + if isJust $ avlLookup Acquirable $ objectFeaturesOf s + then do + o <- withRoom r $ removeRoomObject i + modifyPlayerState $ \s -> s{playerInventoryOf=avlInsert o $ playerInventoryOf s} + else throwError CantAcquireThatError [] -> throwError CantSeeOneError _ -> throwError WhichOneError @@ -514,28 +517,40 @@ return a -- | Damage a target (no matter whether player or mob) without setting focus -damage :: MonadDungeon m => DamageTarget -> Int -> m () +damage :: DamageTarget -> Int -> ChattyDungeonM () damage (TargetPlayer p) v = withPlayer p $ modifyCurrency Health $ subtract v -damage (TargetObject o) v = withObject o $ modifyObjectState $ \o -> o{objectCurHealthOf=objectCurHealthOf o - v} +damage (TargetObject o) v = do + d <- withObject o $ do + modifyObjectState $ \o -> o{objectCurHealthOf=objectCurHealthOf o - v} + liftM ((<=0).objectCurHealthOf) getObjectState + when d $ do + objectTriggerOnDieOf =<< withObject o getObjectState + s <- getPlayerState + when (playerOpponentOf s == o) $ putPlayerState s{playerOpponentOf=FalseObject} + void $ removeRoomObject o -- | Focus an opponent -focusOpponent :: MonadPlayer m => ObjectId -> m () -focusOpponent o = modifyPlayerState $ \p -> p{playerOpponentOf=o} +focusOpponent :: ObjectId -> ChattyDungeonM () +focusOpponent o = do + os <- withObject o getObjectState + if (isJust $ avlLookup Damagable $ objectFeaturesOf os) + then modifyPlayerState $ \p -> p{playerOpponentOf=o} + else throwError WontHitThatError -- | Deal damage to an opponent. Real damage is influenced by random. -dealDamage :: (MonadRandom m,MonadDungeon m) => Int -> m () +dealDamage :: Int -> ChattyDungeonM () dealDamage d = do let dmin = truncate (fromIntegral d * 0.8) dmax = truncate (fromIntegral d * 1.2) r <- mrandomR (dmin,dmax) o <- liftM playerOpponentOf getPlayerState damage (TargetObject o) r - - -instance MonadExpand m => MonadExpand (DungeonT m) where - expand = lift . expand <=< expandDun + +instance (Functor m,MonadExpand m) => MonadExpand (DungeonT m) where + expand = lift . expand <=< liftM (replay.snd) . runRecorderT . expandDun -expandDun [] = return [] +expandDun :: (MonadPrinter m,MonadDungeon m) => String -> m () +expandDun [] = return () expandDun ('#':'?':'{':ss) = let nm = takeBrace 0 ss rm = drop (length nm + 1) ss @@ -548,31 +563,31 @@ case o of FalseObject -> expandDun rm _ -> do - r <- expandDun nm - s <- expandDun rm - return (r ++ s) + expandDun nm + expandDun rm expandDun ('#':'{':ss) = let (nm,rm) = (takeWhile (/='}') &&& tail.dropWhile (/='}')) ss - replace "health" = liftM (show . joinMaybe . avlLookup Health . playerCurrenciesOf) getPlayerState + replace "health" = liftM (show . joinMaybe . avlLookup Health . playerCurrenciesOf) getPlayerState >>= mprint replace "ohealth" = do i <- liftM playerOpponentOf getPlayerState o <- withObject i getObjectState - return $ show $ objectCurHealthOf o + mprint $ show $ objectCurHealthOf o replace "otitle" = do i <- liftM playerOpponentOf getPlayerState o <- withObject i getObjectState - return $ show $ objectTitleOf o + mprint $ unpack $ objectTitleOf o replace s = do cs <- liftM (avlInorder . currenciesOf) getDungeonState case filter ((==s).currencyNameOf) cs of - [] -> return [] - [c] -> liftM (show . joinMaybe . avlLookup (currencyIdOf c) . playerCurrenciesOf) getPlayerState + [] -> return () + [c] -> liftM (show . joinMaybe . avlLookup (currencyIdOf c) . playerCurrenciesOf) getPlayerState >>= mprint in do - r <- replace nm - s <- expandDun rm - return (r ++ s) + replace nm + expandDun rm expandDun ('#':ss) = let (nm,rm) = (takeWhile isAnum &&& dropWhile isAnum) ss isAnum = flip elem (['A'..'Z']++['a'..'z']++['0'..'9']) in expandDun ("#{"++nm++"}"++rm) -expandDun (s:ss) = return . (s:) =<< expandDun ss +expandDun (s:ss) = do + mprint [s] + expandDun ss diff --git a/src/Game/Antisplice/Terminal/Repl.hs b/src/Game/Antisplice/Terminal/Repl.hs --- a/src/Game/Antisplice/Terminal/Repl.hs +++ b/src/Game/Antisplice/Terminal/Repl.hs @@ -85,6 +85,8 @@ Left CantEquipThatThereError -> mprintLn "I can't wear that there. You might want to try some other place?" Left WhereToEquipError -> mprintLn "Where?" Left CantCastThatNowError -> mprintLn "Sorry, I can't cast that now. Check your health, mana and cooldowns." + Left WontHitThatError -> mprintLn "I won't hit that." + Left CantAcquireThatError -> mprintLn "I can't take that." Left e -> throwError e throwError DoneError Just Nothing -> liftIO (killThread thr) >> mprintLn "quit" >> throwError QuitError