Distinguish between selected item and root-selected item

2024-09-21 21:59:53 +01:00
parent 2154abfb1d
commit 31b5db6e9e
33 changed files with 313 additions and 281 deletions
@@ -16,7 +16,7 @@ import ShapePicture

 itemEquipPict :: Creature -> Item -> SPic
 itemEquipPict cr it = case it ^. itUse of
-    HeldUse{} | _itIsHeld it -> overPosSP (heldItemOffset it cr) (itemSPic it)
+    HeldUse{} | _itIsRoot it -> overPosSP (heldItemOffset it cr) (itemSPic it)
    ituse -> fromMaybe mempty $ do
        attachpos <- ituse ^? equipEffect . eeAttachPos
        i <- it ^? itLocation . ipInvID
@@ -23,18 +23,18 @@ transToHandle itm = fromMaybe id $ do

 heldItemOffset :: Item -> Creature -> Point3 -> Point3
 heldItemOffset itm cr
-    | isSelected && _posture (_crStance cr) == Aiming =
+    | isroot && _posture (_crStance cr) == Aiming =
        (+.+.+ aimingWeaponZeroPos cr itm `v2z` shoulderHeight)
-    | isSelected && isTwoHandFlat =
+    | isroot && isTwoHandFlat =
        (+.+.+ V3 (_crRad cr) 0 handD)
            . rotate3 (twoFlatHRot cr)
            . transToHandle itm
-    | isSelected && isOneHand =
+    | isroot && isOneHand =
        (+.+.+ V3 0 0 handD)
            . (+.+.+ V3 (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) 0)
            . (+.+.+ V3 (-2) 0 0)
            . transToHandle itm
-    | isSelected =
+    | isroot =
        (+.+.+ V3 0 0 handD)
            . (+.+.+ V3 (_crRad cr) 0 0)
            . rotate3 (strideRot cr + 1.2)
@@ -44,7 +44,7 @@ heldItemOffset itm cr
    | otherwise = id
  where
    handD = 15
-    isSelected = _itIsHeld itm
+    isroot = _itIsRoot itm
    handPos = case cr ^? crStance . carriage of
        Just (Walking x LeftForward) -> f x * 50
        _ -> 0
@@ -2,7 +2,8 @@ module Dodge.Item.Location (
    pointerToItemLocation,
    getItem,
    pointerToItem,
-    pointerYourItem,
+    pointerYourSelectedItem,
+    pointerYourRootItem,
 ) where

 import Control.Lens
@@ -28,9 +29,14 @@ pointerToItemLocation (InInv cid invid) = cWorld . lWorld . creatures . ix cid .
 pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . ix flid . flIt
 pointerToItemLocation _ = const pure

-pointerYourItem :: Applicative a => (Item -> a Item) -> World -> a World
-pointerYourItem f w = fromMaybe (pure w) $ do
-    itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
+pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
+pointerYourSelectedItem f w = fromMaybe (pure w) $ do
+    itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . imSelectedItem
+    Just $ pointerToItemLocation (InInv 0 itinvid) f w
+
+pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
+pointerYourRootItem f w = fromMaybe (pure w) $ do
+    itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . imRootItem
    Just $ pointerToItemLocation (InInv 0 itinvid) f w

 pointerToItem ::
@@ -5,20 +5,20 @@ module Dodge.Item.Weapon.BatteryGuns (
    splitBeamCombine,
    --    shootTeslaArc,
    shootLaser,
-    circleLaser,
-    shootDualLaser,
+    --circleLaser,
+    --shootDualLaser,
    aTractorBeam,
 ) where

 import Dodge.Base
 import Dodge.Beam
-import Dodge.Creature.HandPos
+--import Dodge.Creature.HandPos
 import Dodge.Data.World
-import Dodge.Item.Weapon.LaserPath
+--import Dodge.Item.Weapon.LaserPath
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
-import Picture
+--import Picture

 --import Control.Monad.State

@@ -84,67 +84,67 @@ shootLaser it cr =
            (_crPos cr)
            (_crDir cr)

-- this has the feel of a left click item
-circleLaser :: Item -> Creature -> World -> World
-circleLaser it cr w
-    | hasLOSIndirect cpos pos w =
-        w
-            & cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
-    | otherwise = w
-  where
-    cpos = _crPos cr
-    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-    pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
-    dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
-    phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
-    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
-    dam = _lasDamage $ _itParams it
+---- this has the feel of a left click item
+--circleLaser :: Item -> Creature -> World -> World
+--circleLaser it cr w
+--    | hasLOSIndirect cpos pos w =
+--        w
+--            & cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
+--    | otherwise = w
+--  where
+--    cpos = _crPos cr
+--    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
+--    pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
+--    dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
+--    phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
+--    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
+--    dam = _lasDamage $ _itParams it

-shootDualLaser :: Item -> Creature -> World -> World
-shootDualLaser it cr w =
-    w
-        & cWorld . lWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
-        & cWorld . lWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
-  where
-    itid = _itID it
-    dir = _crDir cr
-    pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir
-    aimlength = aimingMuzzleLength cr it
-    gap = _dbGap . _itParams $ it
-    posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir)
-    posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
-    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-    mwp'
-        | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
-        | otherwise = mwp
-    dirl = argV $ mwp' -.- posl
-    dirr = argV $ mwp' -.- posr
-    phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
-    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
-    dam = _lasDamage $ _itParams it
+--shootDualLaser :: Item -> Creature -> World -> World
+--shootDualLaser it cr w =
+--    w
+--        & cWorld . lWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
+--        & cWorld . lWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
+--  where
+--    itid = _itID it
+--    dir = _crDir cr
+--    pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir
+--    aimlength = aimingMuzzleLength cr it
+--    gap = _dbGap . _itParams $ it
+--    posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir)
+--    posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
+--    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
+--    mwp'
+--        | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
+--        | otherwise = mwp
+--    dirl = argV $ mwp' -.- posl
+--    dirr = argV $ mwp' -.- posr
+--    phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
+--    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
+--    dam = _lasDamage $ _itParams it

-basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
-basicBeamAt itid w col dam phasev pos dir =
-    Beam
-        { _bmDraw = BasicBeamDraw --drawBeam
-        , _bmPos = pos
-        , _bmDir = dir
-        , _bmDamage = dam
-        , _bmRange = 800
-        , _bmPhaseV = phasev
-        , _bmColor = col
-        , _bmPoints = pos : ps
-        , _bmFirstPoints = []
-        , _bmOrigin = Just itid
-        , _bmType = BeamCombine NoBeamCombine
-        }
-  where
-    (_, ps) = reflectLaserAlong phasev pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
+--basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
+--basicBeamAt itid w col dam phasev pos dir =
+--    Beam
+--        { _bmDraw = BasicBeamDraw --drawBeam
+--        , _bmPos = pos
+--        , _bmDir = dir
+--        , _bmDamage = dam
+--        , _bmRange = 800
+--        , _bmPhaseV = phasev
+--        , _bmColor = col
+--        , _bmPoints = pos : ps
+--        , _bmFirstPoints = []
+--        , _bmOrigin = Just itid
+--        , _bmType = BeamCombine NoBeamCombine
+--        }
+--  where
+--    (_, ps) = reflectLaserAlong phasev pos (pos +.+ 800 *.* unitVectorAtAngle dir) w

-dualRayAt :: BeamType -> Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
-dualRayAt bt itid w col dam phasev pos dir =
-    basicBeamAt itid w col dam phasev pos dir
-        & bmType .~ bt
+--dualRayAt :: BeamType -> Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
+--dualRayAt bt itid w col dam phasev pos dir =
+--    basicBeamAt itid w col dam phasev pos dir
+--        & bmType .~ bt

 aTractorBeam :: Item -> Creature -> World -> World
 aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
@@ -155,7 +155,7 @@ aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos
    dir = _crDir cr
    outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
    power = _attractionPower . _itParams $ _crInv cr IM.! itRef
-    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
+    itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change

 tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
 tractorBeamAt pos outpos dir power =
@@ -16,8 +16,8 @@ module Dodge.Item.Weapon.TriggerType (
    trigDoAlso,
    withTempLight,
    withItem,
-    withItemUpdate,
-    withItemUpdateFirst,
+--    withItemUpdate,
+--    withItemUpdateFirst,
 --    rateIncAB,
 --    torqueBefore,
 --    torqueBeforeAtLeast,
@@ -68,7 +68,7 @@ import Dodge.Creature.HandPos
 import Data.Foldable
 import Data.Maybe
 import Dodge.Base
-import Dodge.Creature.Test
+--import Dodge.Creature.Test
 import Dodge.Data.World
 import Dodge.Inventory.Lock
 import Dodge.LightSource
@@ -208,7 +208,8 @@ withWarmUp ::
    SoundID ->
    ChainEffect
 withWarmUp soundID f item cr w
-    | curWarmUp < maxWarmUp && crWeaponReady cr =
+--    | curWarmUp < maxWarmUp && crWeaponReady cr =
+    | curWarmUp < maxWarmUp =
        w
            & pointertoitem . itUse . heldDelay . warmTime +~ 2
            & soundContinue (CrWeaponSound cid 0) (_crPos cr) soundID (Just 2)
@@ -219,7 +220,7 @@ withWarmUp soundID f item cr w
  where
    item' = _ldtValue item
    cid = _crID cr
-    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
+    itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
    pointertoitem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
    curWarmUp = _warmTime . _heldDelay $ _itUse item'
    maxWarmUp = _warmMax . _heldDelay $ _itUse item'
@@ -391,7 +392,7 @@ useTimeCheck f item cr w = case item ^? ldtValue . itUse . heldDelay of
    cid = _crID cr
    setUseRate = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime 
        +~ userate
-    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
+    itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
    userate = fromMaybe 0 $ item ^? ldtValue . itUse . heldDelay . rateMax

 -- | Applies a world effect after a hammer position check.
@@ -451,16 +452,16 @@ shootL f item cr w
 withItem :: (Item -> ChainEffect) -> ChainEffect
 withItem g f it = g (_ldtValue it) f it

-- not ideal
-withItemUpdateFirst :: (Item -> Item) -> ChainEffect
-withItemUpdateFirst up f it cr = f (over ldtValue up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
-  where
-    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
-
-withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
-withItemUpdate up g f it cr = g (_ldtValue it) f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
-  where
-    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
+---- not ideal
+--withItemUpdateFirst :: (Item -> Item) -> ChainEffect
+--withItemUpdateFirst up f it cr = f (over ldtValue up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
+--  where
+--    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
+--
+--withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
+--withItemUpdate up g f it cr = g (_ldtValue it) f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up)
+--  where
+--    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change

 withTempLight :: Int -> Float -> V3 Float -> ChainEffect
 withTempLight time rad col eff item cr =