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.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.Skills
import Game.Antisplice.Stats
import Game.Antisplice.Templates
import Game.Antisplice.Utils.Atoms
import Game.Antisplice.Utils.None
import Text.Chatty.Interactor.Templates
import System.IO
registerStereo :: MonadAtoms 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 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 :: MonadAtoms m => StereoBuilderT m () -> m (Atom PlayerStereo)
registerStereoM m = do
(_,s) <- runStereoBuilderT m none
registerStereo s
mkInteractor ''StereoBuilderT mkChatty (mkFail ''SplErr) mkDungeon mkRoom mkVocab mkCounter mkAtoms 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" !+ validConsumer AvailableObject objectTriggerOnUseOf
visualStereo :: MonadVocab m => m PlayerStereo
visualStereo = liftM snd $ flip runStereoBuilderT none $ do
mergeSkill $ skill "look" !+
validConsumer Nil (\_ -> roomTriggerOnLookOf =<< getRoomState) #||
validConsumer (Prep "at" :-: AvailableObject :-: Nil) objectTriggerOnLookAtOf
mergeSkill $ skill "read" !+ validConsumer AvailableObject 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" !+ validConsumer AvailableObject objectTriggerOnDrinkOf
mergeSkill $ skill "eat" !+ validConsumer AvailableObject objectTriggerOnEatOf