justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup code for your control

Browse Source
This commit is contained in:
justin
2024-10-03 10:08:13 +01:00
parent 844bb486e6
commit 3b75ab73aa
4 changed files with 141 additions and 174 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/State.hs
+43 -30
View File
@@ -3,7 +3,6 @@ module Dodge.Creature.State (
doDamage,
) where
import Dodge.LightSource
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
@@ -24,6 +23,7 @@ import Dodge.Hammer
import Dodge.ItEffect
import Dodge.Item.Grammar
import Dodge.Item.HeldOffset
import Dodge.LightSource
import Dodge.Prop.Gib
import Dodge.SoundLogic
--import Dodge.WorldEvent.Flash
@@ -73,9 +73,11 @@ stateUpdate f =
checkDeath :: Creature -> World -> World
checkDeath cr w
| _crHP cr > 0 = w
| _crHP cr > 0 =
w
& cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
| otherwise = w
| otherwise =
w
& dropByState cr
& removecr
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
@@ -192,26 +194,27 @@ chainLinkOrientation mo par (ILink lt f) child = (p + Q.rotate q p1, q * q1)
(p, q) = mo
(p1, q1) = f par lt child
updateItemWithOrientation :: Creature -> (Point3, Q.Quaternion Float)
-> LabelDoubleTree ItemLink Item
-> World -> World
updateItemWithOrientation ::
Creature ->
(Point3, Q.Quaternion Float) ->
LabelDoubleTree ItemLink Item ->
World ->
World
updateItemWithOrientation cr m itmtree = case _itType itm of
HELD TORCH -> shineTorch cr itmtree m
_ -> id
where
itm = itmtree ^. ldtValue
shineTorch :: Creature -> LabelDoubleTree ItemLink Item -> (Point3, Q.Quaternion Float) -> World -> World
shineTorch cr itmtree (p,q) = fromMaybe id $ do
(_,mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
shineTorch cr itmtree (p, q) = fromMaybe id $ do
(_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
i <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
guard $ i >= x
invid <- mag ^? ldtValue . itLocation . ilInvID
return $
(cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 pos'')
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . amagLoadStatus . iaLoaded -~ x)
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . amagLoadStatus . iaLoaded -~ x)
where
x = 10
isammolink AmmoInLink{} = True
@@ -219,39 +222,49 @@ shineTorch cr itmtree (p,q) = fromMaybe id $ do
pos = (_crPos cr `v2z` 0 + rotate3 cdir p)
pos'' = pos + rotate3 d (V3 8 0 1.5)
cdir = _crDir cr
a = argV (Q.qToV2 q)
d = _crDir cr + a
d = _crDir cr + argV (Q.qToV2 q)
itemInvSideEffect :: Creature -> Item -> World -> World
itemInvSideEffect cr itm = case _itType itm of
TARGETING tt -> updateItemTargeting tt cr itm
_ -> id
-- this probably needs to be set to null when dropped as well?
updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
updateItemTargeting tt cr itm w = case tt of
_ | not isattached -> w
& pointItUse . tgPos .~ Nothing
& pointItUse . tgActive .~ False
TARGETLASER | crIsAiming cr -> w
& cWorld . lWorld . lasers .:~ LaserStart
_
| not isattached ->
w
& pointItUse . tgPos .~ Nothing
& pointItUse . tgActive .~ False
TARGETLASER
| crIsAiming cr ->
w
& cWorld . lWorld . lasers
.:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetingLaser (_itID itm)
}
TARGETLASER -> w & pointItUse . tgPos .~ Nothing
TargetRBPress | rbpressed -> w
& pointItUse . tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
& pointItUse . tgActive .~ True
TargetRBPress -> w
TARGETLASER -> w & pointItUse . tgPos .~ Nothing
TargetRBPress
| rbpressed ->
w
& pointItUse . tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
& pointItUse . tgActive .~ True
TargetRBPress ->
w
& pointItUse . tgPos .~ Nothing
& pointItUse . tgActive .~ False
TargetRBCreature -> w & pointItUse %~ setRBCreatureTargeting cr w
TargetCursor -> w & pointItUse .~ TargetingUse
(Just (mouseWorldPos (w ^. input) (w ^. wCam)))
Nothing
True
TargetRBCreature -> w & pointItUse %~ setRBCreatureTargeting cr w
TargetCursor ->
w & pointItUse
.~ TargetingUse
(Just (mouseWorldPos (w ^. input) (w ^. wCam)))
Nothing
True
where
pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
cid = _crID cr
@@ -264,7 +277,8 @@ updateItemTargeting tt cr itm 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 =
@@ -292,7 +306,6 @@ useUpdate =
. (heldDelay . warmTime %~ decreaseToZero)
. (heldDelay . rateTime %~ decreaseToZero)
updateAutoRecharge :: Item -> Item
updateAutoRecharge it = case it ^? itUse . leftConsumption of
Just (AutoRecharging l m t p)