Cleanup

2024-10-02 18:54:31 +01:00
parent effd89dc78
commit 6bcd5bc591
3 changed files with 178 additions and 261 deletions
@@ -62,9 +62,9 @@ stateUpdate f =
    foldCr
        [ doDamage -- these two
        , checkDeath -- must be in this order 24/7/22
-        , internalHammerUpdate
+        , internalCreatureUpdate
        , f
-        , movementSideEff
+        , footstepSideEffect
        , updateInv -- upInv must be called before invSideEff 22.05.23
        , invSideEff
        , equipmentEffects
@@ -75,7 +75,6 @@ checkDeath cr w
    | _crHP cr > 0 = w
            & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
    | otherwise = w
-            --        & creatures . at (_crID cr) .~ Nothing
            & dropByState cr
            & removecr
            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
@@ -104,8 +103,8 @@ 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)

-internalHammerUpdate :: Creature -> World -> World
-internalHammerUpdate cr =
+internalCreatureUpdate :: Creature -> World -> World
+internalCreatureUpdate cr =
    cWorld . lWorld . creatures . ix (_crID cr)
        %~ ( (crHammerPosition %~ moveHammerUp)
                . updateMovement
@@ -142,17 +141,6 @@ applyPastDamages cr w
                & randGen .~ g
    | otherwise = w

-movementSideEff :: Creature -> World -> World
-movementSideEff = footstepSideEffect
-
-useUpdate :: ItemUse -> ItemUse
-useUpdate =
-    (heldHammer %~ moveHammerUp)
-        . (leftHammer %~ moveHammerUp)
-        . (leftDelay . rateTime %~ decreaseToZero)
-        . (heldDelay . warmTime %~ decreaseToZero)
-        . (heldDelay . rateTime %~ decreaseToZero)
-
 useEquipment :: Creature -> Int -> World -> World
 useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr
  where
@@ -163,17 +151,15 @@ updateInv :: Creature -> World -> World
 updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.map itemUpdate

 -- a loop going over equipped items
+-- maybe this should be done during a different loop (invSideEff)?
 equipmentEffects :: Creature -> World -> World
 --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 =
-    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 =
        itemInvSideEffect cr it
            . maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
@@ -184,6 +170,15 @@ updateRootItem cr = fromMaybe id $ do
    itmtree <- invTrees' (_crInv cr) ^? ix invid
    return $ updateRootItem' itmtree cr

+updateRootItem' :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
+updateRootItem' itmtree cr =
+    ldtPropagateFold
+        chainLinkOrientation
+        chainLinkOrientation
+        (updateItemWithOrientation cr)
+        (Just (heldItemRelativeOrient (_ldtValue itmtree) cr (0, Q.qID)))
+        itmtree
+
 -- need to check rotation
 chainLinkOrientation ::
    Maybe (Point3, Q.Quaternion Float) ->
@@ -196,15 +191,6 @@ chainLinkOrientation mo par (ILink lt f) child = do
    (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
-
 updateItemWithOrientation :: Creature -> Maybe (Point3, Q.Quaternion Float) -> Item -> World -> World
 updateItemWithOrientation cr m itm = case _itType itm of
    HELD TORCH -> testtorch cr m
@@ -221,68 +207,35 @@ itemInvSideEffect cr itm = case _itType itm of
    TARGETING tt -> updateItemTargeting tt cr itm
    _ -> id

--itemInvSideEffect cr it
--    | hastorchattach = createAttachLight cr it
--    | otherwise = id
--  where
--    hastorchattach = it ^? itType . iyModules . ix ModHeldAttach == Just ATTACHTORCH && _itIsRoot it
-
--createAttachLight :: Creature -> Item -> World -> World
--createAttachLight cr it = createTorchLightOffset cr it attachoff
--  where
--    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
+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
                        { _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
+        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
  where
+    pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
+    cid = _crID cr
+    invid = _ilInvID $ _itLocation itm
    isattached = itm ^?! itLocation . ilIsAttached
    rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
@@ -291,8 +244,7 @@ updateItemTargeting tt cr itm w =
 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 =
@@ -310,14 +262,16 @@ setRBCreatureTargeting cr w ituse
        Just $ hasLOS cpos (_crPos cr) w

 itemUpdate :: Item -> Item
-itemUpdate =
-    updateAutoRecharge
-        . (itUse %~ useUpdate)
+itemUpdate = updateAutoRecharge . (itUse %~ useUpdate)
+
+useUpdate :: ItemUse -> ItemUse
+useUpdate =
+    (heldHammer %~ moveHammerUp)
+        . (leftHammer %~ moveHammerUp)
+        . (leftDelay . rateTime %~ decreaseToZero)
+        . (heldDelay . warmTime %~ decreaseToZero)
+        . (heldDelay . rateTime %~ decreaseToZero)

--        . (itLocation .~ InInv (_crID cr) i itmisselected itmisroot)
--  where
--    itmisroot = Just i == (cr ^? crManipulation . manObject . inInventory . imRootItem)
--    itmisselected = Just i == (cr ^? crManipulation . manObject . inInventory . imSelectedItem)

 updateAutoRecharge :: Item -> Item
 updateAutoRecharge it = case it ^? itUse . leftConsumption of
@@ -326,48 +280,15 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
        | l < m -> it & itUse . leftConsumption . arProgress -~ 1
    _ -> it

--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
-- in the inventory
--crGetTargeting :: Creature -> Maybe TargetingType
--crGetTargeting cr = do
--    i <- cr ^? crManipulation . manObject . imRootItem
--    itm <- cr ^? crInv . ix i
--    itm ^? itType . iyModules . ix ModTarget . imtTargetType
--        <|> do
--            tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtTargeting
--            guard (canAttachTargeting tt itm)
--            return tt
--        <|> do
--            tt <- cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just
--            guard (canAttachTargeting tt itm)
--            return tt
-
--weaponReloadSounds :: Creature -> World -> World
--weaponReloadSounds cr w = case cr ^? crManipulation . manObject . inInventory . iselAction of
--    Just ReloadAction{_reloadAction = la} ->
--        soundContinue
--            (CrReloadSound cid)
--            (_crPos cr)
--            (_actionSound la)
--            (Just 1)
--            w
--    _ -> w
--  where
--    cid = _crID cr
-
 updateMovement :: Creature -> Creature
 updateMovement cr
    | isFrictionless cr = over crPos (+.+ momentum) cr
    | otherwise = updateWalkCycle cr
  where
    momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
-    momentum''
+    momentum
        | magV momentum' > 1 = 1 *.* normalizeV momentum'
        | otherwise = momentum'
-    momentum = momentum''

 isFrictionless :: Creature -> Bool
 isFrictionless cr = case cr ^? crStance . carriage of