module Game.Antisplice.Stereos (
statsStereo,
skillsStereo,
skillStereoM,
addStereo,
replaceStereo,
registerStereo,
registerStereoM,
StereoBuilderT (..),
mergeStereo,
mergeStereoM,
mergeSkill,
mergeRecipe,
mergeSkillM,
mergeRecipeM,
defaultStereo,
visualStereo,
manualStereo,
consumeStereo
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Error.Class
import Control.Arrow
import Data.Monoid
import Game.Antisplice.Action
import Game.Antisplice.Call
import Game.Antisplice.Errors
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Monad.Vocab
import Game.Antisplice.Rooms
import Game.Antisplice.MaskedSkills
import Game.Antisplice.Skills
import Game.Antisplice.Stats
import Game.Antisplice.Templates
import Data.Chatty.Atoms
import Data.Chatty.None
import Data.Chatty.Hetero
import Text.Chatty.Interactor.Templates
import System.IO
registerStereo :: ChAtoms m => PlayerStereo -> m (Atom PlayerStereo)
registerStereo s = do
a <- newAtom
putAtom a s
return a
addStereo :: MonadPlayer m => Atom PlayerStereo -> m ()
addStereo a = modifyPlayerState $ \p -> p{playerStereosOf=a:playerStereosOf p}
replaceStereo :: MonadPlayer m => Atom PlayerStereo -> Atom PlayerStereo -> m ()
replaceStereo rem ins = modifyPlayerState $ \p -> p{playerStereosOf=map (\a -> if a == rem then ins else a) $ playerStereosOf p}
statsStereo :: ((StatKey -> Int) -> StatKey -> Int) -> PlayerStereo
statsStereo m = PlayerStereo m (const none) (const none)
skillsStereo :: [Skill] -> PlayerStereo
skillsStereo sk = PlayerStereo (\_ _ -> 0) (wrapSkills sk) (const none)
recipesStereo :: [Recipe] -> PlayerStereo
recipesStereo rp = PlayerStereo (\_ _ -> 0) (const none) (wrapRecipes rp)
skillStereoM :: Monad m => m Skill -> m PlayerStereo
skillStereoM m = do
sk <- m
return $ skillsStereo [sk]
recipeStereoM :: Monad m => m Recipe -> m PlayerStereo
recipeStereoM m = do
rp <- m
return $ recipesStereo [rp]
newtype StereoBuilderT m a = StereoBuilder { runStereoBuilderT :: PlayerStereo -> m (a,PlayerStereo) }
instance Functor m => Functor (StereoBuilderT m) where
fmap f a = StereoBuilder $ \s -> fmap (first f) $ runStereoBuilderT a s
instance Monad m => Monad (StereoBuilderT m) where
return a = StereoBuilder $ \s -> return (a,s)
m >>= f = StereoBuilder $ \s -> do (a,s') <- runStereoBuilderT m s; runStereoBuilderT (f a) s'
instance (Functor m, Monad m) => Applicative (StereoBuilderT m) where
pure = return
(<*>) = ap
instance MonadTrans StereoBuilderT where
lift m = StereoBuilder $ \s -> do a <- m; return (a,s)
mergeStereo :: Monad m => PlayerStereo -> StereoBuilderT m ()
mergeStereo ste = StereoBuilder $ \s -> return ((),s<>ste)
mergeStereoM :: Monad m => m PlayerStereo -> StereoBuilderT m ()
mergeStereoM m = do
ste <- lift m
mergeStereo ste
mergeSkill :: MonadVocab m => Skill -> StereoBuilderT m ()
mergeSkill sk = do
insertVocab (skillNameOf sk) Skilln
mergeStereo $ skillsStereo [sk]
mergeSkillM :: MonadVocab m => m Skill -> StereoBuilderT m ()
mergeSkillM m = do
sk <- lift m
mergeSkill sk
mergeRecipe :: MonadVocab m => Recipe -> StereoBuilderT m ()
mergeRecipe rp = do
insertVocab (recipeNameOf rp) Noun
mergeStereo $ recipesStereo [rp]
mergeRecipeM :: MonadVocab m => m Recipe -> StereoBuilderT m ()
mergeRecipeM m = do
rp <- lift m
mergeRecipe rp
registerStereoM :: ChAtoms m => StereoBuilderT m () -> m (Atom PlayerStereo)
registerStereoM m = do
(_,s) <- runStereoBuilderT m none
registerStereo s
mkInteractor ''StereoBuilderT mkChatty (mkFail ''SplErr) mkDungeon mkRoom mkVocab mkPlayer mkIO mkObject (mkChannelPrinter ''PlayerId)
defaultStereo :: MonadVocab m => m PlayerStereo
defaultStereo = liftM snd $ flip runStereoBuilderT none $ do
mergeStereo $ statsStereo $
\get k -> case k of
AttackPower -> get Strength * 2
CooldownDuration -> (get CooldownDuration ^ 2) `div` (get CooldownDuration + get Haste) get CooldownDuration
_ -> 0
mergeSkill $ skill "use" !+ AvailableObject :-: Nil #-> objectTriggerOnUseOf
visualStereo :: MonadVocab m => m PlayerStereo
visualStereo = liftM snd $ flip runStereoBuilderT none $ do
mergeSkill (skill "look" !+
Nil #->> (roomTriggerOnLookOf =<< getRoomState)
#|| Prep "at" :-: AvailableObject :-: Nil #-> objectTriggerOnLookAtOf)
mergeSkill (skill "read" !+ AvailableObject :-: Nil #-> objectTriggerOnReadOf)
manualStereo :: MonadVocab m => m PlayerStereo
manualStereo = liftM snd $ flip runStereoBuilderT none $ do
mergeSkill $ skill "hit" !+ optionallyFocusDirectC !+ dealDamageA (calcStat AttackPower) !+ implyGlobalCooldownA
consumeStereo :: MonadVocab m => m PlayerStereo
consumeStereo = liftM snd $ flip runStereoBuilderT none $ do
mergeSkill $ skill "drink" !+ AvailableObject :-: Nil #- Pass &-> objectTriggerOnDrinkOf +? Drinkable :-: Nil
mergeSkill $ skill "eat" !+ AvailableObject :-: Nil #- Pass &-> objectTriggerOnEatOf +? Eatable :-: Nil