317 lines
12 KiB
Haskell
317 lines
12 KiB
Haskell
module Dodge.Creature.State (
|
|
-- crUpdate,
|
|
doDamage,
|
|
invItemEffs,
|
|
) where
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Linear
|
|
import NewInt
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import Data.Monoid
|
|
import Dodge.Base
|
|
import Dodge.BaseTriggerType
|
|
import Dodge.Creature.Damage
|
|
import Dodge.Creature.Impulse.Movement
|
|
import Dodge.Creature.Test
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
--import Dodge.Data.DoubleTree
|
|
import Dodge.Data.World
|
|
import Dodge.DoubleTree
|
|
import Dodge.Euse
|
|
import Dodge.HeldUse
|
|
import Dodge.Inventory.SelectionList
|
|
import Dodge.Item.BackgroundEffect
|
|
import Dodge.Item.Grammar
|
|
import Dodge.Item.HeldOffset
|
|
import Dodge.Item.Location
|
|
import Dodge.Item.MaxAmmo
|
|
import Dodge.SoundLogic
|
|
import Dodge.Targeting.Draw
|
|
import Dodge.Zoning.Creature
|
|
import FoldableHelp
|
|
import Geometry
|
|
import LensHelp
|
|
import qualified Quaternion as Q
|
|
import RandomHelp
|
|
import qualified SDL
|
|
|
|
doDamage :: Int -> World -> World
|
|
doDamage cid w = fromMaybe w $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix cid
|
|
return $ applyPastDamages cr $ applyCreatureDamage (cr ^. crDamage) cr w
|
|
|
|
-- TODO generalise shake to arbitrary damage amounts
|
|
applyPastDamages :: Creature -> World -> World
|
|
applyPastDamages cr w
|
|
| _crPain cr > 200 = dojitter 3 100
|
|
| _crPain cr > 20 = dojitter 2 10
|
|
| _crPain cr > 0 = dojitter 1 1
|
|
| otherwise = w
|
|
where
|
|
dojitter x y =
|
|
let (p, g) = runState (randInCirc x) (_randGen w)
|
|
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p (w ^. cWorld . lWorld)
|
|
& cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ y
|
|
& randGen .~ g
|
|
|
|
-- a loop going over all root inventory items
|
|
invItemEffs :: Int -> World -> World
|
|
invItemEffs cid w = fromMaybe w $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix cid
|
|
return . appEndo (
|
|
foldMap
|
|
(reduceLocDT (Endo . invItemLocUpdate cr) . LocDT TopDT)
|
|
(invDT' $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) (_crInv cr))) $ w
|
|
|
|
invItemLocUpdate :: Creature -> LocationDT OItem -> World -> World
|
|
invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
|
|
ATTACH BULLETSYNTH -> trySynthBullet loc w
|
|
ATTACH CAPACITOR -> tryDrawToCapacitor loc w
|
|
EQUIP WRIST_ECG | haspulse -> tryUseParent loc w
|
|
COPIER _ -> copierItemUpdate itm cr w
|
|
HELD FLATSHIELD -> rootAndAttNotEff createShieldWall removeShieldWall itm cr w
|
|
HELD MINIGUNX{} -> coolMinigun itm w
|
|
HELD MACHINEPISTOL{} -> coolMachinePistol cr itm w
|
|
LASER | loc ^. locDT . dtValue . _2 == WeaponTargetingSF
|
|
, itm ^? itLocation . ilIsAttached == Just True -> shineTargetLaser cr loc w
|
|
HELD LED
|
|
| itm ^? itLocation . ilIsAttached == Just True -> shineTorch cr loc w
|
|
TARGETING tt
|
|
| itm ^? itLocation . ilIsAttached == Just True -> updateItemTargeting tt cr itm w
|
|
ARHUD
|
|
| itm ^? itLocation . ilIsAttached == Just True -> drawARHUD loc w
|
|
_ -> w
|
|
where
|
|
haspulse =
|
|
w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress
|
|
== Just 0
|
|
itm = loc ^. locDT . dtValue . _1
|
|
|
|
coolMinigun :: Item -> World -> World
|
|
coolMinigun itm
|
|
| itm ^? itParams . isWarming == Just True = d . isWarming .~ False
|
|
| otherwise = d . wTime %~ (max 0 . subtract 1)
|
|
where
|
|
d = pointerToItem itm . itParams
|
|
|
|
coolMachinePistol :: Creature -> Item -> World -> World
|
|
coolMachinePistol cr itm w
|
|
| fromMaybe 0 (itm ^? itParams . wTime) >= _coolEnd (baseItemTriggerType itm) =
|
|
w & d . wTime .~ 0
|
|
& d . coolSound .~ Nothing
|
|
| fromMaybe 0 (itm ^? itParams . wTime) == _coolStart (baseItemTriggerType itm) =
|
|
w
|
|
& randGen .~ g
|
|
& d . wTime +~ 1
|
|
& d . coolSound ?~ sid
|
|
& dosound sid
|
|
| fromMaybe 0 (itm ^? itParams . wTime) > _coolStart (baseItemTriggerType itm) =
|
|
w
|
|
& d . wTime +~ 1
|
|
& dosound (fromMaybe undefined (itm ^? itParams . coolSound . _Just))
|
|
| itm ^? itParams . isWarming == Just True = w & d . isWarming .~ False
|
|
| fromMaybe 0 (itm ^? itParams . wTime) >= _warmStart (baseItemTriggerType itm) =
|
|
w & d . wTime .~ _coolStart (baseItemTriggerType itm)
|
|
| otherwise = w & d . wTime .~ 0
|
|
where
|
|
dosound s =
|
|
soundContinue
|
|
(CrWeaponSound (_crID cr) (fromIntegral $ _itID itm))
|
|
(cr ^. crPos . _xy)
|
|
s
|
|
(Just 1)
|
|
d = pointerToItem itm . itParams
|
|
(sid, g) = runState (takeOne [whirdownSmall1S, whirdownSmall2S]) (w ^. randGen)
|
|
|
|
copierItemUpdate :: Item -> Creature -> World -> World
|
|
copierItemUpdate itm cr w = fromMaybe w $ do
|
|
x <- itm ^? itScroll . itsInt
|
|
invid <- itm ^? itLocation . ilInvID
|
|
ip <- itm ^? itType . ibtPathing
|
|
i <- getInventoryPath x ip (_unNInt invid) cr
|
|
itm' <- cr ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k
|
|
v <- getItemValue itm' w cr
|
|
return $ w & pointerToItem itm . itUse . uValue .~ v
|
|
|
|
doAnyEquipmentEffect :: LocationDT OItem -> Creature -> World -> World
|
|
doAnyEquipmentEffect loc cr = maybe id (equipBackgroundEffect loc cr)
|
|
$ loc ^? locDT . dtValue . _1 . itLocation . ilEquipSite . _Just
|
|
|
|
tryUseParent :: LocationDT OItem -> World -> World
|
|
tryUseParent loc w = fromMaybe w $ do
|
|
t <- locUp' loc
|
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
|
return $ gadgetEffect 0 t cr w
|
|
|
|
tryDrawToCapacitor :: LocationDT OItem -> World -> World
|
|
tryDrawToCapacitor loc w = fromMaybe w $ do
|
|
itm <- loc ^? locDT . dtValue . _1
|
|
i <- itm ^? itID . unNInt
|
|
x <- loc ^? locDT . dtValue . _1 . itConsumables . _Just
|
|
guard $ x < 200
|
|
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
|
|
j <- bat ^? itID . unNInt
|
|
y <- bat ^? itConsumables . _Just
|
|
let z = min y 10
|
|
return $ w
|
|
& invpoint . ix i . itConsumables . _Just +~ z
|
|
& invpoint . ix j . itConsumables . _Just -~ z
|
|
where
|
|
invpoint = cWorld . lWorld . items
|
|
|
|
trySynthBullet :: LocationDT OItem -> World -> World
|
|
trySynthBullet loc w = fromMaybe w $ do
|
|
i <- itm ^? itID . unNInt
|
|
x <- itm ^? itUse . uaParams . apInt
|
|
if x < 100
|
|
then do
|
|
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
|
|
j <- bat ^? itID . unNInt
|
|
y <- bat ^. itConsumables
|
|
guard $ y > 0
|
|
return $ w
|
|
& invpoint . ix i . itUse . uaParams . apInt +~ 1
|
|
& invpoint . ix j . itConsumables . _Just -~ 1
|
|
else do
|
|
mag <- loc ^? locDtContext . cdtParent . _1
|
|
j <- mag ^? itID . unNInt
|
|
y <- mag ^. itConsumables
|
|
ymax <- maxAmmo mag
|
|
guard $ y < ymax
|
|
return $ w
|
|
& invpoint . ix i . itUse . uaParams . apInt .~ 0
|
|
& invpoint . ix j . itConsumables . _Just +~ 1
|
|
where
|
|
itm = loc ^. locDT . dtValue . _1
|
|
invpoint = cWorld . lWorld . items
|
|
|
|
drawARHUD :: LocationDT OItem -> World -> World
|
|
drawARHUD (LocDT con _) w = fromMaybe w $ do
|
|
itm <- con ^? cdtParent . _1
|
|
return $
|
|
w & cWorld . lWorld . flares
|
|
<>~ fold
|
|
(drawTargetingAR itm w <|> drawMapperAR itm w)
|
|
|
|
shineTargetLaser :: Creature -> LocationDT OItem -> World -> World
|
|
shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
|
|
guard (crIsAiming cr)
|
|
mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
|
|
i <- mag ^. dtValue . _1 . itConsumables
|
|
guard $ i >= x
|
|
magitid <- mag ^? dtValue . _1 . itID . unNInt
|
|
return $
|
|
w
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& cWorld . lWorld . items
|
|
. ix magitid
|
|
. itConsumables
|
|
. _Just
|
|
-~ x
|
|
& cWorld . lWorld . lasers
|
|
.:~ Laser
|
|
{ _lpPhaseV = 1
|
|
, _lpDir = _crDir cr + argV (Q.qToV2 q)
|
|
, _lpPos = pos
|
|
-- , _lpColor = col
|
|
, _lpType = TargetingLaser (_itID itm)
|
|
}
|
|
where
|
|
o = locOrient loc cr
|
|
itmtree = loc ^. locDT
|
|
(p, q) = o `Q.comp` (V3 5 0 0, Q.qID)
|
|
x = 1
|
|
isammolink AmmoMagSF{} = True
|
|
isammolink _ = False
|
|
pos = cr ^. crPos . _xy + xyV3 (rotate3z cdir p)
|
|
cdir = _crDir cr
|
|
itm = itmtree ^. dtValue . _1
|
|
pointittarg = cWorld . lWorld . items . ix itid . itTargeting
|
|
itid = itm ^. itID . unNInt
|
|
|
|
shineTorch :: Creature -> LocationDT OItem -> World -> World
|
|
shineTorch cr loc = fromMaybe id $ do
|
|
mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
|
|
i <- mag ^. dtValue . _1 . itConsumables
|
|
-- guard $ crIsAiming cr
|
|
guard $ i >= x
|
|
itid <- mag ^? dtValue . _1 . itID . unNInt
|
|
return $
|
|
(cWorld . lWorld . lights .:~ LSParam pos 150 0.3)
|
|
. (cWorld . lWorld . lights .:~ LSParam (pos + V3 0 0 15) 50 0.3)
|
|
. (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x)
|
|
where
|
|
itmtree = loc ^. locDT
|
|
(p, q) = locOrient loc cr
|
|
x = 10
|
|
isammolink AmmoMagSF{} = True
|
|
isammolink _ = False
|
|
pos = _crPos cr + rotate3z cdir (p + Q.rotate q (V3 5 0 1.5))
|
|
cdir = _crDir cr
|
|
|
|
-- this probably needs to be set to null when dropped as well?
|
|
-- does this need to be updated if it is not attached to the used root item?
|
|
updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
|
|
updateItemTargeting tt cr itm w = case tt of
|
|
_
|
|
| not isattached ->
|
|
w
|
|
& pointittarg . itTgPos .~ Nothing
|
|
& pointittarg . itTgActive .~ False
|
|
TargetRBPress
|
|
| rbpressed ->
|
|
w
|
|
& pointittarg . itTgPos %~ maybe (Just $ w ^. cWorld . lWorld . lAimPos) Just
|
|
& pointittarg . itTgActive .~ True
|
|
TargetRBPress ->
|
|
w
|
|
& pointittarg . itTgPos .~ Nothing
|
|
& pointittarg . itTgActive .~ False
|
|
TargetRBCreature -> w & pointittarg %~ setRBCreatureTargeting cr w
|
|
TargetCursor ->
|
|
w
|
|
& pointittarg
|
|
.~ ItTargeting
|
|
(Just (w ^. cWorld . lWorld . lAimPos))
|
|
Nothing
|
|
True
|
|
where
|
|
pointittarg = cWorld . lWorld . items . ix itid . itTargeting
|
|
itid = itm ^. itID . unNInt
|
|
isattached = itm ^?! itLocation . ilIsAttached
|
|
rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
|
|
|
|
setRBCreatureTargeting :: Creature -> World -> ItemTargeting -> ItemTargeting
|
|
setRBCreatureTargeting cr w ituse
|
|
| SDL.ButtonRight `M.member` _mouseButtons (_input w)
|
|
, isJust (ituse ^? itTgID . _Just)
|
|
, canSeeTarget =
|
|
ituse & updatePos & itTgActive .~ True
|
|
| otherwise = ituse & itTgID .~ fmap _crID newtarg & updatePos & itTgActive .~ False
|
|
where
|
|
newtarg =
|
|
safeMinimumOn (dist mwp . (^. crPos . _xy))
|
|
. filter (canseepos . (^. crPos . _xy))
|
|
. IM.elems
|
|
$ crsNearCirc mwp 40 w
|
|
canseepos p = hasLOS ((^. crPos . _xy) cr) p w
|
|
mwp = w ^. cWorld . lWorld . lAimPos
|
|
updatePos t' = t' & itTgPos .~ posFromMaybeID (_itTgID t')
|
|
posFromMaybeID Nothing = Nothing
|
|
posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos . _xy
|
|
canSeeTarget = fromMaybe False $ do
|
|
cid <- ituse ^? itTgID . _Just
|
|
cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos . _xy
|
|
Just $ hasLOS cpos ( cr ^. crPos . _xy) w
|
|
|
|
--isFrictionless :: Creature -> Bool
|
|
--isFrictionless cr = case cr ^? crStance . carriage of
|
|
-- Just (Boosting _) -> True
|
|
-- Just Floating -> True
|
|
-- _ -> False
|