Require line of sight for creature targeting

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)
-    , _tgNotHeldUpdate = \_ _ w t -> (w,t)
+    , _tgUpdate = \_ _ 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
-    & tgNotHeldUpdate  .~ targetUpdateWith 
-        (const ((tgID .~ Nothing) . (tgPos .~ Nothing) . (tgActive .~ False)))
+    & tgUpdate  .~ targetRBCreatureUp 
 --        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