packages feed

antisplice 0.12.1.0 → 0.12.3.0

raw patch · 8 files changed

+100/−41 lines, 8 filesdep ~chatty

Dependency ranges changed: chatty

Files

antisplice.cabal view
@@ -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
src/Game/Antisplice/Errors.hs view
@@ -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'
src/Game/Antisplice/Events.hs view
@@ -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
src/Game/Antisplice/Monad.hs view
@@ -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
src/Game/Antisplice/Monad/Dungeon.hs view
@@ -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
src/Game/Antisplice/Prototypes.hs view
@@ -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
src/Game/Antisplice/Rooms.hs view
@@ -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
src/Game/Antisplice/Terminal/Repl.hs view
@@ -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