--{-# LANGUAGE TupleSections #-} -- | Actions performed by creatures within the world module Dodge.Creature.Action ( performActions, dropItem, blinkActionMousePos, blinkActionFail, unsafeBlinkAction, youDropItem, ) where import RandomHelp import Dodge.WorldEvent.ThingsHit import Control.Applicative import Control.Monad import Data.Foldable import Data.Maybe import Dodge.Base import Dodge.Creature.Action.Blink import Dodge.Creature.Impulse import Dodge.Creature.MoveType import Dodge.Creature.Radius import Dodge.CreatureEffect import Dodge.Data.World import Dodge.FloatFunction import Dodge.FloorItem import Dodge.Inventory import Dodge.Item.BackgroundEffect import Dodge.Path import Dodge.SoundLogic import Geometry import qualified IntMapHelp as IM import LensHelp import Linear import NewInt import qualified Data.Set as S -- it is desirable to be able to determine when an action is finished, -- so that DoActionThen and the like are easy to define performActions :: Int -> World -> World performActions cid w = foldl' (followImpulse cid) (w & cWorld . lWorld . creatures . ix cid . crActionPlan . apAction .~ mayas) iss where cr = w ^?! cWorld . lWorld . creatures . ix cid (iss, mayas) = fromMaybe ([],NoAction) $ performAction cr w <$> cr ^? crActionPlan . apAction type ActionUpdate = ([Impulse], Action) {- | Performing an action on a frame creates an ActionUpdate: gives impulses and updates/deletes the action itself. -} performAction :: Creature -> World -> Action -> ActionUpdate performAction cr w ac = case ac of AimAt tcid p -> performAimAt cr w tcid p WaitThen 0 newAc -> ([], newAc) WaitThen t newAc -> ([], WaitThen (t -1) newAc) ImpulsesList (xs : xss) a -> performAction cr w a & _1 <>~ xs & _2 %~ ImpulsesList xss ImpulsesList _ a -> performAction cr w a DoImpulses imps -> (imps, NoAction) DoActionThen fsta afta -> case performAction cr w fsta of (imps, NoAction) -> (imps, afta) (imps, nxta) -> (imps, DoActionThen nxta afta) DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act DoActionWhilePartial partAc f resetAc | doWdCrBl f w cr -> case performAction cr w partAc of (imps, NoAction) -> (imps, DoActionWhilePartial resetAc f resetAc) (imps, nxta ) -> (imps, DoActionWhilePartial nxta f resetAc) | otherwise -> performAction cr w partAc DoActionIf f ifa | doWdCrBl f w cr -> performAction cr w ifa | otherwise -> ([], NoAction) DoActionIfElse ifa f elsea | doWdCrBl f w cr -> performAction cr w ifa | otherwise -> performAction cr w elsea DoActionWhileInterrupt repa f afta | doWdCrBl f w cr -> (fst $ performAction cr w repa, DoActionWhileInterrupt repa f afta) | otherwise -> performAction cr w afta -- DoActions [] -> ([], NoAction) -- DoActions acs -> -- let (imps, newAcs) = foldMap (performAction cr w) acs -- in (imps, newAcs) StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], NoAction) PathTo p a -> performPathTo a cr w p EvadeAim -> tryEvadeSideways cr w TurnToPoint p -> performTurnToA cr p LeadTarget p -> fromMaybe ([], NoAction) $ do i <- cr ^? crIntention . targetCr . _Just tcr <- w ^? cWorld . lWorld . creatures . ix i return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], NoAction) UseSelf f -> performAction cr w $ doCrAc f cr ArbitraryAction f -> performAction cr w (doCrWdAc f cr w) DoImpulsesAlongside sideImp mainAc -> performAction cr w mainAc & _1 <>~ sideImp DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac DoReplicatePartial _ 0 pac -> performAction cr w pac DoReplicatePartial startac t partac -> case performAction cr w partac of (imps, NoAction) -> (imps, DoReplicatePartial startac (t -1) startac) (imps, nextac) -> (imps, DoReplicatePartial startac t nextac) NoAction -> ([], NoAction) tryEvadeSideways :: Creature -> World -> ActionUpdate tryEvadeSideways _ w = jumpleft -- (mv,mempty) where jumpleft = (mv,DoReplicate 5 (DoImpulses mv)) mv = [Walk (V2 0 d),UpdateRandGen] d = evalState (takeOne [3,-3]) (w ^. randGen) performAimAt :: Creature -> World -> Int -> Point2 -> ActionUpdate performAimAt cr w tcid p = ([TurnToward tpos aimSp], AimAt tcid tpos) where cdir = _crDir cr cpos = cr ^. crPos . _xy canSee' = canSee (_crID cr) tcid w aimSp = case crMvType cr ^? mvAimSpeed of Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos) Nothing -> error "creature without aiming type" tpos | canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos . _xy | otherwise = p crPathing :: Creature -> (Point2 -> Point2 -> World -> Bool,S.Set EdgeObstacle -> Bool) crPathing cr = case cr ^. crStance . carriage of Flying {} -> (isFlyable, not . S.member (WallObstacle WallNotAutoOpen)) _ -> (isWalkable, not . pathEdgeObstructed) performPathTo :: Action -> Creature -> World -> Point2 -> ActionUpdate performPathTo a cr w p | dist cpos p <= crRad (cr ^. crType) = (mempty,NoAction) | fst (crPathing cr) cpos p w = gotowards p | otherwise = case uncurry pointTowardsImpulse' (crPathing cr) cpos p w of Just q -> gotowards q _ -> ([], a) where gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , PathTo p a) cpos = cr ^. crPos . _xy jit = _mvTurnJit $ crMvType cr performTurnToA :: Creature -> Point2 -> ActionUpdate performTurnToA cr p | angleVV cdirv dirv < 0.1 = (mempty,NoAction) | otherwise = ([MvTurnToward p, RandomTurn jit], TurnToPoint p) where cpos = cr ^. crPos . _xy cdirv = unitVectorAtAngle (_crDir cr) dirv = p -.- cpos jit = _mvTurnJit $ crMvType cr --setMinInvSize :: Int -> Creature -> World -> World --setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n --organiseInvKeys :: Int -> World -> World --organiseInvKeys cid w = -- w & cWorld . lWorld . creatures . ix cid -- %~ ( (crInvSel . iselPos .~ newSelKey) -- . (crInv .~ newInv) -- . (crInvSel . iselAction .~ NoInvSelAction) -- ) -- where -- cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid -- pairs = IM.toList (_crInv cr) -- newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs -- newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs -- why not a cid (Int)? dropItem :: Creature -> Int -> World -> World dropItem cr invid w' = doanyitemdropeffect . maybeshiftseldown . copyItemToFloor (cr ^. crPos . _xy) itm -- . mayberemoveequip . rmInvItem (_crID cr) (NInt invid) -- it is important -- to do this before copying the item to the floor! . soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) whiteNoiseFadeOutS Nothing $ w' where --doanyitemdropeffect = fromMaybe id $ do -- rmf <- itm ^? itEffect . ieOnDrop -- return $ doInvEffect rmf itm cr doanyitemdropeffect = itEffectOnDrop itm cr itm = fromMaybe (error "dropItem cannot find item") $ do itid <- cr ^? crInv . ix (NInt invid) w' ^? cWorld . lWorld . items . ix itid maybeshiftseldown w = fromMaybe w $ do 3 <- w ^? hud . diSelection . _Just . slSec return $ w & hud . diSelection . _Just . slInt +~ 1 -- | Get your creature to drop the item under the cursor. youDropItem :: World -> World youDropItem w = fromMaybe w $ do curpos <- cr ^? crManipulation . manObject . imSelectedItem . unNInt <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap)) guard $ not $ w ^. cWorld . lWorld . lInvLock return $ case cr ^. crStance . posture of Aiming{} -> throwItem w AtEase -> dropItem cr curpos w where cr = you w -- placeholder, remember to deal with two handed weapon twist -- should throw all attached items? throwItem :: World -> World throwItem = id