Work on orienting and drawing attachments

This commit is contained in:
2024-09-30 23:02:22 +01:00
parent 48b8cfe7ef
commit 752b568a86
13 changed files with 340 additions and 229 deletions
+77 -65
View File
@@ -3,39 +3,32 @@ module Dodge.Creature.State (
doDamage,
) where
import Dodge.Zoning.Creature
import FoldableHelp
import Data.Maybe
import qualified Data.Map.Strict as M
import qualified SDL
import Dodge.Creature.Test
--import Dodge.Item.Display -- this should not really be imported... TODO move canAttachTargetingBelow
--import Control.Applicative
--import Data.Foldable
--import Data.Maybe
import Data.Maybe
import Data.Monoid
import Dodge.Base
import Dodge.Corpse.Make
import Dodge.Creature.Action
import Dodge.Creature.Damage
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.State.WalkCycle
--import Dodge.Creature.Test
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.World
import Dodge.EnergyBall
--import Dodge.Equipment
import Dodge.Euse
import Dodge.Hammer
import Dodge.ItEffect
--import Dodge.LightSource.Torch
import Dodge.Prop.Gib
import Dodge.SoundLogic
--import Dodge.Targeting
import Dodge.Zoning.Creature
import FoldableHelp
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Picture
import RandomHelp
import qualified SDL
import Shape
import ShapePicture
@@ -68,8 +61,8 @@ stateUpdate f =
, updateInv -- upInv must be called before invSideEff 22.05.23
, invSideEff
, equipmentEffects
-- , heldItemEffects
-- , heldAimEffects
-- , heldItemEffects
-- , heldAimEffects
]
--heldItemEffects :: Creature -> World -> World
@@ -85,8 +78,9 @@ stateUpdate f =
checkDeath :: Creature -> World -> World
checkDeath cr w
| _crHP cr > 0 = w
& cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
| _crHP cr > 0 =
w
& cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
| otherwise =
w
-- & creatures . at (_crID cr) .~ Nothing
@@ -154,7 +148,7 @@ internalHammerUpdate :: Creature -> World -> World
internalHammerUpdate cr =
cWorld . lWorld . creatures . ix (_crID cr)
%~ ( (crHammerPosition %~ moveHammerUp)
-- . stepReloading
-- . stepReloading
. updateMovement
)
@@ -236,25 +230,23 @@ updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.map ite
-- a loop going over equipped items
equipmentEffects :: Creature -> World -> World
equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
--equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
equipmentEffects cr = alaf Endo foldMap (useEquipment cr) (IM.keys $ _crInvEquipped cr)
-- a loop going over all inventory items
invSideEff :: Creature -> World -> World
invSideEff cr w =
-- updateTargeting (crGetTargeting cr) cr $
-- weaponReloadSounds cr $
IM.foldl' f w (_crInv cr)
invSideEff cr = alaf Endo foldMap f (_crInv cr)
where
-- be careful with side effects that affect creature targeting
f w' it =
itemInvSideEffect cr it $
--doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
f it =
itemInvSideEffect cr it
. maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
itemInvSideEffect :: Creature -> Item -> World -> World
itemInvSideEffect cr itm = case _itType itm of
TARGETING tt -> updateItemTargeting tt cr itm
_ -> id
_ -> id
--itemInvSideEffect cr it
-- | hastorchattach = createAttachLight cr it
-- | otherwise = id
@@ -267,39 +259,57 @@ itemInvSideEffect cr itm = case _itType itm of
-- attachoff = it ^?! itDimension . dimAttachPos
updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
updateItemTargeting tt cr itm w = w & case tt of
_ | not isattached
-> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TARGETLASER | crIsAiming cr -> cWorld . lWorld . lasers
.:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetingLaser (_itID itm)
}
TARGETLASER -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse . tgPos .~ Nothing
TargetRBPress | rbpressed
-> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
( (tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just)
. (tgActive .~ True)
)
TargetRBPress
-> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TargetRBCreature -> cWorld . lWorld . creatures . ix (_crID cr)
. crInv . ix (_ilInvID $ _itLocation itm) . itUse %~ setRBCreatureTargeting cr w
TargetCursor -> cWorld . lWorld . creatures . ix (_crID cr)
. crInv . ix (_ilInvID $ _itLocation itm) . itUse .~ TargetingUse
(Just (mouseWorldPos (w ^. input) (w ^. wCam))) Nothing True
where
isattached = itm ^?! itLocation . ilIsAttached
updateItemTargeting tt cr itm w =
w & case tt of
_
| not isattached ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TARGETLASER
| crIsAiming cr ->
cWorld . lWorld . lasers
.:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetingLaser (_itID itm)
}
TARGETLASER ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse
. tgPos
.~ Nothing
TargetRBPress
| rbpressed ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just)
. (tgActive .~ True)
)
TargetRBPress ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TargetRBCreature ->
cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix (_ilInvID $ _itLocation itm)
. itUse
%~ setRBCreatureTargeting cr w
TargetCursor ->
cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix (_ilInvID $ _itLocation itm)
. itUse
.~ TargetingUse
(Just (mouseWorldPos (w ^. input) (w ^. wCam)))
Nothing
True
where
isattached = itm ^?! itLocation . ilIsAttached
rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
@@ -307,7 +317,8 @@ updateItemTargeting tt cr itm w = w & case tt of
setRBCreatureTargeting :: Creature -> World -> ItemUse -> ItemUse
setRBCreatureTargeting cr w ituse
| SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? tgID . _Just)
&& canSeeTarget = ituse & updatePos & tgActive .~ True
&& canSeeTarget =
ituse & updatePos & tgActive .~ True
| otherwise = ituse & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False
where
newtarg =
@@ -328,6 +339,7 @@ itemUpdate :: Item -> Item
itemUpdate =
updateAutoRecharge
. (itUse %~ useUpdate)
-- . (itLocation .~ InInv (_crID cr) i itmisselected itmisroot)
-- where
-- itmisroot = Just i == (cr ^? crManipulation . manObject . inInventory . imRootItem)
@@ -340,7 +352,7 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
| l < m -> it & itUse . leftConsumption . arProgress -~ 1
_ -> it
--itemGetTargeting :: LabelDoubleTree ComposeLinkType Item
--itemGetTargeting :: LabelDoubleTree ComposeLinkType Item
-- I feel like there should be a centralised function that supersumes this
-- i.e. a function that deals with all states that depend upon item positioning
@@ -352,11 +364,11 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
-- itm ^? itType . iyModules . ix ModTarget . imtTargetType
-- <|> do
-- tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtTargeting
-- guard (canAttachTargeting tt itm)
-- guard (canAttachTargeting tt itm)
-- return tt
-- <|> do
-- tt <- cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just
-- guard (canAttachTargeting tt itm)
-- guard (canAttachTargeting tt itm)
-- return tt
--weaponReloadSounds :: Creature -> World -> World