--{-# LANGUAGE TupleSections #-} -- | Actions performed by creatures within the world module Dodge.Creature.Action ( performActions, -- stripNoItems, setMinInvSize, -- dropUnselected, dropExcept, dropItem, blinkActionMousePos, blinkActionFail, unsafeBlinkAction, sizeSelf, youDropItem, pickUpItem, -- pickUpItemID, ) where import Control.Applicative --import Data.List (findIndex) import Control.Monad import Data.Bifunctor import Data.Maybe import Dodge.Base import Dodge.Creature.Action.Blink import Dodge.CreatureEffect import Dodge.Data.SelectionList import Dodge.Data.World import Dodge.Default import Dodge.FloatFunction import Dodge.FloorItem import Dodge.Inventory import Dodge.Inventory.Add import Dodge.Path import Dodge.SoundLogic import Dodge.WallCreatureCollisions import Geometry import qualified IntMapHelp as IM import LensHelp performActions :: World -> Creature -> Creature performActions w cr = cr & crActionPlan . apImpulse .~ concat iss & crActionPlan . apAction .~ catMaybes mayas where (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . apAction type OutAction = ([Impulse], Maybe Action) performAimAt :: Creature -> World -> Int -> Point2 -> OutAction performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos) where cdir = _crDir cr cpos = _crPos cr canSee' = canSee (_crID cr) tcid w aimSp = case cr ^? crMvType . 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 | otherwise = p performPathTo :: Creature -> World -> Point2 -> OutAction performPathTo cr w p | dist cpos p <= _crRad cr = ([], Nothing) | isWalkable cpos p w = ([MvTurnToward p, MvForward, RandomTurn jit], Just (PathTo p)) | otherwise = case pointTowardsImpulse p cpos w of Just q -> ( [ MvTurnToward q , MvForward , RandomTurn jit ] , Just (PathTo p) ) _ -> ([], Nothing) where cpos = _crPos cr jit = _mvTurnJit $ _crMvType cr performTurnToA :: Creature -> Point2 -> OutAction performTurnToA cr p | angleVV cdirv dirv < 0.1 = ([], Nothing) | otherwise = ([MvTurnToward p, RandomTurn jit], Just (TurnToPoint p)) where cpos = _crPos cr cdirv = unitVectorAtAngle (_crDir cr) dirv = p -.- cpos jit = _mvTurnJit $ _crMvType cr {- | Performing an action on a frame creates an OutAction: adds impulses and updates or deletes the action itself. -} performAction :: Creature -> World -> Action -> OutAction performAction cr w ac = case ac of ActionNothing -> ([], Nothing) LabelAction str subAc -> second (fmap (LabelAction str)) $ performAction cr w subAc AimAt tcid p -> performAimAt cr w tcid p WaitThen 0 newAc -> ([], Just newAc) WaitThen t newAc -> ([], Just (WaitThen (t -1) newAc)) ImpulsesList (xs : xss) -> (xs, Just $ ImpulsesList xss) ImpulsesList _ -> ([], Nothing) DoImpulses imps -> (imps, Nothing) DoActionThen fsta afta -> case performAction cr w fsta of (imps, Just nxta) -> (imps, Just (DoActionThen nxta afta)) (imps, Nothing) -> (imps, Just 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, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc) (imps, Nothing) -> (imps, Just $ DoActionWhilePartial resetAc f resetAc) | otherwise -> performAction cr w partAc DoActionIf f ifa | doWdCrBl f w cr -> performAction cr w ifa | otherwise -> ([], Nothing) 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, Just $ DoActionWhileInterrupt repa f afta) | otherwise -> performAction cr w afta DoActions [] -> ([], Nothing) DoActions acs -> let (imps, newAcs) = unzip $ map (performAction cr w) acs in (concat imps, Just . DoActions $ catMaybes newAcs) StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing) PathTo p -> performPathTo cr w p TurnToPoint p -> performTurnToA cr p LeadTarget p -> case cr ^? crIntention . targetCr . _Just of Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing) _ -> ([], Nothing) UseTarget f -> performAction cr w $ doMCrAc f $ cr ^? crIntention . targetCr . _Just UseSelf f -> performAction cr w $ doCrAc f cr UseAheadPos f -> performAction cr w (doP2Ac f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) UseMvTargetPos f -> performAction cr w $ doMP2Ac f $ _mvToPoint $ _crIntention cr ArbitraryAction f -> performAction cr w (doCrWdAc f cr w) DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of (imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac) (imp, _) -> (sideImp ++ imp, Nothing) 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, Just nextac) -> (imps, Just $ DoReplicatePartial startac t nextac) (imps, _) -> (imps, Just $ DoReplicatePartial startac (t -1) startac) NoAction -> ([], Nothing) setMinInvSize :: Int -> Creature -> World -> World setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n ---- maybe this should be removed... --stripNoItems :: Creature -> World -> World --stripNoItems cr = -- organiseInvKeys (_crID cr) -- . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just) -- --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 dropExcept :: Creature -> Int -> World -> World dropExcept cr invid w = foldr (dropItem cr) w . IM.keys $ invid `IM.delete` _crInv cr dropItem :: Creature -> Int -> World -> World dropItem cr invid = rmInvItem (_crID cr) invid . copyItemToFloor (_crPos cr) itm -- . mayberemoveequip where itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid -- | Get your creature to drop the item under the cursor. youDropItem :: World -> World youDropItem w = fromMaybe w $ do curpos <- you w ^? crManipulation . manObject . imSelectedItem <|> fmap fst (IM.lookupMax =<< w ^? hud . hudElement . diSections . ix 0 . ssItems) guard $ not $ _crInvLock (you w) return $ w & dropItem cr curpos & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing where cr = you w sizeSelf :: Float -> Creature -> World -> Maybe World sizeSelf x cr w | not (crOnWall cr1 w) = Just $ w & soundMultiFrom [TeleSound 0, TeleSound 1] cpos teleS Nothing & cWorld . lWorld . distortions .:~ distortionBulge & cWorld . lWorld . creatures . ix cid %~ ( (crRad .~ 10 * x) . (crMvType . mvSpeed .~ yourDefaultSpeed * x) . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x)) ) | otherwise = Nothing where cr1 = colCrWall w (cr{_crRad = 10 * x}) distR = 120 distortionBulge | _crRad cr < 10 * x = raddist 1.9 | otherwise = raddist 0.1 raddist = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) cid = _crID cr cpos = _crPos cr