antisplice 0.13.1.0 → 0.13.2.0
raw patch · 3 files changed
+66/−9 lines, 3 files
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.13.1.0+version: 0.13.2.0 -- A short (one-line) description of the package. synopsis: An engine for text-based dungeons.
src/Game/Antisplice/Monad/Dungeon.hs view
@@ -44,6 +44,7 @@ Relation (..), Feature (..), ObjectId (..),+ KindId (..), ObjectState (..), ObjectT (..), MonadObject (..),@@ -219,8 +220,13 @@ -- | Phantom ID type for objects. data ObjectId = ObjectId Int | FalseObject deriving (Eq,Ord) +-- | Phantom ID type for object kinds.+data KindId = KindId Int | FalseKind deriving (Eq,Ord)+ instance None ObjectId where none = FalseObject+instance None KindId where+ none = FalseKind -- | Target for attacks. May be a player or an object. data DamageTarget = TargetPlayer PlayerId | TargetObject ObjectId@@ -228,6 +234,7 @@ -- | State type for ObjectT data ObjectState = ObjectState { objectIdOf :: !ObjectId,+ objectKindOf :: !KindId, objectTitleOf :: !Text, objectDescOf :: !Text, objectNamesOf :: ![String],
src/Game/Antisplice/Rooms.hs view
@@ -41,6 +41,7 @@ removeRoomObject, insertRoomObject, -- * Object construction+ constructObject, modifyObjectState, setObjectDesc, setObjectTitle,@@ -54,6 +55,8 @@ -- * Object forms registerForm, instanciateForm,+ registerKind,+ setObjectKind, -- * Object investigation getObjectTitle, getObjectDesc,@@ -77,6 +80,8 @@ getEquipment, getCooldown, setCooldown,+ -- * Currencies+ registerCurrency, getCurrency, modifyCurrency, -- * Fight@@ -90,7 +95,10 @@ -- * Guardians guardRoom, guardObject,- guardObjectInRoom+ guardObjectInRoom,+ guardObjectNotInRoom,+ guardKindInRoom,+ guardKindNotInRoom ) where import Text.Chatty.Printer@@ -232,15 +240,17 @@ addRoomObject :: (MonadCounter m,MonadRoom m) => ObjectT m a -> m ObjectId addRoomObject m = do i <- liftM ObjectId countOn- o <- constructObject m $ Just i+ k <- liftM KindId countOn+ o <- constructObject m (Just i) k insertRoomObject o return i -- | Construct a room object (but don't add it)-constructObject :: Monad m => ObjectT m a -> Maybe ObjectId -> m ObjectState-constructObject m j = do+constructObject :: Monad m => ObjectT m a -> Maybe ObjectId -> KindId -> m ObjectState+constructObject m j k = do (_,o) <- runObjectT m $ ObjectState (if isJust j then (\(Just j) -> j) j else none) -- id+ k -- kid (pack "Something") -- title (pack "I don't know what this is.") -- desc none none False False False False -- names, attr, 1seen?, 1acq?, 1insp?, 1eq?@@ -345,10 +355,18 @@ -- | Set whether the current object is a mob. setObjectIsMob :: MonadObject m => Bool -> m ()-setObjectIsMob b = modifyObjectState $ \o -> o{objectFeaturesOf=a b $ objectFeaturesOf o}- where a True = avlInsert Mobile- a False = avlRemove Mobile+setObjectIsMob b = modifyObjectState $ \o -> o{objectFeaturesOf=a b Mobile $ objectFeaturesOf o}+ where a True = avlInsert+ a False = avlRemove +-- | Set object kind.+setObjectKind :: MonadObject m => KindId -> m ()+setObjectKind k = modifyObjectState $ \o -> o{objectKindOf=k}++-- | Register an object kind.+registerKind :: MonadCounter m => m KindId+registerKind = liftM KindId countOn+ -- | Check if the current object is acquirable. getObjectIsAcquirable :: (MonadObject m,Functor m) => m Bool getObjectIsAcquirable = fmap (isJust . avlLookup Acquirable . objectFeaturesOf) getObjectState@@ -407,6 +425,28 @@ [r1] | r1 == r -> m _ -> return () +-- | Only run the given function if the given object is not in the also given room+guardObjectNotInRoom :: MonadDungeon m => ObjectId -> NodeId -> m () -> m ()+guardObjectNotInRoom o r m = do+ rs <- roomOfObject o+ case rs of+ [r1] | r1 == r -> return ()+ _ -> m++-- | Only run the given function if an object of the given kind is in the also given room+guardKindInRoom :: MonadDungeon m => KindId -> NodeId -> m () -> m ()+guardKindInRoom k r m = do+ rs <- withRoom r getRoomState+ let b = null $ filter ((==k).objectKindOf) $ avlPreorder $ roomObjectsOf rs+ unless b m++-- | Only run the given function if no object of the given kind is in the also given room+guardKindNotInRoom :: MonadDungeon m => KindId -> NodeId -> m () -> m ()+guardKindNotInRoom k r m = do+ rs <- withRoom r getRoomState+ let b = null $ filter ((==k).objectKindOf) $ avlPreorder $ roomObjectsOf rs+ when b m+ -- | Determine which rooms contain the given object (won't be more than one, but we're careful) roomOfObject :: MonadDungeon m => ObjectId -> m [NodeId] roomOfObject o = (return . map nodeId . filter (isJust . avlLookup o . roomObjectsOf . nodeContent) . allNodes . roomsOf) =<< getDungeonState@@ -422,6 +462,7 @@ then do o <- withRoom r $ removeRoomObject i modifyPlayerState $ \s -> s{playerInventoryOf=avlInsert o $ playerInventoryOf s}+ objectTriggerOnEachAcquireOf o else throwError CantAcquireThatError [] -> throwError CantSeeOneError _ -> throwError WhichOneError@@ -450,7 +491,8 @@ registerForm :: (MonadAtoms m) => ObjectT m () -> m (Atom ObjectState) registerForm m = do a <- newAtom- o <- constructObject m Nothing+ k <- liftM KindId countOn+ o <- constructObject m Nothing k putAtom a o return a @@ -512,6 +554,14 @@ modifyCurrency c f = modifyPlayerState $ \p -> let c1 = joinMaybe $ avlLookup c $ playerCurrenciesOf p in p{playerCurrenciesOf=avlInsert (c,f c1) $ playerCurrenciesOf p}++-- | Register a currency+registerCurrency :: (MonadCounter m,MonadDungeon m) => String -> String -> m CurrencyId+registerCurrency n d = do+ s <- getDungeonState+ i <- liftM CurrencyId countOn+ putDungeonState s{currenciesOf=avlInsert (Currency i d n) $ currenciesOf s}+ return i -- | Run a function in the context of a given player withPlayer :: MonadDungeon m => PlayerId -> PlayerT (RoomT m) a -> m a