module Game.Antisplice.Action where
import Control.Monad
import Data.Monoid
import Data.Maybe
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Rooms
import Game.Antisplice.Errors
import Game.Antisplice.Stats
import Data.Chatty.Counter
import Data.Chatty.None
import Data.Chatty.AVL
import Data.Chatty.BST
class IsAction a where
infixl 5 #&&
(#&&) :: a -> a -> a
infixl 5 #||
(#||) :: a -> a -> a
infixl 5 !&&
(!&&) :: a -> a -> a
infixl 5 !||
(!||) :: a -> a -> a
instance Monoid PrerequisiteBox where
mempty = none
p `mappend` q = Prerequisite $ do
a <- runPrerequisite p
b <- runPrerequisite q
return (a && b)
instance IsAction PrerequisiteBox where
p #&& q = Prerequisite $ do
a <- runPrerequisite p
if a then runPrerequisite q
else return False
p #|| q = Prerequisite $ do
a <- runPrerequisite p
if a then return True
else runPrerequisite q
p !&& q = p <> q
p !|| q = Prerequisite $ do
a <- runPrerequisite p
b <- runPrerequisite q
return (a || b)
instance Monoid PredicateBox where
mempty = none
p `mappend` q = Predicate $ do
a <- runPredicate p
b <- runPredicate q
return $ case (a,b) of
(Just (Unint i s), Just (Unint j _)) | i >= j -> Just $ Unint i s
(Nothing, k) -> k
(k, _) -> k
instance IsAction PredicateBox where
p #&& q = Predicate $
runPredicate p >>= \case
Nothing -> runPredicate q
Just (Unint i s) -> runPredicate q >>= \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 = Predicate $
runPredicate p >>= \case
Nothing -> return Nothing
Just (Unint i s) -> runPredicate q >>= \case
Just (Unint j _) | i >= j -> return $ Just $ Unint i s
e -> return e
e -> runPredicate q
p !&& q = p <> q
p !|| q = Predicate $ do
a <- runPredicate p
b <- runPredicate q
return $ case (a,b) of
(Nothing, _) -> Nothing
(Just (Unint i s), Just (Unint j _)) | i >= j -> Just $ Unint i s
(_, k) -> k
data Action = Action { askAction :: Predicate, runAction :: Handler }
instance None Action where
none = Action (return Nothing) noneM
instance Monoid Action where
mempty = none
a `mappend` b = Action (runPredicate $ Predicate (askAction a) <> Predicate (askAction b)) (runAction a >> runAction b)
instance IsAction Action where
a #&& b = Action
(runPredicate $ Predicate (askAction a) #&& Predicate (askAction b))
(runAction a >> runAction b)
a #|| b = Action
(runPredicate $ Predicate (askAction a) #|| Predicate (askAction b))
(askAction a >>= \q -> if isNothing q then runAction a else runAction b)
a !&& b = a <> b
a !|| b = Action
(runPredicate $ Predicate (askAction a) !|| Predicate (askAction b))
(askAction a >>= \q -> askAction b >> if isNothing q then runAction a else runAction b)
newtype ActionAfter = ActionAfter { runActionAfter :: Action }
newtype ActionBefore = ActionBefore { runActionBefore :: Action }
instance None ActionAfter where
none = ActionAfter none
instance None ActionBefore where
none = ActionBefore none
instance Monoid ActionAfter where
mempty = none
a `mappend` b = ActionAfter $ runActionAfter a <> runActionAfter b
instance Monoid ActionBefore where
mempty = none
a `mappend` b = ActionBefore $ runActionBefore a <> runActionBefore b
instance IsAction ActionAfter where
a #&& b = ActionAfter $ runActionAfter a #&& runActionAfter b
a #|| b = ActionAfter $ runActionAfter a #|| runActionAfter b
a !&& b = ActionAfter $ runActionAfter a !&& runActionAfter b
a !|| b = ActionAfter $ runActionAfter a !|| runActionAfter b
instance IsAction ActionBefore where
a #&& b = ActionBefore $ runActionBefore a #&& runActionBefore b
a #|| b = ActionBefore $ runActionBefore a #|| runActionBefore b
a !&& b = ActionBefore $ runActionBefore a !&& runActionBefore b
a !|| b = ActionBefore $ runActionBefore a !|| runActionBefore b
instance IsAction (Maybe ReError) where
Nothing #&& Nothing = Nothing
Just (Unint i s) #&& Just (Unint j _) | i >= j = Just $ Unint i s
a #&& Nothing = a
_ #&& e = e
Nothing #|| _ = Nothing
Just (Unint i s) #|| Just (Unint j _) | i >= j = Just $ Unint i s
_ #|| e = e
(!&&) = (#&&)
(!||) = (#||)
ands :: (None a,IsAction a) => [a] -> a
ands = foldr (!&&) none
andl :: (None a,IsAction a) => [a] -> a
andl = foldr (#&&) none
ors :: (None a,IsAction a) => [a] -> a
ors = foldr (!||) none
orl :: (None a,IsAction a) => [a] -> a
orl = foldr (#||) none
consumeCurrencyA :: CurrencyId -> Int -> Action
consumeCurrencyA c h = Action
(do
c1 <- getCurrency c
return (if c1 > h then Nothing else Just $ Uncon "You can't cast that now (check your currencies)"))
(modifyCurrency c (subtract h))
consumeKindA :: KindId -> Int -> Action
consumeKindA k h =
let getObjs :: ChattyDungeonM [ObjectId]
getObjs = liftM (map indexOf . filter ((==k) . objectKindOf) . avlInorder . playerInventoryOf) getPlayerState
in Action
(do
objs <- getObjs
return (if length objs >= h then Nothing else Just $ Uncon "You can't cast that now (check your inventory)"))
(do
objs <- getObjs
modifyPlayerState $ \p -> p{playerInventoryOf=foldr avlRemove (playerInventoryOf p) $ take h objs})
dealDamageA :: ChattyDungeonM Int -> Action
dealDamageA m = Action (return Nothing) (dealDamage =<< m)
implyCooldownA :: ChCounter m => Integer -> m Action
implyCooldownA ms = do
cid <- liftM CooldownId countOn
return (Action
(liftM (\b -> if not b then Nothing else Just $ Uncon "You can't cast that now (check your cooldowns)") $ getCooldown cid)
(setCooldown cid True >> schedule ms (setCooldown cid False)))
implyGlobalCooldownA :: Action
implyGlobalCooldownA = Action
(liftM (\b -> if not b then Nothing else Just $ Uncon "You can't cast that now (check your global cooldown)") $ getCooldown GlobalCooldown)
(do
setCooldown GlobalCooldown True
cd <- calcStat CooldownDuration
schedule (fromIntegral cd) $ setCooldown GlobalCooldown False)