diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 7c4ff8c19..404fe12c1 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -130,9 +130,6 @@ movementSideEff cr w heldItemUpdate :: Int -> Item -> Item heldItemUpdate invid = (itIsHeld .~ True) . invItemUpdate invid --- . (itUse %~ useupdate) --- where --- useupdate = id invItemUpdate :: Int -> Item -> Item invItemUpdate invid = (itUse %~ useupdate) . (itIsHeld .~ False) . (itInvPos ?~ invid) @@ -153,25 +150,17 @@ invSideEff cr w = weaponReloadSounds cr Just g -> g (_itEffect it) cr i w' & doitemupdate where doitemupdate - | i == _crInvSel cr = doHeldItemTargeting cr . (itpointer %~ heldItemUpdate i) - | otherwise = doNotHeldItemTargeting i cr . (itpointer %~ invItemUpdate i) + | i == _crInvSel cr = doItemTargeting i cr . (itpointer %~ heldItemUpdate i) + | otherwise = doItemTargeting i cr . (itpointer %~ invItemUpdate i) itpointer = creatures . ix (_crID cr) . crInv . ix i -doHeldItemTargeting :: Creature -> World -> World -doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting of +doItemTargeting :: Int -> Creature -> World -> World +doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of Nothing -> w Just NoTargeting -> w - Just t -> let (w',t') = _tgHeldUpdate t (_crInv cr IM.! _crInvSel cr) cr w t - in w' & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting .~ t' --- & testString .~ const ["Held"] - -doNotHeldItemTargeting :: Int -> Creature -> World -> World -doNotHeldItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of - Nothing -> w - Just NoTargeting -> w - Just t -> let (w',t') = _tgNotHeldUpdate t (_crInv cr IM.! invid) cr w t + Just t -> let (w',t') = _tgUpdate t (_crInv cr IM.! invid) cr w t in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t' --- & testString .~ const ["Not"] +-- & testString .~ const ["Held"] weaponReloadSounds :: Creature -> World -> World weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 99a9629f0..fb1f40930 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -429,10 +429,9 @@ data ItemValueType = MundaneItem | ArtefactItem data Targeting = NoTargeting - | TargetingOnHeld + | Targeting { _tgPos :: Maybe Point2 - , _tgHeldUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) - , _tgNotHeldUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) + , _tgUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) , _tgDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture , _tgID :: Maybe Int , _tgActive :: Bool diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 0dd24d65f..f7849ba54 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -24,8 +24,11 @@ import Picture import Geometry.Vector import Geometry.Data import LensHelp +import qualified FoldlHelp as L +--import Data.Bifunctor import Data.Maybe +--import qualified Control.Foldl as L import qualified Data.Set as S import qualified SDL {- | Automatically send out radar pulses that detect walls. -} @@ -50,31 +53,28 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1) defaultTargeting :: Targeting -defaultTargeting = TargetingOnHeld +defaultTargeting = Targeting { _tgPos = Nothing - , _tgHeldUpdate = \_ _ w t -> (w,t) - , _tgNotHeldUpdate = \_ _ w t -> (w,t) + , _tgUpdate = \_ _ w t -> (w,t) , _tgDraw = \_ _ _ _ -> mempty , _tgID = Nothing , _tgActive = False } targetLaser :: Targeting targetLaser = defaultTargeting - & tgHeldUpdate .~ targetLaserUpdate + & tgUpdate .~ targetLaserUpdate targetRBPress :: Targeting targetRBPress = defaultTargeting - & tgHeldUpdate .~ targetUpdateWith targetRBPressUpdate + & tgUpdate .~ targetUpdateWith targetRBPressUpdate & tgDraw .~ targetSimpleDraw targetRBCreature :: Targeting targetRBCreature = defaultTargeting - & tgHeldUpdate .~ targetUpdateWith targetRBCreatureUpdate - & tgNotHeldUpdate .~ targetUpdateWith - (const ((tgID .~ Nothing) . (tgPos .~ Nothing) . (tgActive .~ False))) + & tgUpdate .~ targetRBCreatureUp -- undefined & tgDraw .~ targetRBCreatureDraw targetCursor :: Targeting targetCursor = defaultTargeting - & tgHeldUpdate .~ targetUpdateWith targetCursorUpdate + & tgUpdate .~ targetUpdateWith targetCursorUpdate & tgDraw .~ targetSimpleDraw targetSimpleDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture targetSimpleDraw _ it _ cfig w = fromMaybe mempty $ do @@ -83,6 +83,34 @@ targetSimpleDraw _ it _ cfig w = fromMaybe mempty $ do $ uncurryV translate (worldPosToScreen w p) -- $ rotate (_cameraRot w) $ activeTargetCursorPic +targetRBCreatureUp :: Item -> Creature -> World -> Targeting -> (World, Targeting) +targetRBCreatureUp it cr w t + | not $ _itIsHeld it = (w, t + & tgID .~ Nothing + & tgPos .~ Nothing + & tgActive .~ False + ) + | SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just) + && canSeeTarget = (w, t & updatePos + & tgActive .~ True + ) + | otherwise = (w, t & tgID .~ fmap _crID newtarg + & updatePos + & tgActive .~ False + ) + where + newtarg = L.fold + (L.prefilter (canseepos . _crPos) $ L.minimumOn (dist mwp . _crPos)) + $ creaturesNearPointI 3 mwp w + canseepos p = hasLOS (_crPos cr) p w + mwp = mouseWorldPos w + updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t') + posFromMaybeID Nothing = Nothing + posFromMaybeID (Just i) = w ^? creatures . ix i . crPos + canSeeTarget = fromMaybe False $ do + cid <- t ^? tgID . _Just + cpos <- w ^? creatures . ix cid . crPos + Just $ hasLOS cpos (_crPos cr) w targetRBCreatureDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture targetRBCreatureDraw _ it _ cfig w = fromMaybe mempty $ do