Cleanup

2025-07-08 09:59:12 +01:00
parent b6cd988c82
commit c2f234b842
4 changed files with 51 additions and 99 deletions
@@ -3,16 +3,13 @@ module Dodge.Creature.State (
    doDamage,
 ) where

-import Dodge.HeldUse
-import Dodge.BaseTriggerType
-import Dodge.Data.DoubleTree
-import Dodge.Item.Orientation
 import Control.Applicative
 import Control.Monad
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.Monoid
 import Dodge.Base
+import Dodge.BaseTriggerType
 import Dodge.Corpse.Make
 import Dodge.Creature.Action
 import Dodge.Creature.Damage
@@ -22,16 +19,19 @@ import Dodge.Creature.Test
 import Dodge.Damage
 import Dodge.Data.ComposedItem
 import Dodge.Data.Damage.Type
+import Dodge.Data.DoubleTree
 --import Dodge.Data.DoubleTree
 import Dodge.Data.World
 import Dodge.DoubleTree
 import Dodge.Euse
+import Dodge.HeldUse
 import Dodge.Inventory.SelectionList
 import Dodge.Item.BackgroundEffect
 import Dodge.Item.Grammar
 import Dodge.Item.HeldOffset
 import Dodge.Item.Location
 import Dodge.Item.MaxAmmo
+import Dodge.Item.Orientation
 import Dodge.Prop.Gib
 import Dodge.SoundLogic
 import Dodge.Targeting.Draw
@@ -158,45 +158,46 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
    EQUIP WRIST_ECG | haspulse -> tryUseParent loc w
    COPIER _ -> copierItemUpdate itm cr w
    HELD FLATSHIELD -> rootNotrootEff createShieldWall removeShieldWall itm cr w
-    HELD MINIGUNX{}
-        | itm ^? itParams . isWarming == Just True ->
-            w
-                & pointerToItem itm . itParams . isWarming .~ False
-        | otherwise ->
-            w & pointerToItem itm . itParams . wTime
-                %~ (max 0 . subtract 1)
-        -- hard code values?
-    HELD MACHINEPISTOL{}
-        | fromMaybe 0 (itm ^? itParams . wTime) >= _coolEnd (baseItemTriggerType itm) ->
-            w & pointerToItem itm . itParams . wTime
-                .~ 0
-                & pointerToItem itm . itParams . coolSound .~ Nothing
-        | fromMaybe 0 (itm ^? itParams . wTime) == _coolStart (baseItemTriggerType itm) ->
-            w
-                & randGen .~ g
-                & pointerToItem itm . itParams . wTime +~ 1
-                & pointerToItem itm . itParams . coolSound ?~ sid
-                & soundContinue (CrWeaponSound (_crID cr) (fromIntegral $ _itID itm)) (_crPos cr) sid (Just 1)
-        | fromMaybe 0 (itm ^? itParams . wTime) > _coolStart (baseItemTriggerType itm) ->
-            w
-                & pointerToItem itm . itParams . wTime +~ 1
-                & soundContinue (CrWeaponSound (_crID cr) (fromIntegral $ _itID itm)) (_crPos cr) (fromMaybe undefined (itm ^? itParams . coolSound . _Just)) (Just 1)
-        | itm ^? itParams . isWarming == Just True ->
-            w
-                & pointerToItem itm . itParams . isWarming .~ False
-        | fromMaybe 0 (itm ^? itParams . wTime) >= _warmStart (baseItemTriggerType itm) ->
-            w & pointerToItem itm . itParams . wTime
-                .~ _coolStart (baseItemTriggerType itm)
-        | otherwise ->
-            w & pointerToItem itm . itParams . wTime
-                .~ 0
+    HELD MINIGUNX{} -> coolMinigun itm w
+    HELD MACHINEPISTOL{} -> coolMachinePistol cr itm w
    _ -> w
  where
    haspulse =
        w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress
            == Just 0
    itm = loc ^. locLDT . ldtValue . _1
-    (sid, g) = runState (takeOne [whirdownSmall1S,whirdownSmall2S]) (w ^. randGen)
+
+coolMinigun :: Item -> World -> World
+coolMinigun itm
+    | itm ^? itParams . isWarming == Just True = d . isWarming .~ False
+    | otherwise = d . wTime %~ (max 0 . subtract 1)
+  where
+    d = pointerToItem itm . itParams
+
+coolMachinePistol :: Creature -> Item -> World -> World
+coolMachinePistol cr itm w
+    | fromMaybe 0 (itm ^? itParams . wTime) >= _coolEnd (baseItemTriggerType itm) =
+        w & d . wTime .~ 0
+            & d . coolSound .~ Nothing
+    | fromMaybe 0 (itm ^? itParams . wTime) == _coolStart (baseItemTriggerType itm) =
+        w
+            & randGen .~ g
+            & d . wTime +~ 1
+            & d . coolSound ?~ sid
+            & dosound sid
+    | fromMaybe 0 (itm ^? itParams . wTime) > _coolStart (baseItemTriggerType itm) =
+        w
+            & d . wTime +~ 1
+            & dosound (fromMaybe undefined (itm ^? itParams . coolSound . _Just))
+    | itm ^? itParams . isWarming == Just True = w & d . isWarming .~ False
+    | fromMaybe 0 (itm ^? itParams . wTime) >= _warmStart (baseItemTriggerType itm) =
+        w & d . wTime .~ _coolStart (baseItemTriggerType itm)
+    | otherwise = w & d . wTime .~ 0
+  where
+    dosound s = soundContinue 
+        (CrWeaponSound (_crID cr) (fromIntegral $ _itID itm)) (_crPos cr) s (Just 1)
+    d = pointerToItem itm . itParams
+    (sid, g) = runState (takeOne [whirdownSmall1S, whirdownSmall2S]) (w ^. randGen)

 copierItemUpdate :: Item -> Creature -> World -> World
 copierItemUpdate itm cr w = fromMaybe w $ do
@@ -290,19 +291,14 @@ updateAttachedItems itmtree cr =
        (LocLDT TopLDT itmtree)

 -- need to check rotation
-chainLinkOrientation ::
-    (Point3, Q.Quaternion Float) ->
-    CItem ->
-    ItemLink ->
-    CItem ->
-    (Point3, Q.Quaternion Float)
-chainLinkOrientation (p, q) par lt child = (p + Q.rotate q p1, q * q1)
-  where
-    (p1, q1) = orientAttachment (par ^. _1) lt (child ^. _1)
+chainLinkOrientation :: Point3Q -> CItem -> ItemLink -> CItem -> Point3Q
+chainLinkOrientation o par lt child =
+    o
+        `Q.comp` orientAttachment (par ^. _1) lt (child ^. _1)

 updateItemWithOrientation ::
    Creature ->
-    (Point3, Q.Quaternion Float) ->
+    Point3Q ->
    LocationLDT ItemLink CItem ->
    World ->
    World
@@ -351,10 +347,7 @@ shineTargetLaser cr loc o w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $
                    }
  where
    itmtree = loc ^. locLDT
-    --(p,q) = heldItemRelativeOrient (locToTop loc ^. locLDT . ldtValue . _1) cr 
-    --    $ orientLocation (V3 0 0 0,Q.qID) (fmap fst loc) (V3 5 0 0,Q.qID)
-    (p,q) =  o `Q.comp` (V3 5 0 0,Q.qID)
--        $ orientLocation (V3 0 0 0,Q.qID) (fmap fst loc) (V3 5 0 0,Q.qID)
+    (p, q) = o `Q.comp` (V3 5 0 0, Q.qID)
    x = 1
    isammolink AmmoInLink{} = True
    isammolink _ = False
@@ -366,47 +359,6 @@ shineTargetLaser cr loc o w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $
    invid = _ilInvID $ _itLocation itm
    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red

--shineTargetLaser ::
--    Creature ->
--    LDTree ItemLink CItem ->
--    (Point3, Q.Quaternion Float) ->
--    World ->
--    World
--shineTargetLaser cr itmtree (p, q) w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
--    guard (crIsAiming cr)
--    (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
--    i <- mag ^. ldtValue . _1 . itConsumables
--    guard $ i >= x
--    maginvid <- mag ^? ldtValue . _1 . itLocation . ilInvID
--    return $
--        w
--            & worldEventFlags . at InventoryChange ?~ ()
--            & cWorld . lWorld . creatures . ix (_crID cr)
--                . crInv
--                . ix maginvid
--                . itConsumables
--                . _Just
--                -~ x
--            & cWorld . lWorld . lasers
--                .:~ Laser
--                    { _lpPhaseV = 1
--                    , _lpDir = _crDir cr + argV (Q.qToV2 q)
--                    , _lpPos = pos
--                    , _lpColor = col
--                    , _lpType = TargetingLaser (_itID itm)
--                    }
--  where
--    x = 1
--    isammolink AmmoInLink{} = True
--    isammolink _ = False
--    pos = _crPos cr + xyV3 (rotate3 cdir (p + V3 5 0 0))
--    cdir = _crDir cr
--    itm = itmtree ^. ldtValue . _1
--    pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
--    cid = _crID cr
--    invid = _ilInvID $ _itLocation itm
--    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
-
 shineTorch :: Creature -> LDTree ItemLink CItem -> Point3Q -> World -> World
 shineTorch cr itmtree (p, q) = fromMaybe id $ do
    (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
@@ -29,9 +29,9 @@ data ItemLocation
    = InInv 
        { _ilCrID :: Int
        , _ilInvID :: Int
-        , _ilIsRoot :: Bool
+        , _ilIsRoot :: Bool -- of any item
        , _ilIsSelected :: Bool
-        , _ilIsAttached :: Bool
+        , _ilIsAttached :: Bool -- to selected item
        , _ilEquipSite :: Maybe EquipSite
        }
    | OnTurret {_ilTuID :: Int}
@@ -27,9 +27,11 @@ import qualified Data.Map.Strict as M

 testStringInit :: Universe -> [String]
 testStringInit u = prettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv
-            . ix 0 . itTimeLastUsed)
+            . ix 0 . itLocation . ilIsRoot)
        <> prettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv
-            . ix 0 . itParams . wTime)
+            . ix 0 . itLocation . ilIsSelected)
+        <> prettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv
+            . ix 0 . itLocation . ilIsAttached)
        --return . foldMap (prettyLDT (show . (^. _1 . itType))) . invLDT $ _crInv cr
 --  where
 --    idp = invDisplayParams $ u ^. uvWorld
@@ -60,9 +60,7 @@ qToAng = argV . qToV2
 qID :: Q.Quaternion Float
 qID = Q.axisAngle (V3 1 0 0) 0

-comp :: (Point3, Q.Quaternion Float)
-    -> (Point3, Q.Quaternion Float)
-    -> (Point3, Q.Quaternion Float)
+comp :: Point3Q -> Point3Q -> Point3Q
 comp (p,q) (p1,q1) = (p + Q.rotate q p1, q * q1)

 --deriving instance (Flat a => Flat (Quaternion a))