Remove targeting bugs
This commit is contained in:
+26
-10
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user