Cleanup, remove jetpack

2024-10-02 18:23:49 +01:00
parent bac57a702d
commit effd89dc78
11 changed files with 120 additions and 212 deletions
@@ -3,13 +3,6 @@ module Dodge.Creature.State (
    doDamage,
 ) where

-import Dodge.WorldEvent.Flash
-import Dodge.Data.DoubleTree
-import Dodge.Item.HeldOffset
-import Dodge.DoubleTree
-import Dodge.Data.ComposedItem
-import qualified Quaternion as Q
-import Dodge.Item.Grammar
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.Monoid
@@ -21,24 +14,31 @@ import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.State.WalkCycle
 import Dodge.Creature.Test
 import Dodge.Damage
+import Dodge.Data.ComposedItem
+import Dodge.Data.DoubleTree
 import Dodge.Data.World
-import Dodge.EnergyBall
+import Dodge.DoubleTree
 import Dodge.Euse
 import Dodge.Hammer
 import Dodge.ItEffect
+import Dodge.Item.Grammar
+import Dodge.Item.HeldOffset
 import Dodge.Prop.Gib
 import Dodge.SoundLogic
+import Dodge.WorldEvent.Flash
 import Dodge.Zoning.Creature
 import FoldableHelp
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 import Picture
+import qualified Quaternion as Q
 import RandomHelp
 import qualified SDL
 import Shape
 import ShapePicture

+-- this can almost certainly be made more efficient
 foldCr ::
    [Creature -> World -> World] ->
    Creature ->
@@ -68,28 +68,13 @@ stateUpdate f =
        , updateInv -- upInv must be called before invSideEff 22.05.23
        , invSideEff
        , equipmentEffects
-        --        , heldItemEffects
-        --        , heldAimEffects
        ]

--heldItemEffects :: Creature -> World -> World
--heldItemEffects _ = id
-
--heldAimEffects :: Creature -> World -> World
--heldAimEffects cr = fromMaybe id $ do
--    guard (crIsAiming cr)
--    ipos <- cr ^? crManipulation . manObject . inInventory . ispItem
--    itm <- cr ^? crInv . ix ipos
--    f <- itm ^? itEffect . ieWhileAiming
--    return $ doInvEffect f itm cr
-
 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
            --        & creatures . at (_crID cr) .~ Nothing
            & dropByState cr
            & removecr
@@ -104,58 +89,25 @@ checkDeath cr w
        | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing

 corpseOrGib :: Creature -> World -> World
-corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
-    Just (FLAMING, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
-    Just (ELECTRICAL, _) -> w & plNew (cWorld . lWorld . corpses) cpID thecorpse
-    Just (POISONDAM, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
-    _
-        | _crPastDamage cr > 200 ->
-            w & addCrGibs cr
-                & bloodPuddleAt cpos
-                & bloodPuddleAt cpos
-                & bloodPuddleAt cpos
-    _ ->
-        w
-            & bloodPuddleAt cpos
-            & bloodPuddleAt cpos
-            & plNew (cWorld . lWorld . corpses) cpID thecorpse
+corpseOrGib cr = case maxDamageType (_csDamage (_crState cr)) of
+    Just (FLAMING, _) -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
+    Just (ELECTRICAL, _) -> plNew (cWorld . lWorld . corpses) cpID thecorpse
+    Just (POISONDAM, _) -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
+    _ | _crPastDamage cr > 200 -> addCrGibs cr
+    _ -> plNew (cWorld . lWorld . corpses) cpID thecorpse
  where
-    cpos = _crPos cr
    thecorpse = makeDefaultCorpse cr

 scorchSPic :: SPic -> SPic
-scorchSPic =
-    over _1 $
-        overColSH (mixColors 0.9 0.1 black . normalizeColor)
+scorchSPic = over _1 $ overColSH (mixColors 0.9 0.1 black . normalizeColor)

 poisonSPic :: SPic -> SPic
-poisonSPic =
-    over _1 $
-        overColSH (mixColors 0.5 0.5 green . normalizeColor)
-
--scorchSPic :: World -> SPic -> SPic
--scorchSPic w sp = evalState (scorchSPic' sp) (_randGen w)
--
--scorchSPic' :: SPic -> State StdGen SPic
--scorchSPic' = _1 $ overColSHM $ \col -> takeOne [col,black]
----    (return . mixColorsLinear 0.9 0.1 black)
-
-bloodPuddleAt :: Point2 -> World -> World
-bloodPuddleAt p w =
-    w
-        & snd
-            . plNewID
-                (cWorld . lWorld . decorations)
-                (color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
-        & randGen .~ g
-  where
-    (q, g) = randInCirc 10 & runState $ _randGen w
+poisonSPic = over _1 $ overColSH (mixColors 0.5 0.5 green . normalizeColor)

 internalHammerUpdate :: Creature -> World -> World
 internalHammerUpdate cr =
    cWorld . lWorld . creatures . ix (_crID cr)
        %~ ( (crHammerPosition %~ moveHammerUp)
-                --                . stepReloading
                . updateMovement
           )

@@ -169,10 +121,7 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o
    DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)

 doDamage :: Creature -> World -> World
-doDamage cr w =
-    w
-        & applyPastDamages cr
-        & applyCreatureDamage dams cr
+doDamage cr = applyPastDamages cr . applyCreatureDamage dams cr
  where
    dams = _csDamage $ _crState cr

@@ -194,29 +143,7 @@ applyPastDamages cr w
    | otherwise = w

 movementSideEff :: Creature -> World -> World
-movementSideEff cr w
-    | hasJetPack = case cr ^? crStance . carriage of
-        Just (Boosting v) ->
-            w
-                & randGen .~ g
-                & makeFlamelet
-                    (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
-                    20
-                    (momentum +.+ 1 *.* rotateV randDir (vInverse v))
-                    1
-                    20
-        _ -> w
-    | otherwise = footstepSideEffect cr w
-  where
-    hasJetPack = any (\it -> it ^? itType == Just (EQUIP JETPACK)) $ _crInv cr
-    oldPos = _crOldPos cr
-    momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
-    momentum''
-        | magV momentum' > 3 = 3 *.* normalizeV momentum'
-        | otherwise = momentum'
-    momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
-    (randDir, g) = randomR (-0.5, 0.5) $ _randGen w
-    (randAng, _) = randomR (0, 2 * pi) $ _randGen w
+movementSideEff = footstepSideEffect

 useUpdate :: ItemUse -> ItemUse
 useUpdate =
@@ -242,8 +169,9 @@ equipmentEffects cr = alaf Endo foldMap (useEquipment cr) (IM.keys $ _crInvEquip

 -- a loop going over all inventory items
 invSideEff :: Creature -> World -> World
-invSideEff cr = alaf Endo foldMap f (_crInv cr)
-    . updateRootItem cr
+invSideEff cr =
+    alaf Endo foldMap f (_crInv cr)
+        . updateRootItem cr
  where
    -- be careful with side effects that affect creature targeting
    f it =
@@ -257,22 +185,25 @@ updateRootItem cr = fromMaybe id $ do
    return $ updateRootItem' itmtree cr

 -- need to check rotation
-chainLinkOrientation 
-    :: Maybe (Point3, Q.Quaternion Float) 
-    -> Item 
-    -> ItemLink 
-    -> Item 
-    -> Maybe (Point3,Q.Quaternion Float)
+chainLinkOrientation ::
+    Maybe (Point3, Q.Quaternion Float) ->
+    Item ->
+    ItemLink ->
+    Item ->
+    Maybe (Point3, Q.Quaternion Float)
 chainLinkOrientation mo par (ILink lt f) child = do
-    (p,q) <- mo
-    (p1,q1) <- f par lt child
+    (p, q) <- mo
+    (p1, q1) <- f par lt child
    return (p + Q.rotate q1 p1, q * q1)

 updateRootItem' :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
-updateRootItem' itmtree cr = ldtPropagateFold chainLinkOrientation chainLinkOrientation
-    (updateItemWithOrientation cr)
-    (Just (heldItemRelativeOrient (_ldtValue itmtree) cr (0,Q.qID)))
-    itmtree
+updateRootItem' itmtree cr =
+    ldtPropagateFold
+        chainLinkOrientation
+        chainLinkOrientation
+        (updateItemWithOrientation cr)
+        (Just (heldItemRelativeOrient (_ldtValue itmtree) cr (0, Q.qID)))
+        itmtree

 updateItemWithOrientation :: Creature -> Maybe (Point3, Q.Quaternion Float) -> Item -> World -> World
 updateItemWithOrientation cr m itm = case _itType itm of
@@ -281,7 +212,7 @@ updateItemWithOrientation cr m itm = case _itType itm of

 testtorch :: Creature -> Maybe (Point3, Q.Quaternion Float) -> World -> World
 testtorch cr m = fromMaybe id $ do
-    (pos,q) <- m 
+    (pos, q) <- m
    let d = _crDir cr + argV (Q.qToV2 q)
    return $ muzFlareAt yellow (_crPos cr `v2z` 0 + rotate3z d pos) d

@@ -302,50 +233,55 @@ 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 ->
+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))
-    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)
+                        . (tgActive .~ False)
                   )
-    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
+        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)