Move towards allowing equipable targeting items

src/Dodge/Targeting.hs

@@ -1,98 +1,85 @@
 module Dodge.Targeting where
 
 import Color
-import Dodge.Item.Weapon.LaserPath
-import Dodge.Creature.Test
-import Dodge.Base.Coordinate
-import Dodge.Base.Collide
-import Dodge.Zoning.Creature
-import Geometry.Vector
-import FoldableHelp
-import Dodge.Data.World
-import qualified SDL
 import qualified Data.Map.Strict as M
-import LensHelp
 import Data.Maybe
+import Dodge.Base.Collide
+import Dodge.Base.Coordinate
+import Dodge.Creature.Test
+import Dodge.Data.World
+import Dodge.Item.Weapon.LaserPath
+import Dodge.Zoning.Creature
+import FoldableHelp
+import Geometry.Vector
+import LensHelp
+import qualified SDL
 
-updateTargeting :: TargetType -> Item -> Creature -> World -> Targeting -> (World, Targeting)
+updateTargeting :: TargetType -> Creature -> World -> World
 updateTargeting tu = case tu of
-    TargetLaser -> targetLaserUpdate
-    TargetRBPress -> targetUpdateWith targetRBPressUpdate
-    TargetRBLine -> targetUpdateWith targetRBPressUpdate
-    TargetRBCreature -> targetRBCreatureUp
-    TargetCursor -> targetUpdateWith targetCursorUpdate
+    TargetLaser -> targetLaserUpdate'
+    TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
+    TargetRBLine -> upCT (flip targetRBPressUpdate . _crTargeting)
+    TargetRBCreature -> upCT targetRBCreatureUp
+    TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting)
 
-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 `M.member` _mouseButtons (_input w) && isJust (t ^? tgID . _Just)
+upCT :: (Creature -> World -> CreatureTargeting) -> Creature -> World -> World
+upCT f cr w = w & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ f cr w
+
+targetRBCreatureUp :: Creature -> World -> CreatureTargeting
+targetRBCreatureUp cr w
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? ctID . _Just)
         && canSeeTarget =
-        (w, t & updatePos & tgActive .~ True)
-    | otherwise = (w, t & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False)
+        (t & updatePos & ctActive .~ True)
+    | otherwise = t & ctID .~ fmap _crID newtarg & updatePos & ctActive .~ False
   where
+    t = _crTargeting cr
     newtarg =
         safeMinimumOn (dist mwp . _crPos)
             . filter (canseepos . _crPos)
             $ crsNearCirc mwp 40 w
     canseepos p = hasLOS (_crPos cr) p w
     mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
-    updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
+    updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t')
     posFromMaybeID Nothing = Nothing
     posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
     canSeeTarget = fromMaybe False $ do
-        cid <- t ^? tgID . _Just
+        cid <- t ^? ctID . _Just
         cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
         Just $ hasLOS cpos (_crPos cr) w
 
-targetUpdateWith ::
-    (World -> Targeting -> Targeting) ->
-    Item ->
-    Creature ->
-    World ->
-    Targeting ->
-    (World, Targeting)
-targetUpdateWith f it _ w t
-    | _itIsHeld it = (w, f w t)
-    | otherwise = (w, t)
+targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting
+targetCursorUpdate w ct =
+    ct
+        & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+        & ctActive .~ True
 
-targetCursorUpdate :: World -> Targeting -> Targeting
-targetCursorUpdate w t
-    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
-        t
-            & tgPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
-            & tgActive .~ True
-    | otherwise =
-        t & tgPos %~ const Nothing
-            & tgActive .~ False
-
-targetRBPressUpdate :: World -> Targeting -> Targeting
+targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting
 targetRBPressUpdate w t
     | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
         t
-            & tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just
-            & tgActive .~ True
+            & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just
+            & ctActive .~ True
     | otherwise =
-        t & tgPos %~ const Nothing
-            & tgActive .~ False
+        t
+            & ctPos %~ const Nothing
+            & ctActive .~ False
 
-targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
-targetLaserUpdate _ cr w t
+targetLaserUpdate' :: Creature -> World -> World
+targetLaserUpdate' cr w = let (w', ct') = targetLaserUpdate cr w (_crTargeting cr)
+    in w' & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ ct'
+
+targetLaserUpdate :: Creature -> World -> CreatureTargeting -> (World, CreatureTargeting)
+targetLaserUpdate cr w t
     | crIsAiming cr =
         ( addLaserPic w
         , t
-            & tgPos .~ fmap fst mp
-            & tgActive .~ True
+            & ctPos .~ fmap fst mp
+            & ctActive .~ True
         )
     | otherwise =
         ( w
-        , t & tgPos %~ const Nothing
-            & tgActive .~ False
+        , t & ctPos %~ const Nothing
+            & ctActive .~ False
         )
   where
     (mp, _) = reflectLaserAlong 0.2 sp ep w