Move targeting functions

src/Dodge/Targeting.hs

@@ -1,7 +1,18 @@
 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 Dodge.Item.Weapon.ExtraEffect
+import qualified SDL
+import qualified Data.Map.Strict as M
+import LensHelp
+import Data.Maybe
 
 updateTargeting :: TargetType -> Item -> Creature -> World -> Targeting -> (World, Targeting)
 updateTargeting tu = case tu of
@@ -10,3 +21,96 @@ updateTargeting tu = case tu of
     TargetRBLine -> targetUpdateWith targetRBPressUpdate
     TargetRBCreature -> targetRBCreatureUp
     TargetCursor -> targetUpdateWith targetCursorUpdate
+
+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)
+        && canSeeTarget =
+        (w, t & updatePos & tgActive .~ True)
+    | otherwise = (w, t & 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 ^. cWorld . camPos)
+    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 <- t ^? tgID . _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 -> 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 w t
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
+        t
+            & tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just
+            & tgActive .~ True
+    | otherwise =
+        t & tgPos %~ const Nothing
+            & tgActive .~ False
+
+targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
+targetLaserUpdate _ cr w t
+    | crIsAiming cr =
+        ( addLaserPic w
+        , t
+            & tgPos .~ fmap fst mp
+            & tgActive .~ True
+        )
+    | otherwise =
+        ( w
+        , t & tgPos %~ const Nothing
+            & tgActive .~ False
+        )
+  where
+    (mp, _) = reflectLaserAlong 0.2 sp ep w
+    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
+    ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- sp)
+    addLaserPic =
+        cWorld . lWorld . lasers
+            .:~ LaserStart
+                { _lpPhaseV = 1
+                , _lpDir = _crDir cr
+                , _lpPos = sp
+                , _lpColor = col
+                , _lpType = TargetingLaser
+                }
+    --wpammo = _itConsumption it
+    --    reloadFrac
+    --        | _laLoaded wpammo == 0 = 1
+    --        | otherwise = case _laTransfer wpammo of
+    --            Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo)
+    --            NoTransfer -> 1
+    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red