From 5b9e0c39b5d592b5f92e304278853b3f2a3dcda7 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 6 Jan 2023 12:17:34 +0000 Subject: [PATCH] Remove targeting bugs --- src/Dodge/Combine/Module.hs | 4 ++-- src/Dodge/Creature/State.hs | 21 +++++-------------- src/Dodge/Data/Item/Targeting.hs | 4 +--- src/Dodge/HeldUse.hs | 2 +- src/Dodge/Item/Equipment.hs | 2 +- src/Dodge/Item/Held/Rod.hs | 2 +- src/Dodge/Item/Held/Utility.hs | 2 +- src/Dodge/Targeting.hs | 36 +++++++++++++++++++++++--------- src/Dodge/Targeting/Draw.hs | 23 ++++++++------------ src/Dodge/Update.hs | 4 ++-- 10 files changed, 49 insertions(+), 51 deletions(-) diff --git a/src/Dodge/Combine/Module.hs b/src/Dodge/Combine/Module.hs index d6d606f39..19f30160f 100644 --- a/src/Dodge/Combine/Module.hs +++ b/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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index c344737f5..9e6b17d18 100644 --- a/src/Dodge/Creature/State.hs +++ b/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 -crSetTargeting cr = fromMaybe cr $ do +crGetTargeting :: Creature -> Maybe TargetType +crGetTargeting cr = do itm <- find hastargeting $ helditem ++ IM.elems (getCrEquipment cr) - tt <- itm ^? itUse . useTargeting . _Just - return $ cr & crTargeting . ctType ?~ tt + itm ^? itUse . useTargeting . _Just 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} -> diff --git a/src/Dodge/Data/Item/Targeting.hs b/src/Dodge/Data/Item/Targeting.hs index c908c7420..d7ea7cc76 100644 --- a/src/Dodge/Data/Item/Targeting.hs +++ b/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 diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index a8d6c15b1..24f024ff3 100644 --- a/src/Dodge/HeldUse.hs +++ b/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) diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 2156d6c81..a08c901a0 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/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 = diff --git a/src/Dodge/Item/Held/Rod.hs b/src/Dodge/Item/Held/Rod.hs index 28498172f..44debd1d5 100644 --- a/src/Dodge/Item/Held/Rod.hs +++ b/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 diff --git a/src/Dodge/Item/Held/Utility.hs b/src/Dodge/Item/Held/Utility.hs index 5ca87011e..a4a15ca70 100644 --- a/src/Dodge/Item/Held/Utility.hs +++ b/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 diff --git a/src/Dodge/Targeting.hs b/src/Dodge/Targeting.hs index c41c5ffbc..b87f35b84 100644 --- a/src/Dodge/Targeting.hs +++ b/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' - 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 diff --git a/src/Dodge/Targeting/Draw.hs b/src/Dodge/Targeting/Draw.hs index 2561ad332..9aa042c68 100644 --- a/src/Dodge/Targeting/Draw.hs +++ b/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) $ - f + uncurryV translate (worldPosToScreen cam p) 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 = - pictures - [ line [V2 x x, V2 x (x - y)] - , line [V2 x x, V2 (x - y) x] - ] +targCorner = line [V2 (x - y) x, V2 x x, V2 x (x - y)] where x = 10 y = 5 targetCursorPic :: Picture -targetCursorPic = - pictures - [rotate a targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]] +targetCursorPic = pictures [rotate a targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 7c8103ba9..cac189b50 100644 --- a/src/Dodge/Update.hs +++ b/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