Start allowing for more granular control of remote projectiles, cleanup

src/Dodge/Creature.hs

@@ -247,6 +247,7 @@ inventoryX c = case c of
         , megaShellMag
         , homingModule
         , remoteScreen
+        , remoteController
         , remoteDetonator
         , launcherX 3
         , megaShellMag

src/Dodge/Data/ComposedItem.hs

@@ -21,6 +21,7 @@ data ComposeLinkType
     | AmmoEffectLink
     | WeaponScopeLink
     | WeaponTargetingLink
+    | RemoteControllerLink
     | RemoteScreenLink
     | RemoteDetonatorLink
     | AugmentedHUDLink
@@ -38,6 +39,7 @@ data ItemStructuralFunction
     | AugmentedHUDSF
     | AmmoMagSF AmmoType
     | RemoteScreenSF
+    | RemoteControllerSF
     | RemoteDetonatorSF
     | UncomposableIsolateSF
     | AmmoModifierSF AmmoType

src/Dodge/Data/Item/Combine.hs

@@ -70,6 +70,7 @@ data AttachType
     = ZOOMSCOPE
     | BULLETSYNTH
     | REMOTESCREEN
+    | REMOTECONTROLLER
     | REMOTEDETONATOR
     | HOMINGMODULE
     | AUGMENTEDHUD

src/Dodge/Data/Item/Use/Consumption/Ammo.hs

@@ -33,7 +33,10 @@ data ProjectileUpdate
     | ReduceSpinPU {_pjuReduceSpin :: Float}
     | DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt), _pjuTimer :: Int}
     | TimePU
-    | CollisionEffectPU {_pjuScreenID :: Maybe (NewInt ItmInt)}
+    | CollisionEffectPU {_pjuControlID :: Maybe (NewInt ItmInt)
+        ,_pjuDetonatorID :: Maybe (NewInt ItmInt)
+        ,_pjuScreenID :: Maybe (NewInt ItmInt)
+        }
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 
 data AmmoType

src/Dodge/HeldUse.hs

@@ -593,7 +593,7 @@ determineProjectileTracking ::
     LabelDoubleTree ComposeLinkType Item ->
     LabelDoubleTree ComposeLinkType Item ->
     ProjectileHoming
-determineProjectileTracking magtree itmtree = case lookup RemoteScreenLink (magtree ^. ldtLeft) of
+determineProjectileTracking magtree itmtree = case lookup RemoteControllerLink (magtree ^. ldtLeft) of
     Just screen -> HomeUsingRemoteScreen (screen ^. ldtValue . itID)
     Nothing -> fromMaybe NoHoming $ do
         _ <- lookup AmmoTargetingLink (magtree ^. ldtLeft) -- should not have to give a direction
@@ -611,10 +611,14 @@ createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
     magid <- magtree ^? ldtValue . itLocation . ilInvID
     ammoitem <- cr ^? crInv . ix magid
     let homing = determineProjectileTracking magtree itmtree
+        rdetonate = fmap (^. ldtValue . itID) $
+            lookup RemoteDetonatorLink (magtree ^. ldtLeft)
+        rscreen = fmap (^. ldtValue . itID) $
+            lookup RemoteScreenLink (magtree ^. ldtLeft)
     aparams <- ((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload))
         <|> ammoitem ^? itConsumables . magParams . ampPayload
     return $
-        createShell homing aparams muz cr
+        createShell homing rdetonate rscreen aparams muz cr
             . startthesound
   where
     -- the sound should be moved to the projectile firing

src/Dodge/Item.hs

@@ -39,6 +39,7 @@ itemFromAttachType at = case at of
     ZOOMSCOPE -> zoomScope
     BULLETSYNTH -> bulletSynthesizer
     REMOTESCREEN -> remoteScreen
+    REMOTECONTROLLER -> remoteController
     REMOTEDETONATOR -> remoteDetonator
     --    ROCKETHOMER -> rocketHomer
     HOMINGMODULE -> homingModule

src/Dodge/Item/Display.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Item.Display (
     itemDisplay,
     itemBaseName,
@@ -13,6 +14,10 @@ import LensHelp
 import Padding
 import ShortShow
 
+-- Principles: base names should identify an item, numbers can change based on a
+-- variety of factors but typically don't depend on functional quality,
+-- colour gives an indication of an item's function within a structure
+
 itemDisplay :: Creature -> ComposedItem -> [String]
 itemDisplay cr ci =
     zipWithDefaults
@@ -39,7 +44,7 @@ itemDisplayPad ls rs
 basicItemDisplay :: Item -> [String]
 basicItemDisplay itm =
     Prelude.take (itInvHeight itm) $
-        itemBaseName itm :
+        itemBaseName (itm ^. itType) :
         --catMaybes [maybeWarmupStatus itm, maybeRateStatus itm]
         catMaybes [maybeWarmupStatus itm]
             ++ repeat "*"
@@ -47,36 +52,28 @@ basicItemDisplay itm =
 itemString :: Item -> String
 itemString = head . basicItemDisplay
 
-itemBaseName :: Item -> String
+-- this should be immutable with the item type
-itemBaseName itm = case _itType itm of
+itemBaseName :: ItemType -> String
+itemBaseName = \case
     CRAFT str -> show str
     HELD hit -> case hit ^? xNum of
         Just i -> takeWhile (/= ' ') (show hit) ++ show i
         Nothing -> show hit
     EQUIP eit -> showEquipItem eit
-    ATTACH ait -> showAttachItem ait itm
+    ATTACH ait -> showAttachItem ait
     AMMOMAG ait -> show ait
     TARGETING tt -> show tt
 --    BULLETMOD (BulletModTrajectory btt) -> show btt
     BULLETMOD (BulletModPayload btt) -> show btt
     BULLETMOD (BulletModEffect btt) -> show btt
 
-showAttachItem :: AttachType -> Item -> String
+showAttachItem :: AttachType -> String
-showAttachItem t itm = case t of
+showAttachItem t = case t of
     ZOOMSCOPE -> "ZOOMSCOPE"
     BULLETSYNTH -> "BSYNTH"
-    REMOTESCREEN ->
+    REMOTESCREEN -> "REM.SCREEN"
-        "REMOTE SCREEN "
+    REMOTECONTROLLER -> "REM.CONTR0LR"
-            ++ maybe
+    REMOTEDETONATOR -> "REM.DETONATR"
-                mempty
-                show
-                (itm ^? itUse . uaParams . apLinkedProjectile . _Just)
-    REMOTEDETONATOR ->
-        "REM.DETONATOR"
-            ++ maybe
-                mempty
-                show
-                (itm ^? itUse . uaParams . apLinkedProjectile . _Just)
     HOMINGMODULE -> "HOMING MOD"
     AUGMENTEDHUD -> "AUGMENTED HUD"
     SHELLPAYLOAD x -> show x
@@ -86,6 +83,9 @@ showEquipItem eit = case eit of
     INVISIBILITYEQUIPMENT esite -> "INVISIBILITY " ++ show esite
     _ -> show eit
 
+-- this can change, but probably won't when (say) dropped and then picked up
+-- again
+-- that is to say, it should not change based on functional positioning
 itemNumberDisplay :: Creature -> ComposedItem -> [String]
 itemNumberDisplay cr ci
     | EQUIP WRIST_ECG <- ci ^. _1 . itType =
@@ -98,6 +98,7 @@ itemNumberDisplay cr ci
         ["!TARG!"]
     | Just x <- ci ^? _1 . itConsumables . magLoadStatus . iaLoaded = [shortShow x]
     | UseAttach (APInt i) <- ci ^. _1 . itUse = [show i]
+    | UseAttach (APLinkProjectile i) <- ci ^. _1 . itUse = [show i]
     | UseScope OpticScope{_opticZoom = x} <- ci ^. _1 . itUse = [shortShow x]
     | otherwise = mempty
 

src/Dodge/Item/Grammar.hs

@@ -67,6 +67,7 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
         let screenanddet = case atype of
                 LauncherAmmo -> [ (RemoteScreenSF, RemoteScreenLink) 
                     , (RemoteDetonatorSF, RemoteDetonatorLink)
+                    , (RemoteControllerSF, RemoteControllerLink)
                     ]
                 _ -> []
         return
@@ -106,6 +107,7 @@ itemToFunction itm = case itm ^. itType of
             AmmoMagSF amtype
     AMMOMAG{} -> maybe UncomposableIsolateSF AmmoMagSF $ itm ^? itConsumables . magType
     ATTACH REMOTESCREEN -> RemoteScreenSF
+    ATTACH REMOTECONTROLLER -> RemoteControllerSF
     ATTACH REMOTEDETONATOR -> RemoteDetonatorSF
     ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
     ATTACH ZOOMSCOPE -> WeaponScopeSF

src/Dodge/Item/InventoryColor.hs

@@ -18,6 +18,7 @@ itemInvColor ci = case ci ^. _2 of
     AugmentedHUDSF -> rose
     AmmoMagSF{} -> red
     RemoteScreenSF -> azure
+    RemoteControllerSF -> azure
     RemoteDetonatorSF -> azure
     UncomposableIsolateSF -> greyN 0.5
     AmmoModifierSF{} -> orange

src/Dodge/Item/Scope.hs

@@ -3,6 +3,7 @@ module Dodge.Item.Scope (
     zoomScope,
     targetingScope,
     remoteScreen,
+    remoteController,
     remoteDetonator,
     homingModule,
 --    bulletTargetingModule,
@@ -61,3 +62,7 @@ remoteScreen = makeAttach REMOTESCREEN
 remoteDetonator :: Item
 remoteDetonator = makeAttach REMOTEDETONATOR
     & itUse . uaParams .~ APLinkProjectile Nothing 
+
+remoteController :: Item
+remoteController = makeAttach REMOTECONTROLLER
+    & itUse . uaParams .~ APLinkProjectile Nothing 

src/Dodge/Projectile/Create.hs

@@ -2,6 +2,9 @@ module Dodge.Projectile.Create (
     createShell,
 ) where
 
+import NewInt
+--import Dodge.Data.ComposedItem
+--import Dodge.Data.DoubleTree
 import Dodge.Item.Location
 import Data.Maybe
 import Dodge.Data.World
@@ -16,9 +19,13 @@ homingDrawType ht = case ht of
     HomeUsingTargeting {} -> DrawRemoteShell
 
 -- assumes the mscreen is in your inventory
-createShell :: ProjectileHoming -> Payload -> Muzzle -> Creature -> World -> World
+createShell :: ProjectileHoming 
-createShell homing payload muz cr w = w
+    -> Maybe (NewInt ItmInt) 
+    -> Maybe (NewInt ItmInt) 
+    -> Payload -> Muzzle -> Creature -> World -> World
+createShell homing mdetonator mscreen payload muz cr w = w
     & updatescreen
+    & updatedetonator
     & cWorld . lWorld . projectiles . at i
         ?~ Shell
             { _prjPos = pos
@@ -33,7 +40,7 @@ createShell homing payload muz cr w = w
             , _prjPayload = payload
             , _prjTimer = 350
             , _prjUpdates =
-                [ CollisionEffectPU (homing ^? phRemoteID) --Just screenid)
+                [ CollisionEffectPU (homing ^? phRemoteID) mdetonator mscreen
                 , TimePU
                 , StartSpinPU 335 (_crID cr) spinamount
                 , RemoteDirectionPU (350 - thrustdelay) 0 homing
@@ -45,6 +52,11 @@ createShell homing payload muz cr w = w
     spindrag = 1
     spinamount = 2
     thrustdelay = 20
+    updatedetonator = fromMaybe id $ do
+        screenid <- mdetonator
+        return $ pointerToItemID screenid . itUse . uaParams
+                . apLinkedProjectile
+                ?~ i
     updatescreen = fromMaybe id $ do
         screenid <- homing ^? phRemoteID
         return $ pointerToItemID screenid . itUse . uaParams

src/Dodge/Projectile/Update.hs

@@ -25,8 +25,8 @@ updateProjectile pj w = foldl' (\w' pu -> upProjectile pu pj w') w (_prjUpdates
 
 upProjectile :: ProjectileUpdate -> Projectile -> World -> World
 upProjectile pu pj = case pu of
-    CollisionEffectPU mscreenid -> shellCollisionCheck 
+    CollisionEffectPU mcontrolid mdetonatorid mscreenid -> shellCollisionCheck 
-        mscreenid pj
+        mcontrolid mdetonatorid mscreenid pj
     TimePU -> decTimMvVel pj
     ThrustPU st et
         | act st et -> doThrust pj
@@ -47,14 +47,17 @@ upProjectile pu pj = case pu of
     act st et = time <= st && time >= et
 
 --shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World
-shellCollisionCheck :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
+shellCollisionCheck :: Maybe (NewInt ItmInt) 
-shellCollisionCheck f pj w
+    -> Maybe (NewInt ItmInt) 
+    -> Maybe (NewInt ItmInt) 
+    -> Projectile -> World -> World
+shellCollisionCheck controlid detid screenid pj w
     | time > 330 && circOnSomeWall oldPos 4 w = g
     | time <= 330 && anythingHitCirc 2 oldPos newPos w = g
     | time <= 0 = g
     | otherwise = w
   where
-    g = explodeShell f pj w
+    g = explodeShell controlid detid screenid pj w
     time = _prjTimer pj
     oldPos = _prjPos pj
     newPos = oldPos +.+ _prjVel pj
@@ -154,12 +157,25 @@ decTimMvVel pj =
     vel = _prjVel pj
     pjid = _prjID pj
 
-explodeShell :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
+explodeShell :: Maybe (NewInt ItmInt) -> 
-explodeShell mitid pj w =
+    Maybe (NewInt ItmInt) -> 
+    Maybe (NewInt ItmInt) -> 
+    Projectile -> World -> World
+explodeShell controlid mdetid screenid pj w =
     w
-        & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU mitid 30]
+        & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU screenid 30]
         & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
         & usePayload (_prjPayload pj) (_prjPos pj) (_prjVel pj)
         & stopSoundFrom (ShellSound pjid)
+        & updatedetonator
+        & updatecontroller
   where
+    updatedetonator = fromMaybe id $ do
+        detid <- mdetid
+        return $ pointerToItemID detid . itUse . uaParams . apLinkedProjectile %~ deleteif
+    deleteif (Just x) | x == pjid = Nothing
+    deleteif x = x
+    updatecontroller = fromMaybe id $ do
+        cid <- controlid
+        return $ pointerToItemID cid . itUse . uaParams . apLinkedProjectile %~ deleteif
     pjid = pj ^. prjID

src/Dodge/Render/HUD.hs

@@ -289,8 +289,8 @@ drawRBOptions cfig w = fromMaybe mempty $ do
         | a == b - 1 = listCursorChooseBorderScale 0 1 (bc South) curpos 0 white 7 1
         | otherwise = mempty
     otheritem j = fromMaybe "" $ do
-        itm <- you w ^? crInv . ix j
+        itype <- you w ^? crInv . ix j . itType
-        return $ itemBaseName itm
+        return $ itemBaseName ittype
 
 equipAllocString :: EquipmentAllocation -> String
 equipAllocString = \case