module Game.Antisplice.Stereos (
statsStereo,
skillsStereo,
skillStereoM,
addStereo,
replaceStereo,
registerStereo,
registerStereoM,
StereoBuilderT (..),
mergeStereo,
mergeStereoM,
mergeSkill,
mergeSkillM,
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.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)
skillsStereo :: [Skill] -> PlayerStereo
skillsStereo sk = PlayerStereo (\_ _ -> 0) $ wrapSkills sk
skillStereoM :: Monad m => m Skill -> m PlayerStereo
skillStereoM m = do
sk <- m
return $ skillsStereo [sk]
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
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" !+ bareAction (\p ->
case p of
SkillParam Getters{..} (Just o) Nothing Nothing -> objectTriggerOnUseOf =<< dispget getAvailableObject o
_ -> throwError UnintellegibleError)
visualStereo :: MonadVocab m => m PlayerStereo
visualStereo = liftM snd $ flip runStereoBuilderT none $ do
mergeSkill $ skill "look" !+ bareAction (\p ->
case p of
SkillParam Getters{..} Nothing Nothing Nothing -> roomTriggerOnLookOf =<< getRoomState
SkillParam Getters{..} Nothing (Just n) Nothing -> objectTriggerOnLookAtOf =<< dispget getAvailableObject n
_ -> throwError UnintellegibleError)
mergeSkill $ skill "read" !+ bareAction (\p ->
case p of
SkillParam Getters{..} (Just n) Nothing Nothing -> objectTriggerOnReadOf =<< dispget getAvailableObject n
_ -> throwError UnintellegibleError)
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" !+ bareAction (\p ->
case p of
SkillParam Getters{..} (Just o) Nothing Nothing -> objectTriggerOnDrinkOf =<< dispget getAvailableObject o
_ -> throwError UnintellegibleError)
mergeSkill $ skill "eat" !+ bareAction (\p ->
case p of
SkillParam Getters{..} (Just o) Nothing Nothing -> objectTriggerOnEatOf =<< dispget getAvailableObject o
_ -> throwError UnintellegibleError)