Remove targeting bugs

This commit is contained in:
2023-01-06 12:17:34 +00:00
parent b05f86d130
commit 5b9e0c39b5
10 changed files with 49 additions and 51 deletions
+26 -10
View File
@@ -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'
TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
TargetRBLine -> upCT (flip targetRBPressUpdate . _crTargeting)
TargetRBCreature -> upCT targetRBCreatureUp
TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting)
Nothing -> clearTargeting
Just TargetLaser -> targetLaserUpdate'
Just TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
Just TargetRBLine -> upCT (flip targetRBPressUpdate . _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,14 +71,17 @@ 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)
in w' & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ ct'
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
@@ -75,6 +90,7 @@ targetLaserUpdate cr w t
, t
& ctPos .~ fmap fst mp
& ctActive .~ True
& ctType ?~ TargetLaser
)
| otherwise =
( w