Refactor targeting

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -11,7 +11,11 @@ module Dodge.Item.Weapon.ExtraEffect
     , targetRBCreature
     , targetCursor
     , targetLaser
-    , targetDistanceDraw
+    , targetLaserUpdate
+    , targetUpdateWith
+    , targetRBPressUpdate
+    , targetRBCreatureUp
+    , targetCursorUpdate
 --    , rbSetTarget
     ) where
 import Dodge.Data
@@ -25,15 +29,11 @@ import Dodge.Creature.Test
 import Dodge.WorldEvent.HelperParticle
 import Picture
 import Geometry.Vector
-import Geometry.Data
 import LensHelp
 import Sound.Data
-import ShortShow
 
 import qualified Data.Map.Strict as M
---import Data.Bifunctor
 import Data.Maybe
---import qualified Control.Foldl as L
 import qualified Streaming.Prelude as S
 import qualified SDL
 autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
@@ -55,61 +55,27 @@ autoSonarEffect = autoEffect (const (aRadarPulse ObCreature)) 50 click1S
 defaultTargeting :: Targeting
 defaultTargeting = Targeting
     { _tgPos = Nothing
-    , _tgUpdate = \_ _ w t -> (w,t)
-    , _tgDraw = \_ _ _ _ -> mempty
+    , _tgUpdate = NoTargetUpdate
+    , _tgDraw = NoTargetDraw
     , _tgID = Nothing
     , _tgActive = False
     }
 targetLaser :: Targeting
 targetLaser = defaultTargeting
-    & tgUpdate  .~ targetLaserUpdate
+    & tgUpdate  .~ TargetLaserUpdate
 targetRBPress :: Targeting
 targetRBPress = defaultTargeting
-    & tgUpdate  .~ targetUpdateWith targetRBPressUpdate
-    & tgDraw    .~ targetSimpleDraw
+    & tgUpdate  .~ TargetRBPressUpdate
+    & tgDraw    .~ SimpleDrawTarget
 targetRBCreature :: Targeting
 targetRBCreature = defaultTargeting
-    & tgUpdate  .~ targetRBCreatureUp 
-    & tgDraw    .~ targetRBCreatureDraw
+    & tgUpdate  .~ TargetRBCreatureUpdate
+    & tgDraw    .~ TargetRBCreatureDraw
 
 targetCursor :: Targeting
 targetCursor = defaultTargeting
-    & tgUpdate  .~ targetUpdateWith targetCursorUpdate
-    & tgDraw    .~ targetSimpleDraw
-
-targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture
-targetDraw f it _ cfig w = fromMaybe mempty $ do
-    p <- it ^? itTargeting . tgPos . _Just
-    return $ winScale cfig 
-        $ setLayer FixedCoordLayer 
-        $ color white 
-        $ uncurryV translate (worldPosToScreen w p)
-        $ f it
-targetSimpleDraw :: Item -> Creature -> Configuration -> World -> Picture
-targetSimpleDraw = targetDraw $ const activeTargetCursorPic
-
-targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture
-targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do
-    p <- itm ^? itTargeting . tgPos . _Just
-    let p1 = worldPosToScreen w p
-        mwp = mouseWorldPos w
-        p2 = worldPosToScreen w mwp
-        thecol = if dist p mwp > 100 then red else white
-    return $ winScale cfig 
-        $ setLayer FixedCoordLayer 
-        $ color thecol 
-        $ line [p1, p2]
-            <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)
-
-transMidLine :: Point2 -> Point2 -> Picture -> Picture
-transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2))
-  where
-    f (V2 x y) (V2 x' y') 
-        | y > y' && x > x' = max (-10) (x'-x)
-        | y > y' && x < x' = min 10 (x'-x)
-        | x > x'    = min 10 (x-x')
-        | otherwise = max (-10) (x-x')
-
+    & tgUpdate  .~ TargetCursorUpdate
+    & tgDraw    .~ SimpleDrawTarget
 
 targetRBCreatureUp :: Item -> Creature -> World -> Targeting -> (World, Targeting)
 targetRBCreatureUp it cr w t
@@ -140,28 +106,6 @@ targetRBCreatureUp it cr w t
         cpos <- w ^? creatures . ix cid . crPos
         Just $ hasLOS cpos (_crPos cr) w
 
-targetRBCreatureDraw :: Item -> Creature -> Configuration -> World -> Picture
-targetRBCreatureDraw = targetDraw thepic
-  where
-    thepic it | _tgActive $ _itTargeting it = activeTargetCursorPic
-        | otherwise = targetCursorPic
-
-activeTargetCursorPic :: Picture
-activeTargetCursorPic = pictures
-    [rotate a $ line [V2 15 0,V2 10 0] <> targCorner | a <- [0,0.5*pi,pi,1.5*pi]]
-
-targetCursorPic :: Picture
-targetCursorPic = pictures
-    [rotate a targCorner | a <- [0,0.5*pi,pi,1.5*pi]]
-targCorner :: Picture
-targCorner = pictures
-    [line [V2   x  x, V2 x (x-y)]
-    ,line [V2   x  x, V2 (x-y) x]
-    ]
-  where
-    x = 10
-    y = 5
-
 targetUpdateWith :: (World -> Targeting -> Targeting)
     -> Item -> Creature -> World -> Targeting -> (World,Targeting)
 targetUpdateWith f it _ w t 

src/Dodge/Item/Weapon/Utility.hs

@@ -71,7 +71,7 @@ unsafeBlinkGun = blinkGun
 forceFieldGun :: Item
 forceFieldGun = defaultWeapon 
     { _itConsumption = defaultLoadable & laAmmoType .~ ForceFieldAmmo forceField
-    , _itTargeting = targetRBPress & tgDraw .~ targetDistanceDraw
+    , _itTargeting = targetRBPress & tgDraw .~ TargetDistanceDraw
     , _itParams = ParamMID Nothing
     }
     & itUse . rUse .~ HeldForceField --useForceFieldGun