Work on orienting and drawing attachments
This commit is contained in:
+77
-65
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user