Work on AttachUse -> UseAttach

ghcidOutput

@@ -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
+   |     ^^^^

src/Dodge/Creature/Impulse/UseItem.hs

@@ -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

src/Dodge/Creature/Picture.hs

@@ -9,27 +9,25 @@ 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) 
+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
-
 basicCrShape ::
     Creature ->
     Shape
@@ -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
@@ -77,28 +68,6 @@ 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
 
 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 =
+upperBody cr = arms cr <> shoulderSH (torso cr)
-    mconcat
-        [ 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)

src/Dodge/Data/Item/Combine.hs

@@ -69,13 +69,10 @@ data CraftType
     | GASINJECTOR
     | FLAKCRAFT
     | FRAGCRAFT
-    | --    | ENERGYBALLCRAFT EnergyBallType
+    | TELEPORTMODULE
-      --    | BULBODYCRAFT BulletEffect
-      TELEPORTMODULE
     | TIMEMODULE
     | SIZEMODULE
     | GRAVITYMODULE
-    --    | TARGETMODULE TargetingType
     deriving (Eq, Ord, Show, Read)
 
 data AttachType

src/Dodge/Data/Item/Use.hs

@@ -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
+    | UseAttach
-        {_atLinkedProjectile :: Maybe Int}
+        {_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 ''AttachParams
---makeLenses ''ScrollAttachParams
 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

src/Dodge/Item/Ammo.hs

@@ -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
+bulletSynthesizer = makeAttach BULLETSYNTHESIZER
-    & itType .~ ATTACH BULLETSYNTHESIZER
-    & itUse .~ AttachUse Nothing

src/Dodge/Item/Display.hs

@@ -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 {} -> []

src/Dodge/Item/HeldOffset.hs

@@ -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

src/Dodge/Item/Orientation.hs

@@ -1,5 +1,6 @@
 module Dodge.Item.Orientation 
-    where
+    ( 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)

src/Dodge/Item/Scope.hs

@@ -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
+homingModule = makeAttach HOMINGMODULE
-     & itType .~ ATTACH HOMINGMODULE
-     & itUse .~ AttachUse Nothing
 
 fletchingModule :: Item
 fletchingModule = bulletTargetingModule FlechetteTrajectoryType
@@ -45,12 +44,8 @@ bulletPayloadModule :: BulletPayload -> Item
 bulletPayloadModule = bulletModule . BulletModPayload
 
 augmentedHUD :: Item
-augmentedHUD = defaultHeldItem
+augmentedHUD = makeAttach AUGMENTEDHUD
-        & itType .~ ATTACH AUGMENTEDHUD
-        & itUse .~ AttachUse Nothing
 
 remoteScreen :: Item
-remoteScreen =
+remoteScreen = makeAttach REMOTESCREEN
-    defaultHeldItem
+
-        & itType .~ ATTACH REMOTESCREEN
-        & itUse .~ AttachUse Nothing

src/Dodge/Projectile/Create.hs

@@ -47,8 +47,8 @@ createShell homing payload muz cr w = w
     thrustdelay = 20
     updatescreen = fromMaybe id $ do
         screenid <- homing ^? phRemoteID
-        return $ pointerToItemID screenid . itUse
+        return $ pointerToItemID screenid . itUse . uaParams
-                . atLinkedProjectile
+                . apLinkedProjectile
                 ?~ i
     i = IM.newKey $ w ^. cWorld . lWorld . projectiles
     dir = _crDir cr + _mzRot muz

src/Dodge/Projectile/Update.hs

@@ -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 =

src/Dodge/SelectUse.hs

@@ -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

src/Dodge/Update/Camera.hs

@@ -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