Work on AttachUse -> UseAttach

This commit is contained in:
2024-10-01 14:21:40 +01:00
parent 36238669f5
commit f90bbc1cd0
15 changed files with 436 additions and 374 deletions
+67 -1
View File
@@ -1 +1,67 @@
All good (604 modules, at 13:28:17)
/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:26:1-22: warning: [-Wunused-top-binds]
Defined but not used: heldItemRelativeOrient
|
26 | heldItemRelativeOrient itm cr (p,q)
| ^^^^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:44:5-9: warning: [-Wunused-local-binds]
Defined but not used: handD
|
44 | handD = 15
| ^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:44:13-14: warning: [-Wtype-defaults]
• Defaulting the following constraint to type Integer
Num p0 arising from the literal 15
• In the expression: 15
In an equation for handD: handD = 15
In an equation for heldItemRelativeOrient:
heldItemRelativeOrient itm cr (p, q)
| _posture (_crStance cr) == Aiming = (p, q)
| isTwoHandFlat = (p, q)
| isOneHand = (p, q)
| otherwise = (p, q)
where
handD = 15
handPos
= case cr ^? crStance . carriage of
Just (Walking x LeftForward) -> f x * 50
_ -> 0
isOneHand
= itm ^? itUseAimStance == Just OneHand
|| isNothing (itm ^? itUseAimStance)
isTwoHandFlat = itm ^? itUseAimStance == Just TwoHandFlat
....
|
44 | handD = 15
| ^^
/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:45:5-11: warning: [-Wunused-local-binds]
Defined but not used: handPos
|
45 | handPos = case cr ^? crStance . carriage of
| ^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:46:45: warning: [-Wtype-defaults]
• Defaulting the following constraints to type Double
(Num a0)
arising from a use of *
at /home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:46:45
(Fractional a0)
arising from a use of f
at /home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:46:41-43
• In the expression: f x * 50
In a case alternative: Just (Walking x LeftForward) -> f x * 50
In the expression:
case cr ^? crStance . carriage of
Just (Walking x LeftForward) -> f x * 50
_ -> 0
|
46 | Just (Walking x LeftForward) -> f x * 50
| ^
/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:53:5: warning: [-Wunused-local-binds]
Defined but not used: f
|
53 | f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen
| ^
/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:54:5-8: warning: [-Wunused-local-binds]
Defined but not used: sLen
|
54 | sLen = _strideLength $ _crStance cr
| ^^^^
+1 -1
View File
@@ -40,7 +40,7 @@ itemUseEffect cr it w = case it ^. ldtValue . itUse of
EquipUse{} -> doequipmentchange
(UseConsume eff) -> useC eff (_ldtValue it) cr w
CraftUse{} -> w
AttachUse{} -> selectUse it cr w
UseAttach{} -> selectUse it cr w
TargetingUse {} -> w
UseAmmoMag{} -> w
ScopeUse{} -> w
+14 -49
View File
@@ -9,26 +9,24 @@ module Dodge.Creature.Picture (
deadFeet,
) where
import Dodge.Item.Grammar
import Shape
import Control.Lens
import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.Creature
import Dodge.Item.Draw
import Dodge.Item.Grammar
import Geometry
import Picture
import qualified Quaternion as Q
import Shape
--import Shape
import ShapePicture
basicCrPict :: Creature -> SPic
basicCrPict cr = uncurryV translateSPxy (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
<> noPic (basicCrShape cr)
--testShape :: Shape
--testShape = translateSHz 10 . rotateSHx 1 . upperCylinder 20 $ polyCirc 2 10
basicCrPict cr =
uncurryV translateSPxy (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
<> noPic (basicCrShape cr)
basicCrShape ::
Creature ->
@@ -53,22 +51,15 @@ feet :: Creature -> Shape
{-# INLINE feet #-}
feet cr = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) ->
mconcat
[ translateSHxy (f sa) off aFoot
, translateSHxy (- f sa) (- off) aFoot
]
translateSHxy (f sa) off aFoot
<> translateSHxy (- f sa) (- off) aFoot
Just (Walking sa RightForward) ->
mconcat
[ translateSHxy (- f sa) off aFoot
, translateSHxy (f sa) (- off) aFoot
]
translateSHxy (- f sa) off aFoot
<> translateSHxy (f sa) (- off) aFoot
_ ->
mconcat
[ translateSHxy 0 off aFoot
, translateSHxy 0 (- off) aFoot
]
translateSHxy 0 off aFoot
<> translateSHxy 0 (- off) aFoot
where
aFoot :: Shape
aFoot = upperPrismPolyST 10 $ polyCirc 3 4
off = 5
sLen = _strideLength $ _crStance cr
@@ -76,29 +67,7 @@ feet cr = case cr ^? crStance . carriage of
deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet
--cr = case cr ^? crStance . carriage of
-- Just (Walking sa LeftForward) ->
-- mconcat
-- [ translateSHxy (f sa) off aFoot
-- , translateSHxy (- f sa) (- off) aFoot
-- ]
-- Just (Walking sa RightForward) ->
-- mconcat
-- [ translateSHxy (- f sa) off aFoot
-- , translateSHxy (f sa) (- off) aFoot
-- ]
-- _ ->
-- mconcat
-- [ translateSHxy 0 off aFoot
-- , translateSHxy 0 (- off) aFoot
-- ]
-- where
-- aFoot :: Shape
-- aFoot = upperPrismPolyT 3 $ polyCirc 3 4
-- off = 5
-- sLen = _strideLength $ _crStance cr
-- f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
deadFeet = feet
arms :: Creature -> Shape
{-# INLINE arms #-}
@@ -162,15 +131,11 @@ baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI
upperBody :: Creature -> Shape
{-# INLINE upperBody #-}
upperBody cr =
mconcat
[ arms cr
, shoulderSH $ torso cr
]
upperBody cr = arms cr <> shoulderSH (torso cr)
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr . fmap (\(a,b,_) -> (a,b))) (invLDT $ _crInv cr)
drawEquipment cr = foldMap (itemEquipPict cr . fmap (\(a, b, _) -> (a, b))) (invLDT $ _crInv cr)
+1 -4
View File
@@ -69,13 +69,10 @@ data CraftType
| GASINJECTOR
| FLAKCRAFT
| FRAGCRAFT
| -- | ENERGYBALLCRAFT EnergyBallType
-- | BULBODYCRAFT BulletEffect
TELEPORTMODULE
| TELEPORTMODULE
| TIMEMODULE
| SIZEMODULE
| GRAVITYMODULE
-- | TARGETMODULE TargetingType
deriving (Eq, Ord, Show, Read)
data AttachType
+13 -7
View File
@@ -16,6 +16,7 @@ module Dodge.Data.Item.Use (
module Dodge.Data.Item.BulletMod
) where
import Dodge.Data.Item.Effect
import Dodge.Data.Item.BulletMod
import Dodge.Data.Item.Scope
import Control.Lens
@@ -23,7 +24,6 @@ import Data.Aeson
import Data.Aeson.TH
import qualified Data.IntMap.Strict as IM
import Dodge.Data.GenFloat
--import qualified Data.Sequence as Seq
import Dodge.Data.Hammer
import Dodge.Data.Item.HeldDelay
import Dodge.Data.Item.HeldUse
@@ -55,8 +55,8 @@ data ItemUse
, _equipTargeting :: Maybe TargetingType
}
| CraftUse
| AttachUse
{_atLinkedProjectile :: Maybe Int}
| UseAttach
{_uaParams :: AttachParams}
| UseAmmoMag
{ _amagLoadStatus :: ReloadStatus
, _amagParams :: AmmoParams
@@ -76,6 +76,14 @@ data ItemUse
data TriggerType = AutoTrigger | HammerTrigger
deriving (Eq, Show, Read)
data AttachParams
= APLinkProjectile
{_apLinkedProjectile :: Maybe Int}
| APItEffect
{_apItEffect :: ItEffect }
| APNothing
deriving (Eq, Show, Read)
data HeldParams
= DefaultHeldParams
| GasSprayParams
@@ -189,9 +197,7 @@ makeLenses ''AimParams
makeLenses ''ItZoom
makeLenses ''Muzzle
makeLenses ''HeldParams
--makeLenses ''AttachParams
--makeLenses ''ScrollAttachParams
makeLenses ''AttachParams
makeLenses ''AmmoParams
makeLenses ''MuzzleEffect
deriveJSON defaultOptions ''MuzzleEffect
@@ -203,7 +209,7 @@ deriveJSON defaultOptions ''Muzzle
deriveJSON defaultOptions ''AimStance
--deriveJSON defaultOptions ''ScrollAttachParams
--deriveJSON defaultOptions ''AttachParams
deriveJSON defaultOptions ''AttachParams
deriveJSON defaultOptions ''ItZoom
deriveJSON defaultOptions ''AimParams
deriveJSON defaultOptions ''ItemUse
+4 -4
View File
@@ -1,5 +1,7 @@
module Dodge.Item.Ammo where
module Dodge.Item.Ammo
where
import Dodge.Item.Attach
import Control.Lens
import Dodge.Data.World
import Dodge.Default.Item
@@ -98,6 +100,4 @@ chemFuelPouch =
}
bulletSynthesizer :: Item
bulletSynthesizer = defaultHeldItem
& itType .~ ATTACH BULLETSYNTHESIZER
& itUse .~ AttachUse Nothing
bulletSynthesizer = makeAttach BULLETSYNTHESIZER
+2 -2
View File
@@ -78,7 +78,7 @@ showAttachItem t itm = case t of
ZOOMSCOPE -> "ZOOMSCOPE"
-- TARGETATTACH x -> show x
BULLETSYNTHESIZER -> "BSYNTH"
REMOTESCREEN -> "REMOTE SCREEN " ++ show (itm ^? itUse . atLinkedProjectile . _Just)
REMOTESCREEN -> "REMOTE SCREEN " ++ show (itm ^? itUse . uaParams . apLinkedProjectile . _Just)
HOMINGMODULE -> "HOMING MOD"
AUGMENTEDHUD -> "AUGMENTED HUD"
@@ -115,7 +115,7 @@ itemNumberDisplay cr itm = case iu of
EquipUse{} -> showEquipmentNumber cr itm
CraftUse -> []
UseConsume {} -> []
AttachUse {} -> []
UseAttach {} -> []
UseAmmoMag {} -> [maybe "" shortShow $ itm ^? itUse . amagLoadStatus . iaLoaded]
ScopeUse OpticScope {_opticZoom = x} -> [shortShow x]
ScopeUse {} -> []
+32 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Item.HeldOffset (
heldItemOffset,
) where
import qualified Linear.Quaternion as Q
import Data.Maybe
import Dodge.Creature.HandPos
import Dodge.Data.Creature
@@ -21,6 +22,37 @@ transToHandle itm = fromMaybe id $ do
V2 x y <- itm ^? itUse . heldAim . aimHandlePos
return (-.-.- V3 x y 0)
heldItemRelativeOrient :: Item -> Creature -> (Point3, Q.Quaternion Float) -> (Point3, Q.Quaternion Float)
heldItemRelativeOrient itm cr (p,q)
| _posture (_crStance cr) == Aiming = (p,q)
| isTwoHandFlat = (p,q)
-- (+.+.+ V3 (_crRad cr) 0 handD)
-- . rotate3 (twoFlatHRot cr)
-- . transToHandle itm
| isOneHand = (p,q)
-- (+.+.+ V3 0 0 handD)
-- . (+.+.+ V3 (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) 0)
-- . (+.+.+ V3 (-2) 0 0)
-- . transToHandle itm
| otherwise = (p,q)
-- (+.+.+ V3 0 0 handD)
-- . (+.+.+ V3 (_crRad cr) 0 0)
-- . rotate3 (strideRot cr + 1.2)
-- . (+.+.+ V3 (-8) 0 0)
-- . transToHandle itm
where
handD = 15
handPos = case cr ^? crStance . carriage of
Just (Walking x LeftForward) -> f x * 50
_ -> 0
isOneHand =
itm ^? itUseAimStance == Just OneHand
|| isNothing (itm ^? itUseAimStance)
isTwoHandFlat = itm ^? itUseAimStance == Just TwoHandFlat
itUseAimStance = itUse . heldAim . aimStance
f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen
sLen = _strideLength $ _crStance cr
heldItemOffset :: Item -> Creature -> Point3 -> Point3
heldItemOffset itm cr
| _posture (_crStance cr) == Aiming =
@@ -39,7 +71,6 @@ heldItemOffset itm cr
. (+.+.+ V3 (_crRad cr) 0 0)
. rotate3 (strideRot cr + 1.2)
. (+.+.+ V3 (-8) 0 0)
-- . (+.+.+ V3 (-5) 0 0)
. transToHandle itm
where
handD = 15
+3 -3
View File
@@ -1,5 +1,6 @@
module Dodge.Item.Orientation
where
module Dodge.Item.Orientation
( orientAttachment
) where
import Dodge.Data.ComposedItem
import Geometry.Data
@@ -13,7 +14,6 @@ orientChild itm = case _itType itm of
orientByLink :: Item -> ComposeLinkType -> (Point3, Q.Quaternion Float)
orientByLink itm lt = case (_itType itm,lt) of
--(HELD FLAMETHROWER, AmmoInLink{}) -> undefined --(V3 4 (-6) 0,0)
(HELD FLAMETHROWER, AmmoInLink{}) -> (V3 4 (-6) 0, Q.axisAngle (V3 1 0 0) 0)
(HELD _,AmmoInLink{}) -> (V3 7 (-2) 0, Q.axisAngle (V3 1 0 0) 0)
_ -> (0,Q.axisAngle (V3 1 0 0) 0)
+5 -10
View File
@@ -10,6 +10,7 @@ module Dodge.Item.Scope (
bulletPayloadModule,
) where
import Dodge.Item.Attach
import Control.Lens
import Dodge.Data.Item
import Dodge.Default.Item
@@ -25,9 +26,7 @@ targetingScope tt = defaultHeldItem
& itUse .~ TargetingUse Nothing Nothing False
homingModule :: Item
homingModule = defaultHeldItem
& itType .~ ATTACH HOMINGMODULE
& itUse .~ AttachUse Nothing
homingModule = makeAttach HOMINGMODULE
fletchingModule :: Item
fletchingModule = bulletTargetingModule FlechetteTrajectoryType
@@ -45,12 +44,8 @@ bulletPayloadModule :: BulletPayload -> Item
bulletPayloadModule = bulletModule . BulletModPayload
augmentedHUD :: Item
augmentedHUD = defaultHeldItem
& itType .~ ATTACH AUGMENTEDHUD
& itUse .~ AttachUse Nothing
augmentedHUD = makeAttach AUGMENTEDHUD
remoteScreen :: Item
remoteScreen =
defaultHeldItem
& itType .~ ATTACH REMOTESCREEN
& itUse .~ AttachUse Nothing
remoteScreen = makeAttach REMOTESCREEN
+2 -2
View File
@@ -47,8 +47,8 @@ createShell homing payload muz cr w = w
thrustdelay = 20
updatescreen = fromMaybe id $ do
screenid <- homing ^? phRemoteID
return $ pointerToItemID screenid . itUse
. atLinkedProjectile
return $ pointerToItemID screenid . itUse . uaParams
. apLinkedProjectile
?~ i
i = IM.newKey $ w ^. cWorld . lWorld . projectiles
dir = _crDir cr + _mzRot muz
+2 -2
View File
@@ -66,9 +66,9 @@ destroyProjectile mitid pjid w = w & cWorld . lWorld . projectiles %~ IM.delete
removelink = fromMaybe id $ do
itid <- fmap _unNInt mitid
loc <- w ^? cWorld . lWorld . itemLocations . ix itid
itm <- w ^? pointerToItemLocation loc . itUse . atLinkedProjectile . _Just
itm <- w ^? pointerToItemLocation loc . itUse . uaParams . apLinkedProjectile . _Just
guard $ itm == pjid
return $ pointerToItemLocation loc . itUse . atLinkedProjectile .~ Nothing
return $ pointerToItemLocation loc . itUse . uaParams . apLinkedProjectile .~ Nothing
doThrust :: Projectile -> World -> World
doThrust pj w =
+1 -1
View File
@@ -11,7 +11,7 @@ import Control.Lens
selectUse :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
selectUse ittree _ w = fromMaybe w $ do
itid <- ittree ^? ldtValue . itID
pjid <- ittree ^? ldtValue . itUse . atLinkedProjectile . _Just
pjid <- ittree ^? ldtValue . itUse . uaParams . apLinkedProjectile . _Just
thepj <- w ^? cWorld . lWorld . projectiles . ix pjid
return $ w
& cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU (Just itid) 30] -- 69 is placeholder, should be removed
+1 -1
View File
@@ -88,7 +88,7 @@ moveZoomCamera cfig theinput cr w campos =
where
mremotepos = do
i <- cr ^? crManipulation . manObject . imSelectedItem
j <- cr ^? crInv . ix i . itUse . atLinkedProjectile . _Just
j <- cr ^? crInv . ix i . itUse . uaParams . apLinkedProjectile . _Just
w ^? cWorld . lWorld . projectiles . ix j . prjPos
docamrot = rotateV (campos ^. camRot)
offset = fromMaybe noscopeoffset $ do
+288 -286
View File
File diff suppressed because it is too large Load Diff