module Game.Antisplice.Skills (
Condition,
Consumer,
Skill (..),
ToConsumer (toConsumer),
(!+), (>!+), (!+>), (>!+>),
skill,
bareAction,
bareCondition,
focusDirectC,
optionallyFocusDirectC,
runSkill,
wrapSkills
) where
import Control.Arrow
import Control.Monad
import Control.Monad.Error.Class
import Data.Monoid
import Game.Antisplice.Action
import Game.Antisplice.Errors
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Rooms
import Game.Antisplice.Stats
import Game.Antisplice.Utils.None
import Game.Antisplice.Utils.Counter
import Game.Antisplice.Utils.Atoms
newtype Condition = Condition { runCondition :: SkillParam -> Prerequisite }
instance Monoid Condition where
mempty = Condition $ \_ -> return True
a `mappend` b = Condition $ \p -> do
a' <- runCondition a p
b' <- runCondition b p
return (a' && b')
instance IsAction Condition where
p #&& q = Condition $ \x -> do
a <- runCondition p x
if a then runCondition q x
else return False
p #|| q = Condition $ \x -> do
a <- runCondition p x
if a then return True
else runCondition q x
p !&& q = p <> q
p !|| q = Condition $ \x -> do
a <- runCondition p x
b <- runCondition q x
return (a || b)
instance None Condition where
none = mempty
data Skill = Skill {
skillConditionOf :: !Condition,
skillActionOf :: !(SkillParam -> Handler),
skillNameOf :: !String
}
data Consumer = Consumer !Condition !(SkillParam -> Handler)
instance Monoid Consumer where
mempty = Consumer none (const noneM)
(Consumer c1 a1) `mappend` (Consumer c2 a2) = Consumer (c1 <> c2) (\p -> a1 p >> a2 p)
instance IsAction Consumer where
(Consumer c1 a1) #&& (Consumer c2 a2) = Consumer (c1 #&& c2) (\p -> a1 p >> a2 p)
(Consumer c1 a1) #|| (Consumer c2 a2) = Consumer (c1 #|| c2) (\p -> runCondition c1 p >>= \q -> if q then a1 p else a2 p)
p !&& q = p <> q
(Consumer c1 a1) !|| (Consumer c2 a2) = Consumer (c1 !|| c2) (\p -> runCondition c1 p >>= \q -> runCondition c2 p >> if q then a1 p else a2 p)
instance None Consumer where
none = mempty
focusDirectC :: Consumer
focusDirectC = bareAction (\p -> case p of
SkillParam (Just o) _ _ -> focusOpponent $ objectIdOf o
_ -> throwError UnintellegibleError)
optionallyFocusDirectC :: Consumer
optionallyFocusDirectC = bareAction (\p -> case p of
SkillParam (Just o) _ _ -> focusOpponent $ objectIdOf o
SkillParam Nothing _ _ -> do
o <- liftM playerOpponentOf getPlayerState
case o of
FalseObject -> throwError UnintellegibleError
_ -> noneM)
class ToConsumer c where
toConsumer :: c -> Consumer
instance ToConsumer Consumer where
toConsumer = id
instance ToConsumer Skill where
toConsumer (Skill c a n) = Consumer c a
instance ToConsumer HandlerBox where
toConsumer (Handler t) = Consumer none (const t)
instance ToConsumer (SkillParam -> HandlerBox) where
toConsumer t = Consumer none (runHandler . t)
instance ToConsumer Condition where
toConsumer c = Consumer c (const noneM)
instance ToConsumer PrerequisiteBox where
toConsumer p = Consumer (Condition $ \_ -> runPrerequisite p) (const noneM)
instance ToConsumer Action where
toConsumer a = Consumer (Condition $ \_ -> askAction a) (\_ -> runAction a)
infixl 5 !+
(!+) :: ToConsumer c => Skill -> c -> Skill
s !+ c = s !+! toConsumer c
where (Skill c a n) !+! (Consumer c1 a1) = Skill (c <> c1) (\p -> a p >> a1 p) n
infixl 5 >!+
(>!+) :: (ToConsumer c,Monad m) => m Skill -> c -> m Skill
m >!+ c = do
s <- m
return (s !+ c)
infixl 5 !+>
(!+>) :: (ToConsumer c,Monad m) => Skill -> m c -> m Skill
s !+> m = do
c <- m
return (s !+ c)
infixl 5 >!+>
(>!+>) :: (ToConsumer c,Monad m) => m Skill -> m c -> m Skill
ms >!+> mc = do
s <- ms
c <- mc
return (s !+ c)
bareAction :: (SkillParam -> Handler) -> Consumer
bareAction t = toConsumer $ \p -> Handler (t p)
bareCondition :: (SkillParam -> ChattyDungeonM Bool) -> Consumer
bareCondition = toConsumer.Condition
skill :: String -> Skill
skill = Skill none (const noneM)
wrapSkills :: [Skill] -> String -> Maybe (SkillParam -> HandlerBox)
wrapSkills sk n =
case filter ((==n).skillNameOf) sk of
[] -> Nothing
sk:_ -> Just $ \p -> Handler (runSkill sk p)
runSkill :: Skill -> SkillParam -> Handler
runSkill (Skill c a _) p = do
b <- runCondition c p
unless b $ throwError CantCastThatNowError
a p