module Game.Antisplice.Skills (
Condition(..),
Consumer(..),
Skill (..),
Recipe (..),
ToConsumer (toConsumer),
Extensible(..),
(>!+), (!+>), (>!+>),
skill,
recipe,
validConsumer,
validCondition,
(#-),
(#->),
(#->>),
focusDirectC,
optionallyFocusDirectC,
callRecipe,
runConsumer,
wrapSkills,
wrapRecipes,
) where
import Control.Arrow
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Error.Class
import Data.Monoid
import Data.Maybe
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.Stats
import Data.Chatty.None
import Data.Chatty.Counter
import Data.Chatty.Atoms
import Data.Chatty.Hetero
import Game.Antisplice.MaskedSkills
newtype Condition = Condition { runCondition' :: InvokableP }
runCondition :: Condition -> [String] -> ChattyDungeonM (Maybe ReError)
runCondition c ps = runPredicate $ runCondition' c ps
instance Monoid Condition where
mempty = Condition $ \_ -> Predicate $ return Nothing
a `mappend` b = Condition $ \ps -> Predicate $ do
a' <- runCondition a ps
b' <- runCondition b ps
return $ case a' of
Nothing -> b'
Just (Unint i s) -> case b' of
Nothing -> Just (Unint i s)
Just (Unint j t)
| i >= j -> Just (Unint i s)
| otherwise -> Just (Unint j s)
e -> e
e -> e
instance IsAction Condition where
p #&& q = Condition $ \ps -> Predicate $ do
runCondition p ps >>= \case
Nothing -> runCondition q ps
Just (Unint i s) -> runCondition q ps >>= \case
Nothing -> return $ Just $ Unint i s
Just (Unint j _) | i >= j -> return $ Just $ Unint i s
e -> return e
e -> return e
p #|| q = Condition $ \ps -> Predicate $ do
runCondition p ps >>= \case
Nothing -> return Nothing
Just (Unint i s) -> runCondition q ps >>= \case
Just (Unint j _) | i >= j -> return $ Just $ Unint i s
e -> return e
Just (Uncon s) -> return $ Just (Uncon s)
e -> runCondition q ps
p !&& q = p <> q
p !|| q = Condition $ \ps -> Predicate $ do
a <- runCondition p ps
b <- runCondition q ps
return $ case a of
Nothing -> Nothing
Just (Unint i s) | Just (Unint j _) <- b, i >= j -> Just $ Unint i s
_ -> b
instance None Condition where
none = mempty
data Skill = Skill {
skillConditionOf :: !Condition,
skillActionOf :: !Invokable,
skillNameOf :: !String
}
data Recipe = Recipe {
recipeConditionOf :: !Condition,
recipeActionOf :: !Invokable,
recipeMethodOf :: !RecipeMethod,
recipeNameOf :: !String
}
data Consumer = Consumer !Condition !Invokable
instance Monoid Consumer where
mempty = Consumer none noneM
(Consumer c1 a1) `mappend` (Consumer c2 a2) = Consumer (c1 <> c2) (\ps -> Handler (runHandler (a1 ps) >> runHandler (a2 ps)))
instance IsAction Consumer where
(Consumer c1 a1) #&& (Consumer c2 a2) = Consumer (c1 #&& c2) (\ps -> Handler (runHandler (a1 ps) >> runHandler (a2 ps)))
(Consumer c1 a1) #|| (Consumer c2 a2) = Consumer (c1 #|| c2) (\ps -> Handler (runCondition c1 ps >>= \q -> if isNothing q then runHandler (a1 ps) else runHandler (a2 ps)))
p !&& q = p <> q
(Consumer c1 a1) !|| (Consumer c2 a2) = Consumer (c1 !|| c2) (\ps -> Handler (runCondition c1 ps >>= \q -> runCondition c2 ps >> if isNothing q then runHandler (a1 ps) else runHandler (a2 ps)))
instance None Consumer where
none = mempty
focusDirectC :: Consumer
focusDirectC = SeenObject :-: Nil #-> \o -> focusOpponent $ objectIdOf o
optionallyFocusDirectC :: Consumer
optionallyFocusDirectC = focusDirectC #|| Nil #->> (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 Recipe where
toConsumer (Recipe c a m n) = Consumer c a
instance ToConsumer HandlerBox where
toConsumer t = Consumer none (\_ -> t)
instance ToConsumer Condition where
toConsumer c = Consumer c (\_ -> Handler $ return none)
instance ToConsumer PredicateBox where
toConsumer p = Consumer (Condition $ \_ -> p) (\_ -> Handler $ return none)
instance ToConsumer Action where
toConsumer a = Consumer (Condition $ \_ -> Predicate $ askAction a) (\_ -> Handler $ runAction a)
class Extensible e where
infixl 4 !+
(!+) :: ToConsumer c => e -> c -> e
instance Extensible Skill where
s !+ c = s !+! toConsumer c
where (Skill c a n) !+! (Consumer c1 a1) = Skill (c <> c1) (\ps -> Handler (runHandler (a ps) >> runHandler (a1 ps))) n
instance Extensible Recipe where
s !+ c = s !+! toConsumer c
where (Recipe c a m n) !+! (Consumer c1 a1) = Recipe (c <> c1) (\ps -> Handler (runHandler (a ps) >> runHandler (a1 ps))) m n
instance Extensible Consumer where
s !+ c = s <> toConsumer c
infixl 4 >!+
(>!+) :: (ToConsumer c,Monad m,Extensible e) => m e -> c -> m e
m >!+ c = do
s <- m
return (s !+ c)
infixl 4 !+>
(!+>) :: (ToConsumer c,Monad m,Extensible e) => e -> m c -> m e
s !+> m = do
c <- m
return (s !+ c)
infixl 4 >!+>
(>!+>) :: (ToConsumer c,Monad m,Extensible e) => m e -> m c -> m e
ms >!+> mc = do
s <- ms
c <- mc
return (s !+ c)
validConsumer :: (Append m (Cons EnsureLineEnd Nil) s,Append r Nil r,CallMask s r,Tuplify r t) => m -> (t -> Handler) -> Consumer
validConsumer m h =
let eitherToMaybe (Right x) = Nothing
eitherToMaybe (Left e) = Just e
in Consumer
(Condition $ \ps -> Predicate $ liftM eitherToMaybe $ tryMask m ps)
(\ps -> Handler $ do
t <- processMask m ps
h t)
infixr 6 #-
(#-) :: (Append m (Cons EnsureLineEnd Nil) s,Append r Nil r, CallMask s r) => m -> MaskedConsumer r -> Consumer
m #- (MasCon ps hs) = Consumer
(Condition $ \ss -> Predicate $ do
tryMask m ss >>= \case
Right r -> liftM andl $ mapM (\(PMCond c) -> usepmask c r) ps
Left e -> return $ Just e)
(\ps -> Handler $ do
tryMask m ps >>= \case
Right r -> mapM_ (\(PMHandler po h) -> h =<< liftM tuplify (usepost po r)) hs
Left e -> throwError $ ReError e)
infixr 6 #->
(#->) :: (Append m (Cons EnsureLineEnd Nil) s,Append r Nil r, CallMask s r, Tuplify r t) => m -> (t -> Handler) -> Consumer
(#->) = validConsumer
infixr 6 #->>
(#->>) :: (Append m (Cons EnsureLineEnd Nil) s,CallMask s Nil) => m -> Handler -> Consumer
m #->> h = m #-> const h
validCondition :: (Append m (Cons EnsureLineEnd Nil) s,Append r Nil r, CallMask s r, Tuplify r t) => m -> (t -> Predicate) -> Condition
validCondition m p =
let eitherToMaybe (Right x) = Nothing
eitherToMaybe (Left e) = Just e
in
Condition (\ps -> Predicate $ liftM eitherToMaybe $ tryMask m ps) <>
Condition (\ps -> Predicate $ do t <- processMask m ps; p t)
callRecipe :: RecipeMethod -> Consumer
callRecipe m = CatchAny :-: Remaining :-: Nil #->
\(p,ps) -> do
ste <- totalStereo
case stereoRecipeBonus ste p of
Nothing -> throwError CantCastThatNowError
Just r -> runHandler $ r m ps
skill :: String -> Skill
skill = Skill none noneM
recipe :: RecipeMethod -> String -> Recipe
recipe = Recipe none noneM
wrapSkills :: [Skill] -> String -> Maybe Invokable
wrapSkills sk n =
case filter ((==n).skillNameOf) sk of
[] -> Nothing
sk:_ -> Just $ runConsumer sk
wrapRecipes :: [Recipe] -> String -> Maybe (RecipeMethod -> Invokable)
wrapRecipes sk n =
case filter ((==n).recipeNameOf) sk of
[] -> Nothing
sk:_ -> Just $ \m -> if m == recipeMethodOf sk then runConsumer sk else \_ -> Handler $ throwError WrongMethodError
runConsumer :: ToConsumer c => c -> Invokable
runConsumer c = runConsumer' $ toConsumer c
where runConsumer' :: Consumer -> Invokable
runConsumer' (Consumer c a) = \ps -> Handler $ do
b <- runCondition c ps
case b of
Nothing -> runHandler $ a ps
Just e -> throwError $ ReError e