Remove targeting bugs

src/Dodge/Combine/Module.hs

@@ -18,7 +18,7 @@ moduleModification imt = case imt of
     PENBUL -> itUse . heldConsumption . laAmmoType . amBullet . buEffect .~ PenetrateBullet
     STATICBUL -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall TeslaBall
     CONCUSBUL -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall ConcBall
-    TARGET t -> itUse . useTargeting .~ (Just t)
+    TARGET t -> itUse . useTargeting ?~ t
     MAGNETTRAJ ->
         (itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0)
             . (itUse . heldConsumption . laAmmoType . amBullet . buVel .~ V2 10 0)
@@ -36,7 +36,7 @@ moduleModification imt = case imt of
   where
     makeDirectedTele it =
         it
-            & itUse . useTargeting .~ (Just TargetRBPress)
+            & itUse . useTargeting ?~ TargetRBPress
             & itUse . heldMods %~ ModWithDirectedTeleport -- .:~ withPosDirWallCheck directedTelPos
             -- for the camera: the simplest option is to remove all zoom/offset
             & itUse . heldAim . aimZoom . izFac .~ 1

src/Dodge/Creature/State.hs

@@ -235,10 +235,10 @@ equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEq
 -- a loop going over all inventory items
 invSideEff :: Creature -> World -> World
 invSideEff cr w =
-    crDoTargeting cr $
+    updateTargeting (crGetTargeting cr) cr $
         weaponReloadSounds cr $
-            over (cWorld . lWorld . creatures . ix (_crID cr)) crSetTargeting $
                 IM.foldl' f w (_crInv cr)
+    -- be careful with side effects that affect creature targeting
   where
     f w' it =
         itemInvSideEffect cr it $
@@ -275,11 +275,10 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
         | l < m -> it & itUse . leftConsumption . arProgress -~ 1
     _ -> it
 
-crSetTargeting :: Creature -> Creature
+crGetTargeting :: Creature -> Maybe TargetType
-crSetTargeting cr = fromMaybe cr $ do
+crGetTargeting cr = do
     itm <- find hastargeting $ helditem ++ IM.elems (getCrEquipment cr)
-    tt <- itm ^? itUse . useTargeting . _Just
+    itm ^? itUse . useTargeting . _Just
-    return $ cr & crTargeting . ctType ?~ tt
   where
     hastargeting itm = isJust (itm ^? itUse . useTargeting . _Just)
     helditem = fromMaybe [] $ do
@@ -287,16 +286,6 @@ crSetTargeting cr = fromMaybe cr $ do
         itm <- cr ^? crInv . ix i
         return [itm]
 
-crDoTargeting :: Creature -> World -> World
-crDoTargeting cr = fromMaybe id $ do
-    tt <- cr ^? crTargeting . ctType . _Just
-    return $ updateTargeting tt cr
-
-doItemTargeting :: Int -> Creature -> World -> World
-doItemTargeting invid cr w = case cr ^? crInv . ix invid . itUse . useTargeting . _Just of
-    Nothing -> w
-    Just t -> updateTargeting t cr w
-
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
     Just ReloadAction{_reloadAction = la} ->

src/Dodge/Data/Item/Targeting.hs

@@ -1,14 +1,12 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.Item.Targeting where
 
-import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Geometry.Data
 
 data TargetType
     = TargetLaser

src/Dodge/HeldUse.hs

@@ -346,7 +346,7 @@ useMod hm = case hm of
         yoff x = fromIntegral x - fromIntegral (n' -1) / 2
         n' = _lasCycle (_itParams it)
     thegapDualBeam = _dbGap . _itParams
-    directedTelPos it cr w = (p, a)
+    directedTelPos _ cr w = (p, a)
       where
         p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
         a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- p)

src/Dodge/Item/Equipment.hs

@@ -92,7 +92,7 @@ targetingHat tt =
     defaultEquipment
         & itUse . equipEffect . eeSite .~ GoesOnHead
         & itType . iyBase .~ EQUIP (TARGETINGHAT tt)
-        & itUse . useTargeting .~ (Just tt)
+        & itUse . useTargeting ?~ tt
 
 headLamp :: Item
 headLamp =

src/Dodge/Item/Held/Rod.hs

@@ -72,7 +72,7 @@ sniperRifle =
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 0.5, _izMin = 0.5}
         & itUse . heldScroll .~ HeldScrollZoom -- zoomLongGun
         & itScope .~ ZoomScope (V2 0 0) 0 1 0.5 False
-        & itUse . useTargeting .~ (Just TargetLaser)
+        & itUse . useTargeting ?~ TargetLaser
         & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1}
 
 machineGun :: Item

src/Dodge/Item/Held/Utility.hs

@@ -43,7 +43,7 @@ torch =
 forceFieldGun :: Item
 forceFieldGun =
     defaultWeapon
-        & itUse . useTargeting .~ Just TargetRBLine
+        & itUse . useTargeting ?~ TargetRBLine
         & itParams .~ ParamMID Nothing
         & itUse . heldUse .~ HeldForceField --useForceFieldGun
         & itUse . heldDelay .~ NoDelay

src/Dodge/Targeting.hs

@@ -1,4 +1,6 @@
-module Dodge.Targeting where
+module Dodge.Targeting (
+    updateTargeting,
+) where
 
 import Color
 import qualified Data.Map.Strict as M
@@ -14,13 +16,20 @@ import Geometry.Vector
 import LensHelp
 import qualified SDL
 
-updateTargeting :: TargetType -> Creature -> World -> World
+updateTargeting :: Maybe TargetType -> Creature -> World -> World
 updateTargeting tu = case tu of
-    TargetLaser -> targetLaserUpdate'
+    Nothing -> clearTargeting
-    TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
+    Just TargetLaser -> targetLaserUpdate'
-    TargetRBLine -> upCT (flip targetRBPressUpdate . _crTargeting)
+    Just TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
-    TargetRBCreature -> upCT targetRBCreatureUp
+    Just TargetRBLine -> upCT (flip targetRBPressUpdate . _crTargeting)
-    TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting)
+    Just TargetRBCreature -> upCT targetRBCreatureUp
+    Just TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting)
+
+clearTargeting :: Creature -> World -> World
+clearTargeting cr = cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ defaultTargeting
+
+defaultTargeting :: CreatureTargeting
+defaultTargeting = CreatureTargeting Nothing Nothing Nothing False
 
 upCT :: (Creature -> World -> CreatureTargeting) -> Creature -> World -> World
 upCT f cr w = w & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ f cr w
@@ -29,8 +38,10 @@ targetRBCreatureUp :: Creature -> World -> CreatureTargeting
 targetRBCreatureUp cr w
     | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? ctID . _Just)
         && canSeeTarget =
-        (t & updatePos & ctActive .~ True)
+        t & updatePos & ctActive .~ True
+            & ctType ?~ TargetRBCreature
     | otherwise = t & ctID .~ fmap _crID newtarg & updatePos & ctActive .~ False
+            & ctType ?~ TargetRBCreature
   where
     t = _crTargeting cr
     newtarg =
@@ -52,6 +63,7 @@ targetCursorUpdate w ct =
     ct
         & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
         & ctActive .~ True
+            & ctType ?~ TargetCursor
 
 targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting
 targetRBPressUpdate w t
@@ -59,13 +71,16 @@ targetRBPressUpdate w t
         t
             & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just
             & ctActive .~ True
+            & ctType ?~ TargetRBPress
     | otherwise =
         t
             & ctPos %~ const Nothing
             & ctActive .~ False
+            & ctType ?~ TargetRBPress
 
 targetLaserUpdate' :: Creature -> World -> World
-targetLaserUpdate' cr w = let (w', ct') = targetLaserUpdate cr w (_crTargeting cr)
+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)
@@ -75,6 +90,7 @@ targetLaserUpdate cr w t
         , t
             & ctPos .~ fmap fst mp
             & ctActive .~ True
+            & ctType ?~ TargetLaser
         )
     | otherwise =
         ( w

src/Dodge/Targeting/Draw.hs

@@ -1,4 +1,6 @@
-module Dodge.Targeting.Draw where
+module Dodge.Targeting.Draw (
+    drawTargeting,
+) where
 
 import Data.Maybe
 import Dodge.Base
@@ -13,12 +15,12 @@ drawTargeting :: TargetType -> Creature -> Configuration -> World -> Picture
 drawTargeting td = case td of
     TargetRBCreature -> targetRBCreatureDraw
     TargetRBLine -> targetDistanceDraw
-    TargetLaser -> \_ _ _ -> mempty
+    TargetLaser -> targetSimpleDraw
     TargetRBPress -> targetSimpleDraw
     TargetCursor -> targetSimpleDraw
 
 targetSimpleDraw :: Creature -> Configuration -> World -> Picture
-targetSimpleDraw = targetDraw $ activeTargetCursorPic
+targetSimpleDraw = targetDraw activeTargetCursorPic
 
 targetDistanceDraw :: Creature -> Configuration -> World -> Picture
 targetDistanceDraw cr cfig w = fromMaybe mempty $ do
@@ -43,8 +45,7 @@ targetDraw f cr cfig w = fromMaybe mempty $ do
         winScale cfig $
             setLayer FixedCoordLayer $
                 color white $
-                    uncurryV translate (worldPosToScreen cam p) $
+                    uncurryV translate (worldPosToScreen cam p) f
-                        f
   where
     cam = w ^. cWorld . camPos
 
@@ -66,20 +67,14 @@ targetRBCreatureDraw :: Creature -> Configuration -> World -> Picture
 targetRBCreatureDraw cr = targetDraw thepic cr
   where
     thepic
-        | _ctActive $ _crTargeting $ cr = activeTargetCursorPic
+        | _ctActive $ _crTargeting cr = activeTargetCursorPic
         | otherwise = targetCursorPic
 
 targCorner :: Picture
-targCorner =
+targCorner = line [V2 (x - y) x, V2 x x, V2 x (x - y)]
-    pictures
-        [ line [V2 x x, V2 x (x - y)]
-        , line [V2 x x, V2 (x - y) x]
-        ]
   where
     x = 10
     y = 5
 
 targetCursorPic :: Picture
-targetCursorPic =
+targetCursorPic = pictures [rotate a targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]]
-    pictures
-        [rotate a targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]]

src/Dodge/Update.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+--{-# LANGUAGE BangPatterns #-}
 
 {- |
 Module      : Dodge.Update
@@ -653,7 +653,7 @@ updateSeenWalls :: World -> World
 updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
 
 markWallSeen :: World -> Int -> World
-markWallSeen w i = w & cWorld . seenWalls . at i .~ Just ()
+markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
 --markWallSeen !w !i = w & cWorld . lWorld . walls %~ IM.adjust markSeen i
 -- in the past there might have been a space leak, which the following was meant
 -- to fix