Implement targeting launcher shells using separate item

src/Dodge/Creature/Impulse/UseItem.hs

@@ -1,7 +1,7 @@
 module Dodge.Creature.Impulse.UseItem (
     useRootItem,
     useItemLeftClick,
-    itemEffect,
+    itemUseEffect,
     useItemHotkey,
 ) where
 
@@ -29,11 +29,11 @@ useRootItem crid w = fromMaybe w $ do
         itRef <- cr ^? crManipulation . manObject . imRootItem
         it <- invTrees (_crInv cr) ^? ix itRef
         return $
-            itemEffect cr it w
+            itemUseEffect cr it w
                 & worldEventFlags . at InventoryChange ?~ ()
 
-itemEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
-itemEffect cr it w = case it ^. ldtValue . itUse of
+itemUseEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
+itemUseEffect cr it w = case it ^. ldtValue . itUse of
     HeldUse{ _heldMods = usemods} -> 
         heldEffect usemods it cr w
             & pointerToItem itm . itUse . heldHammer .~ HammerDown
@@ -42,6 +42,7 @@ itemEffect cr it w = case it ^. ldtValue . itUse of
     (ConsumeUse eff) -> useC eff (_ldtValue it) cr w
     CraftUse{} -> w
     AttachUse{} -> selectUse it cr  w
+    TargetingUse {} -> w
     AmmoMagUse{} -> w
     ScopeUse{} -> w
   where
@@ -118,7 +119,7 @@ useItemLeftClick' cr' w = fromMaybe w $ do
     itRef <- cr ^? crManipulation . manObject . imSelectedItem
     it <- invTrees (_crInv cr) ^? ix itRef
     return $
-        itemEffect cr it w
+        itemUseEffect cr it w
             & worldEventFlags . at InventoryChange ?~ ()
 --            & f
 --  where

src/Dodge/Creature/State.hs

@@ -3,9 +3,15 @@ module Dodge.Creature.State (
     doDamage,
 ) where
 
-import Dodge.Item.Display -- this should not really be imported... TODO move canAttachTargetingBelow
-import Control.Applicative
-import Data.Foldable
+import Dodge.Zoning.Creature
+import FoldableHelp
+import Data.Maybe
+import qualified Data.Map.Strict as M
+import qualified SDL
+import Dodge.Creature.Test
+--import Dodge.Item.Display -- this should not really be imported... TODO move canAttachTargetingBelow
+--import Control.Applicative
+--import Data.Foldable
 --import Data.Maybe
 import Dodge.Base
 import Dodge.Corpse.Make
@@ -24,7 +30,7 @@ import Dodge.ItEffect
 --import Dodge.LightSource.Torch
 import Dodge.Prop.Gib
 import Dodge.SoundLogic
-import Dodge.Targeting
+--import Dodge.Targeting
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
@@ -235,19 +241,20 @@ equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEq
 -- a loop going over all inventory items
 invSideEff :: Creature -> World -> World
 invSideEff cr w =
-    updateTargeting (crGetTargeting cr) cr $
+--    updateTargeting (crGetTargeting cr) cr $
 --        weaponReloadSounds cr $
             IM.foldl' f w (_crInv cr)
   where
     -- be careful with side effects that affect creature targeting
-
     f w' it =
         itemInvSideEffect cr it $
             --doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
             w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
 
 itemInvSideEffect :: Creature -> Item -> World -> World
-itemInvSideEffect _ _ = id
+itemInvSideEffect cr itm = case _iyBase $ _itType itm of
+    TARGETING tt -> updateItemTargeting tt cr itm
+    _ -> id 
 --itemInvSideEffect cr it
 --    | hastorchattach = createAttachLight cr it
 --    | otherwise = id
@@ -259,6 +266,65 @@ itemInvSideEffect _ _ = id
 --  where
 --    attachoff = it ^?! itDimension . dimAttachPos
 
+updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
+updateItemTargeting tt cr itm w = w & case tt of
+    _ | not isattached
+        -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
+            ( (tgPos .~ Nothing)
+            . (tgActive .~ False)
+            )
+    TARGETLASER | crIsAiming cr -> cWorld . lWorld . lasers
+            .:~ LaserStart
+                { _lpPhaseV = 1
+                , _lpDir = _crDir cr
+                , _lpPos = sp
+                , _lpColor = col
+                , _lpType = TargetingLaser (_itID itm)
+                }
+    TARGETLASER -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
+        . itUse . tgPos .~ Nothing
+    TargetRBPress | rbpressed 
+        -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
+            ( (tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just)
+            . (tgActive .~ True)
+            )
+    TargetRBPress
+        -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
+            ( (tgPos .~ Nothing)
+            . (tgActive .~ False)
+            )
+    TargetRBCreature -> cWorld . lWorld . creatures . ix (_crID cr) 
+            . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~ setRBCreatureTargeting cr w
+    TargetCursor -> cWorld . lWorld . creatures . ix (_crID cr) 
+            . crInv . ix (_ilInvID $ _itLocation itm) . itUse .~ TargetingUse 
+                (Just (mouseWorldPos (w ^. input) (w ^. wCam))) Nothing True
+    _ -> id
+  where 
+    isattached = itm ^?! itLocation . ilIsAttached 
+    rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
+    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
+    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
+
+setRBCreatureTargeting :: Creature -> World -> ItemUse -> ItemUse
+setRBCreatureTargeting cr w ituse
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? tgID . _Just)
+        && canSeeTarget = ituse & updatePos & tgActive .~ True
+    | otherwise = ituse & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False
+  where
+    newtarg =
+        safeMinimumOn (dist mwp . _crPos)
+            . filter (canseepos . _crPos)
+            $ crsNearCirc mwp 40 w
+    canseepos p = hasLOS (_crPos cr) p w
+    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
+    updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
+    posFromMaybeID Nothing = Nothing
+    posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
+    canSeeTarget = fromMaybe False $ do
+        cid <- ituse ^? tgID . _Just
+        cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
+        Just $ hasLOS cpos (_crPos cr) w
+
 itemUpdate :: Item -> Item
 itemUpdate =
     updateAutoRecharge
@@ -280,19 +346,19 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
 -- I feel like there should be a centralised function that supersumes this
 -- i.e. a function that deals with all states that depend upon item positioning
 -- in the inventory
-crGetTargeting :: Creature -> Maybe TargetType
-crGetTargeting cr = do
-    i <- cr ^? crManipulation . manObject . imRootItem
-    itm <- cr ^? crInv . ix i
-    itm ^? itType . iyModules . ix ModTarget . imtTargetType
-        <|> do
-            tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtAttach . ibtAttachTarget
-            guard (canAttachTargeting tt itm) 
-            return tt
-        <|> do
-            tt <- cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just
-            guard (canAttachTargeting tt itm) 
-            return tt
+--crGetTargeting :: Creature -> Maybe TargetingType
+--crGetTargeting cr = do
+--    i <- cr ^? crManipulation . manObject . imRootItem
+--    itm <- cr ^? crInv . ix i
+--    itm ^? itType . iyModules . ix ModTarget . imtTargetType
+--        <|> do
+--            tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtTargeting
+--            guard (canAttachTargeting tt itm) 
+--            return tt
+--        <|> do
+--            tt <- cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just
+--            guard (canAttachTargeting tt itm) 
+--            return tt
 
 --weaponReloadSounds :: Creature -> World -> World
 --weaponReloadSounds cr w = case cr ^? crManipulation . manObject . inInventory . iselAction of