232 lines
8.4 KiB
Haskell
232 lines
8.4 KiB
Haskell
{- | 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
|
|
|