{- | Actions performed by creatures within the world -} module Dodge.Creature.Action ( performActionsR , startReloadingWeapon , blinkAction , crAutoReload , copyItemToFloor , youDropItem , pickUpItem ) where import Dodge.Path import Dodge.Creature.Stance.Data import Dodge.WorldEvent.Shockwave import Dodge.Data import Dodge.Base import Dodge.Base.Zone import Dodge.Base.Collide import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms --import Dodge.WorldEvent import Dodge.Inventory --import Dodge.LightSources import Geometry import Picture import qualified IntMapHelp as IM import Control.Lens --import Control.Monad --import Control.Applicative import Data.Maybe --import Data.List import System.Random import Control.Monad.Reader --import qualified Data.Map as M performActions :: World -> Creature -> Creature performActions w cr = cr & crActionPlan . crImpulse .~ concat iss & crActionPlan . crAction .~ catMaybes mayas where (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction performActionsR :: Creature -> Reader World Creature performActionsR cr = reader $ \w -> performActions w cr 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 -> f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos) Nothing -> error "creature without aiming type" tpos | canSee' = _crPos (_creatures w IM.! tcid) | otherwise = p performPathTo :: Creature -> World -> Point2 -> OutAction performPathTo cr w p | dist cpos p < 5 = ([], Nothing) | hasLOS cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p)) | otherwise = case pointTowardsImpulse cpos p w of Just q -> ([MvTurnToward q,MvForward,RandomTurn jit] , Just (PathTo p)) _ -> ([],Nothing) where cpos = _crPos cr jit = _mvTurnJit $ _crMvType cr {- | Performing an action means that a creature has some impulses for a frame, and updates or deletes the action itself. -- doAction -} performAction :: Creature -> World -> Action -> OutAction performAction cr w ac = case ac of 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 | 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 | f (w,cr) -> performAction cr w ifa | otherwise -> ([],Nothing) DoActionIfElse ifa f elsea | f (w,cr) -> performAction cr w ifa | otherwise -> performAction cr w elsea DoActionWhileInterrupt repa f afta | 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 LeadTarget p -> case cr ^? crTarget . _Just of Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing) _ -> ([], Nothing) UseTarget f -> performAction cr w $ f $ cr ^? crTarget . _Just UseSelf f -> performAction cr w $ f cr UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) UseMvTargetPos f -> performAction cr w $ f $ _crMvTarget cr ArbitraryAction f -> performAction cr w (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 sac t pac -> case performAction cr w pac of (imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac) (imps , _) -> (imps, Just $ DoReplicatePartial sac (t-1) sac) NoAction -> ([],Nothing) startReloadingWeapon :: Creature -> World -> Maybe World startReloadingWeapon cr w = let cid = _crID cr it = _crInv cr IM.! _crInvSel cr itRef = creatures . ix cid . crInv . ix (_crInvSel cr) in case it of Weapon {_wpMaxAmmo=maxA,_wpLoadedAmmo=lA,_wpReloadState=rS,_wpReloadTime=rT} | lA < maxA && rS == 0 -> Just $ set ( itRef . wpLoadedAmmo) maxA $ set ( itRef . wpReloadState) rT w _ -> Nothing {- | Start reloading if clip is empty. -} crAutoReload :: Creature -> Creature crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of Just 0 | _posture (_crStance cr) /= Aiming -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT) & crInv . ix (_crInvSel cr) . wpLoadedAmmo %~ (`fromMaybe` maxA) _ -> cr where reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo {- | Teleport a creature to the mouse position -} blinkAction :: Creature -> World -> World blinkAction cr w = soundOnce teleSound . over radDistortion (distortionBulge ++) . set (creatures . ix cid . crPos) p3 . blinkShockwave cid p3 $ inverseShockwaveAt cpos 40 2 2 2 w where distR = 120 distortionBulge = [(p3,p3 +.+ V2 distR 0, p3 +.+ V2 0 distR,0.1) ,(cpos,cpos +.+ V2 distR 0, cpos +.+ V2 0 distR,1.9) ] cid = _crID cr p1 = mouseWorldPos w cpos = _crPos cr p2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w r = 1.5 * _crRad cr p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2 blinkShockwave :: Int -- ^ Blinking creature ID. -> Point2 -> World -> World blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan {- | Get your creature to drop the item under the cursor. -} youDropItem :: World -> World youDropItem w = case yourItem w of NoItem -> w _ -> rmSelectedInvItem (_yourID w) . copyItemToFloor (you w) (_crInvSel $ you w) $ soundOnce putDownSound w {- | Copy an inventory item to the floor. -} copyItemToFloor :: Creature -> Int -- ^ Inventory position -> World -> World copyItemToFloor cr i w = case _crInv cr IM.! i of NoItem -> w it -> over floorItems (IM.insert flid theflit) . updateLocation $ set randGen g w where (rot, g) = randomR (-pi,pi) $ _randGen w offset = (_crRad cr + 2) *.* unitVectorAtAngle rot updateLocation w' = case it ^? itID of Just (Just i') -> w' & itemPositions . ix i' .~ OnFloor flid _ -> w' flid = IM.newKey $ _floorItems w theflit = FlIt {_flIt = it ,_flItPos = offset +.+ _crPos cr ,_flItRot = rot ,_flItID = flid } {- | Pick up a specific item. -} pickUpItem :: Int -- ^ Creature id -> FloorItem -> World -> World pickUpItem cid flit w = case maybeInvSlot of Nothing -> w Just i -> w & soundOnce pickUpSound & updateItLocation i & floorItems %~ IM.delete (_flItID flit) & creatures . ix cid . crInv . ix i %~ addItem it where it = _flIt flit maybeInvSlot = checkInvSlotsYou it w updateItLocation invid w' = case _itID it of Nothing -> w' Just j -> w' & itemPositions . ix j .~ InInv 0 invid