Partial implementation of more sensible muzzle position determination

2024-11-28 21:15:22 +00:00
parent 0d5e578f07
commit 3763ff2c8a
6 changed files with 188 additions and 133 deletions
@@ -27,7 +27,7 @@ import ShapePicture
 -- the position of a weapon handle
 aimingWeaponHandlePos :: Creature -> Item -> Point2
 aimingWeaponHandlePos _ it = case it ^? itUse . heldAim . aimStance of
-    Just TwoHandUnder -> 0
+    Just TwoHandUnder -> V2 (-2) 0
    Just TwoHandOver -> V2 (-7) 0
    Just OneHand -> V2 10 (-2)
    Just TwoHandFlat -> V2 10 0
@@ -23,38 +23,31 @@ import Dodge.SelectUse
 import qualified IntMapHelp as IM

 useRootItem :: Int -> World -> World
-useRootItem crid w = fromMaybe w $ do
+useRootItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
    cr <- w ^? cWorld . lWorld . creatures . ix crid
    itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
-    it <- invRootTrees (_crInv cr) ^? ix itRef
-    return $
-        itemUseEffect' cr it w
-            & worldEventFlags . at InventoryChange ?~ ()
+    itmtree <- invRootTrees (_crInv cr) ^? ix itRef
+    let itm = itmtree ^. ldtValue . cItem
+    case itmtree ^. ldtValue . cItemFunction of
+        WeaponPlatformSF ->
+            return $
+                heldEffect (bimap _iatType _cItem itmtree) cr w
+                    & pointerToItem itm . itUse . heldHammer .~ HammerDown
+        EquipmentPlatformSF -> do
+            guard (_crHammerPosition cr == HammerUp)
+            invid <- itm ^? itLocation . ilInvID
+            return $ toggleEquipmentAt invid cr w
+        _ -> Nothing

-itemUseEffect' :: Creature -> LabelDoubleTree ItemLink ComposedItem -> World -> World
-itemUseEffect' cr itmtree w = case itmtree ^. ldtValue . cItemFunction of
-    WeaponPlatformSF ->
-        heldEffect (bimap _iatType _cItem itmtree) cr w
-            & pointerToItem itm . itUse . heldHammer .~ HammerDown
-    EquipmentPlatformSF -> doequipmentchange
-    _ -> w
-  where
-    --    UseHotkey{} -> doequipmentchange
-    --    UseEquip{} -> doequipmentchange
-    --    (UseConsume eff) -> useC eff (_ldtValue itmtree) cr w
-    --    UseCraft{} -> w
-    --    UseAttach{} -> selectUse itmtree cr  w
-    --    UseAmmoMag{} -> w
-    --    UseScope{} -> w
-    --    UseBulletMod{} -> w
-
-    itm :: Item
-    itm = itmtree ^. ldtValue . cItem
-
-    doequipmentchange = fromMaybe w $ do
-        guard (_crHammerPosition cr == HammerUp)
-        invid <- itm ^? itLocation . ilInvID
-        return $ toggleEquipmentAt invid cr w
+--  where
+--    UseHotkey{} -> doequipmentchange
+--    UseEquip{} -> doequipmentchange
+--    (UseConsume eff) -> useC eff (_ldtValue itmtree) cr w
+--    UseCraft{} -> w
+--    UseAttach{} -> selectUse itmtree cr  w
+--    UseAmmoMag{} -> w
+--    UseScope{} -> w
+--    UseBulletMod{} -> w

 itemUseEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
 itemUseEffect cr itmtree w = case itmtree ^. ldtValue . itUse of
@@ -4,8 +4,6 @@ module Dodge.Creature.State (
 ) where

 import Control.Monad
-import Dodge.Targeting.Draw
-import Dodge.Data.DoubleTree
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.Monoid
@@ -18,6 +16,7 @@ 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.DoubleTree
 import Dodge.Euse
@@ -27,6 +26,7 @@ import Dodge.Item.Grammar
 import Dodge.Item.HeldOffset
 import Dodge.Prop.Gib
 import Dodge.SoundLogic
+import Dodge.Targeting.Draw
 import Dodge.Zoning.Creature
 import FoldableHelp
 import Geometry
@@ -74,13 +74,15 @@ crUpdate f =

 checkDeath :: Creature -> World -> World
 checkDeath cr w
-    | _crHP cr > 0 = w
-        & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
-    | otherwise = w
-           & dropByState cr -- the order of
-           & removecr       -- these is important
-           & stopSoundFrom (CrWeaponSound (_crID cr) 0)
-           & corpseOrGib cr
+    | _crHP cr > 0 =
+        w
+            & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
+    | otherwise =
+        w
+            & dropByState cr -- the order of
+            & removecr -- these is important
+            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
+            & corpseOrGib cr
  where
    removecr
        | _crID cr == 0 =
@@ -166,8 +168,11 @@ invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr

 -- a loop going over all root inventory items
 invRootItemEffs :: Creature -> World -> World
-invRootItemEffs cr = appEndo $ foldMap (reduceLocLDT (Endo . invItemLocUpdate) . LocLDT TopLDT) 
-    (invLDT (_crInv cr))
+invRootItemEffs cr =
+    appEndo $
+        foldMap
+            (reduceLocLDT (Endo . invItemLocUpdate) . LocLDT TopLDT)
+            (invLDT (_crInv cr))

 invItemLocUpdate :: LocationLDT ItemLink PartiallyComposedItem -> World -> World
 invItemLocUpdate loc w = case itm ^. itType of
@@ -176,24 +181,52 @@ invItemLocUpdate loc w = case itm ^. itType of
        x <- itm ^? itUse . uaParams . apInt
        if x < 100
            then do
-                bat <- loc ^? locLDT . ldtLeft . ix 0 . _2 . ldtValue . _1 
+                bat <- loc ^? locLDT . ldtLeft . ix 0 . _2 . ldtValue . _1
                j <- bat ^? itLocation . ilInvID
                y <- bat ^? itUse . amagLoadStatus . iaLoaded
                guard $ y > 0
-                return $ w & cWorld . lWorld . creatures 
-                    . ix 0 . crInv . ix i . itUse . uaParams . apInt +~ 1
-                        & cWorld . lWorld . creatures 
-                    . ix 0 . crInv . ix j . itUse . amagLoadStatus . iaLoaded -~ 1
+                return $
+                    w
+                        & cWorld . lWorld . creatures
+                            . ix 0
+                            . crInv
+                            . ix i
+                            . itUse
+                            . uaParams
+                            . apInt
+                            +~ 1
+                        & cWorld . lWorld . creatures
+                            . ix 0
+                            . crInv
+                            . ix j
+                            . itUse
+                            . amagLoadStatus
+                            . iaLoaded
+                            -~ 1
            else do
                mag <- loc ^? locLdtContext . cldtParent . _1
                j <- mag ^? itLocation . ilInvID
                y <- mag ^? itUse . amagLoadStatus . iaLoaded
                ymax <- mag ^? itUse . amagLoadStatus . iaMax
                guard $ y < ymax
-                return $ w & cWorld . lWorld . creatures 
-                    . ix 0 . crInv . ix i . itUse . uaParams . apInt .~ 0
-                        & cWorld . lWorld . creatures 
-                    . ix 0 . crInv . ix j . itUse . amagLoadStatus . iaLoaded +~ 1
+                return $
+                    w
+                        & cWorld . lWorld . creatures
+                            . ix 0
+                            . crInv
+                            . ix i
+                            . itUse
+                            . uaParams
+                            . apInt
+                            .~ 0
+                        & cWorld . lWorld . creatures
+                            . ix 0
+                            . crInv
+                            . ix j
+                            . itUse
+                            . amagLoadStatus
+                            . iaLoaded
+                            +~ 1
    _ -> w
  where
    itm = loc ^. locLDT . ldtValue . _1
@@ -220,7 +253,8 @@ chainLinkOrientation ::
    ItemLink ->
    ComposedItem ->
    (Point3, Q.Quaternion Float)
-chainLinkOrientation mo (CItem par _) (ILink lt f) (CItem child _) = (p + Q.rotate q p1, q * q1)
+chainLinkOrientation mo (CItem par _) (ILink lt f) (CItem child _) =
+    (p + Q.rotate q p1, q * q1)
  where
    (p, q) = mo
    (p1, q1) = f par lt child
@@ -246,25 +280,36 @@ drawAugmentedHUD (LocLDT con _) w = fromMaybe w $ do
    itm <- con ^? cldtParent . cItem
    return $ w & cWorld . lWorld . flares <>~ drawTargeting itm w

-shineTargetLaser :: Creature -> LabelDoubleTree ItemLink ComposedItem -> (Point3, Q.Quaternion Float)
-    -> World -> World
-shineTargetLaser cr itmtree (p,q) w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
+shineTargetLaser ::
+    Creature ->
+    LabelDoubleTree ItemLink ComposedItem ->
+    (Point3, Q.Quaternion Float) ->
+    World ->
+    World
+shineTargetLaser cr itmtree (p, q) w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
    guard (crIsAiming cr)
    (_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
    i <- mag ^? ldtValue . cItem . itUse . amagLoadStatus . iaLoaded
    guard $ i >= x
    maginvid <- mag ^? ldtValue . cItem . itLocation . ilInvID
-    return $ w
-        & worldEventFlags . at InventoryChange ?~ ()
-        & cWorld . lWorld . creatures . ix (_crID cr) 
-            . crInv . ix maginvid . itUse . amagLoadStatus . iaLoaded -~ x
-       & cWorld . lWorld . lasers .:~ LaserStart
-                        { _lpPhaseV = 1
-                        , _lpDir = _crDir cr + argV (Q.qToV2 q)
-                        , _lpPos = pos
-                        , _lpColor = col
-                        , _lpType = TargetingLaser (_itID itm)
-                        }
+    return $
+        w
+            & worldEventFlags . at InventoryChange ?~ ()
+            & cWorld . lWorld . creatures . ix (_crID cr)
+                . crInv
+                . ix maginvid
+                . itUse
+                . amagLoadStatus
+                . iaLoaded
+                -~ x
+            & cWorld . lWorld . lasers
+                .:~ LaserStart
+                    { _lpPhaseV = 1
+                    , _lpDir = _crDir cr + argV (Q.qToV2 q)
+                    , _lpPos = pos
+                    , _lpColor = col
+                    , _lpType = TargetingLaser (_itID itm)
+                    }
  where
    x = 1
    isammolink AmmoInLink{} = True
@@ -272,7 +317,6 @@ shineTargetLaser cr itmtree (p,q) w = fromMaybe (w & pointittarg . itTgPos .~ No
    pos = _crPos cr + xyV3 (rotate3 cdir (p + V3 5 0 0))
    cdir = _crDir cr
    itm = itmtree ^. ldtValue . cItem
-    --pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
    pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
    cid = _crID cr
    invid = _ilInvID $ _itLocation itm
@@ -302,21 +346,28 @@ shineTorch cr itmtree (p, q) = fromMaybe id $ do
 -- does this need to be updated if it is not attached to the used root item?
 updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
 updateItemTargeting tt cr itm w = case tt of
-    _ | not isattached -> w 
-            & pointittarg .itTgPos .~ Nothing
-            & pointittarg .itTgActive .~ False
-    TargetRBPress | rbpressed -> w
-                & pointittarg .itTgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
-                & pointittarg .itTgActive .~ True
-    TargetRBPress -> w
-            & pointittarg .itTgPos .~ Nothing
-            & pointittarg .itTgActive .~ False
+    _
+        | not isattached ->
+            w
+                & pointittarg . itTgPos .~ Nothing
+                & pointittarg . itTgActive .~ False
+    TargetRBPress
+        | rbpressed ->
+            w
+                & pointittarg . itTgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
+                & pointittarg . itTgActive .~ True
+    TargetRBPress ->
+        w
+            & pointittarg . itTgPos .~ Nothing
+            & pointittarg . itTgActive .~ False
    TargetRBCreature -> w & pointittarg %~ setRBCreatureTargeting cr w
-    TargetCursor -> w 
-        & pointittarg .~ ItTargeting
-                (Just (mouseWorldPos (w ^. input) (w ^. wCam)))
-                Nothing
-                True
+    TargetCursor ->
+        w
+            & pointittarg
+                .~ ItTargeting
+                    (Just (mouseWorldPos (w ^. input) (w ^. wCam)))
+                    Nothing
+                    True
  where
    pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
    cid = _crID cr
@@ -326,10 +377,10 @@ updateItemTargeting tt cr itm w = case tt of

 setRBCreatureTargeting :: Creature -> World -> ItemTargeting -> ItemTargeting
 setRBCreatureTargeting cr w ituse
-    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^?itTgID . _Just)
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? itTgID . _Just)
        && canSeeTarget =
-        ituse & updatePos &itTgActive .~ True
-    | otherwise = ituse &itTgID .~ fmap _crID newtarg & updatePos &itTgActive .~ False
+        ituse & updatePos & itTgActive .~ True
+    | otherwise = ituse & itTgID .~ fmap _crID newtarg & updatePos & itTgActive .~ False
  where
    newtarg =
        safeMinimumOn (dist mwp . _crPos)
@@ -341,7 +392,7 @@ setRBCreatureTargeting cr w ituse
    posFromMaybeID Nothing = Nothing
    posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
    canSeeTarget = fromMaybe False $ do
-        cid <- ituse ^?itTgID . _Just
+        cid <- ituse ^? itTgID . _Just
        cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
        Just $ hasLOS cpos (_crPos cr) w

@@ -6,6 +6,7 @@ module Dodge.HeldUse (
    mcUseHeld,
 ) where

+import Dodge.Item.HeldOffset
 import Color
 import Control.Monad
 import Data.Maybe
@@ -391,7 +392,10 @@ makeBullet thebullet itm cr mz w =
                    & buDrag *~ drag
                )
  where
-    bulpos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm + V2 0 offset)
+--    bulpos = _crPos cr 
+--        + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm + V2 0 offset)
+    (moff,mrot) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz)
+    bulpos = _crPos cr + rotateV (_crDir cr) moff
    (a, g'') = randomR (- inacc, inacc) $ _randGen w
    inacc = _mzInaccuracy mz
    (drag, g') = case _rifling (_heldParams $ _itUse itm) of
@@ -400,7 +404,7 @@ makeBullet thebullet itm cr mz w =
    (muzvel, g) = case _muzVel $ _heldParams $ _itUse itm of
        ConstFloat x -> (x, g')
        UniRandFloat x y -> randomR (x, y) g'
-    dir = _crDir cr + _mzRot mz + a
+    dir = _crDir cr + mrot + a
    offset = case itm ^? itUse . heldParams . randomOffset of
        Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
        _ -> 0
@@ -3,6 +3,7 @@ module Dodge.Item.HeldOffset (
    twoFlatHRot,
    heldItemOffset,
    heldItemRelativeOrient,
+    heldItemOrient2D,
 ) where

 import qualified Quaternion as Q
@@ -23,6 +24,11 @@ transToHandle itm = fromMaybe id $ do
    V2 x y <- itm ^? itUse . heldAim . aimHandlePos
    return (-.-.- V3 x y 0)

+heldItemOrient2D :: Item -> Creature -> Point2 -> Float -> (Point2, Float)
+heldItemOrient2D itm cr p a = (V2 x y, argV . Q.qToV2 $ q )
+  where
+    (V3 x y _,q) = heldItemRelativeOrient itm cr (p `v2z` 0, Q.axisAngle (V3 0 0 1) a)
+
 heldItemRelativeOrient :: Item -> Creature -> (Point3, Q.Quaternion Float) -> (Point3, Q.Quaternion Float)
 heldItemRelativeOrient itm cr (p,q)
    |  _posture (_crStance cr) == Aiming =