Add gimbal and gyroscope, allowing more fine tuned projectile control

src/Dodge/Creature.hs

@@ -240,7 +240,9 @@ inventoryX c = case c of
     'U' ->
         [targetingScope tt | tt <- [minBound .. maxBound]]
         <>
-        [ battery
+        [ gyroscope 
+        , gimbal
+        , battery
         , laser
         , augmentedHUD
         , rLauncher

src/Dodge/Data/ComposedItem.hs

@@ -29,6 +29,7 @@ data ComposeLinkType
     | AugmentedHUDLink
     | FunctionChangeLink
     | MakeAutoLink
+    | ProjectileStabiliserLink
     deriving (Eq, Ord, Show, Read)
 
 data ItemStructuralFunction
@@ -52,6 +53,7 @@ data ItemStructuralFunction
     | AmmoEffectSF AmmoType
     | FunctionChangeSF
     | MakeAutoSF
+    | ProjectileStabiliserSF
     deriving (Eq, Ord, Show, Read)
 
 type ComposedItem = (Item, ItemStructuralFunction, LinkTest)

src/Dodge/Data/Item/Combine.hs

@@ -72,6 +72,8 @@ data AttachType
     | BULLETSYNTH
     | REMOTESCREEN
     | JOYSTICK
+    | GIMBAL
+    | GYROSCOPE
     | REMOTEDETONATOR
     | SMOKEREDUCER
     | HOMINGMODULE

src/Dodge/HeldUse.hs

@@ -300,7 +300,8 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
         MuzzleTesla -> shootTeslaArc itm cr mz w
         MuzzleTractor -> shootTractorBeam cr w
         MuzzleRLauncher -> createProjectileR itmtree magtree mz cr w
-        MuzzleGLauncher -> createProjectile (Grenade (GBounce 2)) magtree mz cr w
+        MuzzleGLauncher -> createProjectile (Grenade (GBounce 2)) magtree 
+            (getPJStabiliser itmtree) mz cr w
         MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
         MuzzleShatter -> shootShatter itm cr w
         MuzzleDetector -> itemDetectorEffect itm cr w
@@ -619,19 +620,30 @@ createProjectileR itmtree magtree =
             (determineProjectileTracking magtree itmtree)
             smoke
         ) magtree
+        (getPJStabiliser itmtree)
   where
     smoke 
         | isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft) = Just ReducedRocketSmoke
         | otherwise = Nothing
 
+
+getPJStabiliser :: LabelDoubleTree ComposeLinkType Item -> Maybe PJStabiliser
+getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of
+    Just ldt' -> case ldt' ^? ldtValue . itType . ibtAttach of
+        Just GIMBAL -> Just StabOrthReduce
+        Just GYROSCOPE -> Just StabSpinIncrease 
+        _ -> Nothing
+    _ -> Nothing
+
 createProjectile ::
     ProjectileType ->
     LabelDoubleTree ComposeLinkType Item ->
+    Maybe PJStabiliser ->
     Muzzle ->
     Creature ->
     World ->
     World
-createProjectile pjtype magtree muz cr = fromMaybe failsound $ do
+createProjectile pjtype magtree stab muz cr = fromMaybe failsound $ do
     magid <- magtree ^? ldtValue . itLocation . ilInvID
     ammoitem <- cr ^? crInv . ix magid
     let rdetonate = (^. ldtValue . itID) <$>
@@ -641,7 +653,7 @@ createProjectile pjtype magtree muz cr = fromMaybe failsound $ do
     aparams <- ((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload))
         <|> ammoitem ^? itConsumables . magParams . ampPayload
     return $
-        createShell rdetonate rscreen pjtype aparams muz cr
+        createShell rdetonate rscreen stab pjtype aparams muz cr
             . startthesound
   where
     -- the sound should be moved to the projectile firing

src/Dodge/Item.hs

@@ -41,6 +41,8 @@ itemFromAttachType at = case at of
     BULLETSYNTH -> bulletSynthesizer
     REMOTESCREEN -> remoteScreen
     JOYSTICK -> joystick
+    GIMBAL -> gimbal
+    GYROSCOPE -> gyroscope
     REMOTEDETONATOR -> remoteDetonator
     SMOKEREDUCER -> smokeReducer
     --    ROCKETHOMER -> rocketHomer

src/Dodge/Item/Display.hs

@@ -78,6 +78,8 @@ showAttachItem t = case t of
     HOMINGMODULE -> "HOMING MOD"
     AUGMENTEDHUD -> "AUGMENTED HUD"
     SHELLPAYLOAD x -> show x
+    GIMBAL -> "GIMBAL"
+    GYROSCOPE -> "GYROSCOPE"
 
 showEquipItem :: EquipItemType -> String
 showEquipItem eit = case eit of

src/Dodge/Item/Grammar.hs

@@ -44,15 +44,17 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
                 dropWhile
                     ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
                     llist
-        (_, linktype) <- safeHead xs
+        (sf, linktype) <- safeHead xs
-        return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
+        return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) 
+            (_2 .~ sf)
     rtest ldt = do
         let xs =
                 dropWhile
                     ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
                     rlist
-        (_, linktype) <- safeHead xs
+        (sf, linktype) <- safeHead xs
-        return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
+        return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) 
+            (_2 .~ sf)
 
 itemToBreakLists ::
     Item ->
@@ -64,6 +66,7 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
         ( getAmmoLinks itm
         , [(WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
             <> getAutoSpringLinks itm
+            <> extraWeaponLinks itm
         )
     (_, GadgetPlatformSF) ->
         ( getAmmoLinks itm
@@ -101,6 +104,15 @@ getAutoSpringLinks itm = case itm ^? itUse . heldTriggerType of
     Just HammerTrigger -> [(MakeAutoSF, MakeAutoLink)]
     _ -> []
 
+extraWeaponLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
+extraWeaponLinks itm = case itm ^. itType of
+    HELD GLAUNCHER -> launcherlinks
+    HELD RLAUNCHER -> launcherlinks
+    HELD RLAUNCHERX{} -> launcherlinks
+    _ -> []
+  where
+    launcherlinks = [(ProjectileStabiliserSF,ProjectileStabiliserLink)]
+
 getAmmoLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
 getAmmoLinks itm =
     map
@@ -139,7 +151,10 @@ itemToFunction itm = case itm ^. itType of
 structureToPotentialFunction ::
     LabelDoubleTree ItemLink ComposedItem ->
     S.Set ItemStructuralFunction
-structureToPotentialFunction = S.singleton . (^. ldtValue . _2)
+structureToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
+    ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
+    ATTACH GYROSCOPE -> S.singleton ProjectileStabiliserSF
+    _ -> S.singleton (ldt ^. ldtValue . _2)
 
 baseCI :: Item -> ComposedItem
 baseCI itm = (itm, itemToFunction itm, itemBaseConnections itm)

src/Dodge/Item/InventoryColor.hs

@@ -28,6 +28,7 @@ itemInvColor ci = case ci ^. _2 of
     AmmoPayloadSF{} -> violet
     AmmoEffectSF{} -> aquamarine
     FunctionChangeSF -> yellow
+    ProjectileStabiliserSF -> white
 
 --ammoTypeColor :: AmmoType -> Color
 --ammoTypeColor = \case

src/Dodge/Item/Scope.hs

@@ -1,4 +1,6 @@
 module Dodge.Item.Scope (
+    gimbal,
+    gyroscope,
     stickyMod,
     shellModule,
     zoomScope,
@@ -75,6 +77,12 @@ remoteDetonator = makeAttach REMOTEDETONATOR
 joystick :: Item
 joystick = makeAttach JOYSTICK
 --    & itUse . uaParams .~ APLinkProjectile Nothing 
+--
+gimbal :: Item
+gimbal = makeAttach GIMBAL
+
+gyroscope :: Item
+gyroscope = makeAttach GYROSCOPE
 
 smokeReducer :: Item
 smokeReducer = makeAttach SMOKEREDUCER

src/Dodge/Projectile/Create.hs

@@ -1,5 +1,6 @@
 module Dodge.Projectile.Create (
     createShell,
+    PJStabiliser (..),
 ) where
 
 import NewInt
@@ -12,12 +13,18 @@ import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 
+data PJStabiliser
+    = StabOrthReduce
+    | StabSpinIncrease
+
+
 -- assumes the mscreen is in your inventory
 createShell ::Maybe (NewInt ItmInt) 
     -> Maybe (NewInt ItmInt) 
+    -> Maybe PJStabiliser
     -> ProjectileType
     -> Payload -> Muzzle -> Creature -> World -> World
-createShell mdetonator mscreen pjtype payload muz cr w = w
+createShell mdetonator mscreen stab pjtype payload muz cr w = w
     & updatescreen
     & updatedetonator
     & cWorld . lWorld . projectiles . at i
@@ -25,23 +32,28 @@ createShell mdetonator mscreen pjtype payload muz cr w = w
             { _pjPos = pos
             , _pjZ = 20
             , _pjZVel = 5
-            , _pjVel = rotateV dir (V2 speed 0) + cr ^. crPos - cr ^. crOldPos
+            , _pjVel = rotateV dir (V2 speed 0) + crvelcomponent
             , _pjID = i
             , _pjDir = dir
             , _pjSpin = 0
             , _pjPayload = payload
             , _pjTimer = lifespan
             , _pjUpdates =
-                [-- TimePU
+                anyspin <>
-                 StartSpinPU (lifespan - 15) (_crID cr) spinamount
+                [ RemoteDirectionPU (lifespan - thrustdelay) 0
-                , RemoteDirectionPU (lifespan - thrustdelay) 0
---                , ReduceSpinPU (1 - spindrag * 2 / 200)
                 ] <> thrustorgrav
             , _pjType = pjtype
             , _pjDetonatorID = mdetonator
             , _pjScreenID = mscreen
             }
   where
+    crvelcomponent = case stab of
+        Just StabOrthReduce -> projV (cr ^. crPos - cr ^. crOldPos) (unitVectorAtAngle dir)
+        _ -> cr ^. crPos - cr ^. crOldPos
+    anyspin = case stab of
+        Just StabOrthReduce -> []
+        Just StabSpinIncrease -> [StartSpinPU (lifespan - 15) (_crID cr) 4]
+        _ -> [StartSpinPU (lifespan - 15) (_crID cr) 2]
     speed = case pjtype of
         Grenade {} -> 4
         Rocket{} -> 1
@@ -51,8 +63,6 @@ createShell mdetonator mscreen pjtype payload muz cr w = w
         Grenade {}-> [ApplyGravityPU]
         Rocket{} -> [ThrustPU (lifespan - thrustdelay) 0]
         RetiredProjectile -> []
---    spindrag = 1
-    spinamount = 2
     thrustdelay = 20
     updatedetonator = fromMaybe id $ do
         screenid <- mdetonator