Require line of sight for creature targeting

src/Dodge/Creature/State.hs

@@ -130,9 +130,6 @@ movementSideEff cr w
 
 heldItemUpdate :: Int -> Item -> Item
 heldItemUpdate invid = (itIsHeld .~ True) . invItemUpdate invid
---    . (itUse %~ useupdate)
---  where
---    useupdate = id
 
 invItemUpdate :: Int -> Item -> Item
 invItemUpdate invid = (itUse %~ useupdate) . (itIsHeld .~ False) . (itInvPos ?~ invid)
@@ -153,25 +150,17 @@ invSideEff cr w = weaponReloadSounds cr
         Just g  -> g (_itEffect it) cr i w' & doitemupdate
       where
         doitemupdate 
-            | i == _crInvSel cr =  doHeldItemTargeting cr      . (itpointer %~ heldItemUpdate i) 
+            | i == _crInvSel cr = doItemTargeting i cr . (itpointer %~ heldItemUpdate i) 
-            | otherwise         =  doNotHeldItemTargeting i cr . (itpointer %~ invItemUpdate i)  
+            | otherwise         = doItemTargeting i cr . (itpointer %~ invItemUpdate i)  
         itpointer = creatures . ix (_crID cr) . crInv . ix i
 
-doHeldItemTargeting :: Creature -> World -> World
+doItemTargeting :: Int -> Creature -> World -> World
-doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting of
+doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
     Nothing -> w
     Just NoTargeting -> w
-    Just t  -> let (w',t') = _tgHeldUpdate t (_crInv cr IM.! _crInvSel cr) cr w t
+    Just t  -> let (w',t') = _tgUpdate t (_crInv cr IM.! invid) cr w t
-        in w' & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting .~ t'
---            & testString .~ const ["Held"]
-
-doNotHeldItemTargeting :: Int -> Creature -> World -> World
-doNotHeldItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
-    Nothing -> w
-    Just NoTargeting -> w
-    Just t  -> let (w',t') =  _tgNotHeldUpdate t (_crInv cr IM.! invid) cr w t
         in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
---            & testString .~ const ["Not"]
+--            & testString .~ const ["Held"]
 
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of

src/Dodge/Data.hs

@@ -429,10 +429,9 @@ data ItemValueType = MundaneItem | ArtefactItem
 
 data Targeting
     = NoTargeting
-    | TargetingOnHeld
+    | Targeting
         { _tgPos    :: Maybe Point2
-        , _tgHeldUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
+        , _tgUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
-        , _tgNotHeldUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
         , _tgDraw   :: Int -> Item -> Creature -> Configuration -> World -> Picture
         , _tgID     :: Maybe Int
         , _tgActive :: Bool

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -24,8 +24,11 @@ import Picture
 import Geometry.Vector
 import Geometry.Data
 import LensHelp
+import qualified FoldlHelp as L
 
+--import Data.Bifunctor
 import Data.Maybe
+--import qualified Control.Foldl as L
 import qualified Data.Set as S
 import qualified SDL
 {- | Automatically send out radar pulses that detect walls.  -}
@@ -50,31 +53,28 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
         & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1)
 
 defaultTargeting :: Targeting
-defaultTargeting = TargetingOnHeld
+defaultTargeting = Targeting
     { _tgPos = Nothing
-    , _tgHeldUpdate = \_ _ w t -> (w,t)
+    , _tgUpdate = \_ _ w t -> (w,t)
-    , _tgNotHeldUpdate = \_ _ w t -> (w,t)
     , _tgDraw = \_ _ _ _ -> mempty
     , _tgID = Nothing
     , _tgActive = False
     }
 targetLaser :: Targeting
 targetLaser = defaultTargeting
-    & tgHeldUpdate  .~ targetLaserUpdate
+    & tgUpdate  .~ targetLaserUpdate
 targetRBPress :: Targeting
 targetRBPress = defaultTargeting
-    & tgHeldUpdate  .~ targetUpdateWith targetRBPressUpdate
+    & tgUpdate  .~ targetUpdateWith targetRBPressUpdate
     & tgDraw    .~ targetSimpleDraw
 targetRBCreature :: Targeting
 targetRBCreature = defaultTargeting
-    & tgHeldUpdate  .~ targetUpdateWith targetRBCreatureUpdate
+    & tgUpdate  .~ targetRBCreatureUp 
-    & tgNotHeldUpdate  .~ targetUpdateWith 
-        (const ((tgID .~ Nothing) . (tgPos .~ Nothing) . (tgActive .~ False)))
 --        undefined
     & tgDraw    .~ targetRBCreatureDraw
 targetCursor :: Targeting
 targetCursor = defaultTargeting
-    & tgHeldUpdate  .~ targetUpdateWith targetCursorUpdate
+    & tgUpdate  .~ targetUpdateWith targetCursorUpdate
     & tgDraw    .~ targetSimpleDraw
 targetSimpleDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture
 targetSimpleDraw _ it _ cfig w = fromMaybe mempty $ do
@@ -83,6 +83,34 @@ targetSimpleDraw _ it _ cfig w = fromMaybe mempty $ do
         $ uncurryV translate (worldPosToScreen w p)
 --        $ rotate (_cameraRot w)
         $ activeTargetCursorPic
+targetRBCreatureUp :: Item -> Creature -> World -> Targeting -> (World, Targeting)
+targetRBCreatureUp it cr w t
+    | not $ _itIsHeld it = (w, t   
+        & tgID .~ Nothing
+        & tgPos .~ Nothing
+        & tgActive .~ False
+        )
+    | SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just)
+        && canSeeTarget = (w, t & updatePos
+        & tgActive .~ True
+        )
+    | otherwise = (w, t & tgID .~ fmap _crID newtarg
+        & updatePos
+        & tgActive .~ False 
+        )
+  where
+    newtarg = L.fold 
+        (L.prefilter (canseepos . _crPos) $ L.minimumOn (dist mwp . _crPos)) 
+        $ creaturesNearPointI 3 mwp w
+    canseepos p = hasLOS (_crPos cr) p w
+    mwp = mouseWorldPos w
+    updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
+    posFromMaybeID Nothing = Nothing
+    posFromMaybeID (Just i) = w ^? creatures . ix i . crPos
+    canSeeTarget = fromMaybe False $ do
+        cid <- t ^? tgID . _Just
+        cpos <- w ^? creatures . ix cid . crPos
+        Just $ hasLOS cpos (_crPos cr) w
 
 targetRBCreatureDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture
 targetRBCreatureDraw _ it _ cfig w = fromMaybe mempty $ do