module Game.Antisplice.Stereos (
statsStereo,
skillsStereo,
skillStereoM,
addStereo,
replaceStereo,
registerStereo,
registerStereoM,
StereoBuilderT (..),
mergeStereo,
mergeStereoM,
mergeSkill,
mergeSkillM,
defaultStereo,
visualStereo,
manualStereo
) 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 = statsStereo $
\get k -> case k of
AttackPower -> get Strength * 2
CooldownDuration -> (get CooldownDuration ^ 2) `div` (get CooldownDuration + get Haste) get CooldownDuration
_ -> 0
visualStereo :: MonadVocab m => m PlayerStereo
visualStereo = liftM snd $ flip runStereoBuilderT none $ do
mergeSkill $ skill "look" !+ bareAction (\p ->
case p of
SkillParam Nothing Nothing Nothing -> roomTriggerOnLookOf =<< getRoomState
SkillParam Nothing (Just o) Nothing -> objectTriggerOnLookAtOf o
_ -> throwError UnintellegibleError)
mergeSkill $ skill "read" !+ bareAction (\p ->
case p of
SkillParam (Just o) Nothing Nothing -> objectTriggerOnReadOf o
_ -> throwError UnintellegibleError)
manualStereo :: MonadVocab m => m PlayerStereo
manualStereo = liftM snd $ flip runStereoBuilderT none $ do
mergeSkill $ skill "hit" !+ optionallyFocusDirectC !+ dealDamageA (calcStat AttackPower) !+ implyGlobalCooldownA