diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 782e2d23a..c537e820a 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -3,6 +3,7 @@ module Dodge.Creature.State , doDamage ) where import Dodge.Data +import Dodge.Targeting import Dodge.ItEffect import Dodge.Euse import Dodge.EnergyBall @@ -229,7 +230,7 @@ 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') = _tgUpdate t (_crInv cr IM.! invid) cr w t + Just t -> let (w',t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t' weaponReloadSounds :: Creature -> World -> World diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 3c6988797..808f8b6d1 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -438,8 +438,8 @@ data Targeting = NoTargeting | Targeting { _tgPos :: Maybe Point2 - , _tgUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) - , _tgDraw :: Item -> Creature -> Configuration -> World -> Picture + , _tgUpdate :: TargetUpdate --Item -> Creature -> World -> Targeting -> (World, Targeting) + , _tgDraw :: TargetDraw --Item -> Creature -> Configuration -> World -> Picture , _tgID :: Maybe Int , _tgActive :: Bool } diff --git a/src/Dodge/Data/Targeting.hs b/src/Dodge/Data/Targeting.hs index 3a49a6db7..e7aa84e62 100644 --- a/src/Dodge/Data/Targeting.hs +++ b/src/Dodge/Data/Targeting.hs @@ -2,6 +2,13 @@ {-# LANGUAGE StrictData #-} module Dodge.Data.Targeting where -data TargetUpdate = NoTargeting +data TargetUpdate = NoTargetUpdate + | TargetLaserUpdate + | TargetRBPressUpdate + | TargetRBCreatureUpdate + | TargetCursorUpdate -data TargetDraw = SquareTarget +data TargetDraw = NoTargetDraw + | TargetDistanceDraw + | SimpleDrawTarget + | TargetRBCreatureDraw diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 6f847a386..7bba9d495 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -11,7 +11,11 @@ module Dodge.Item.Weapon.ExtraEffect , targetRBCreature , targetCursor , targetLaser - , targetDistanceDraw + , targetLaserUpdate + , targetUpdateWith + , targetRBPressUpdate + , targetRBCreatureUp + , targetCursorUpdate -- , rbSetTarget ) where import Dodge.Data @@ -25,15 +29,11 @@ import Dodge.Creature.Test import Dodge.WorldEvent.HelperParticle import Picture import Geometry.Vector -import Geometry.Data import LensHelp import Sound.Data -import ShortShow import qualified Data.Map.Strict as M ---import Data.Bifunctor import Data.Maybe ---import qualified Control.Foldl as L import qualified Streaming.Prelude as S import qualified SDL autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World @@ -55,61 +55,27 @@ autoSonarEffect = autoEffect (const (aRadarPulse ObCreature)) 50 click1S defaultTargeting :: Targeting defaultTargeting = Targeting { _tgPos = Nothing - , _tgUpdate = \_ _ w t -> (w,t) - , _tgDraw = \_ _ _ _ -> mempty + , _tgUpdate = NoTargetUpdate + , _tgDraw = NoTargetDraw , _tgID = Nothing , _tgActive = False } targetLaser :: Targeting targetLaser = defaultTargeting - & tgUpdate .~ targetLaserUpdate + & tgUpdate .~ TargetLaserUpdate targetRBPress :: Targeting targetRBPress = defaultTargeting - & tgUpdate .~ targetUpdateWith targetRBPressUpdate - & tgDraw .~ targetSimpleDraw + & tgUpdate .~ TargetRBPressUpdate + & tgDraw .~ SimpleDrawTarget targetRBCreature :: Targeting targetRBCreature = defaultTargeting - & tgUpdate .~ targetRBCreatureUp - & tgDraw .~ targetRBCreatureDraw + & tgUpdate .~ TargetRBCreatureUpdate + & tgDraw .~ TargetRBCreatureDraw targetCursor :: Targeting targetCursor = defaultTargeting - & tgUpdate .~ targetUpdateWith targetCursorUpdate - & tgDraw .~ targetSimpleDraw - -targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture -targetDraw f it _ cfig w = fromMaybe mempty $ do - p <- it ^? itTargeting . tgPos . _Just - return $ winScale cfig - $ setLayer FixedCoordLayer - $ color white - $ uncurryV translate (worldPosToScreen w p) - $ f it -targetSimpleDraw :: Item -> Creature -> Configuration -> World -> Picture -targetSimpleDraw = targetDraw $ const activeTargetCursorPic - -targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture -targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do - p <- itm ^? itTargeting . tgPos . _Just - let p1 = worldPosToScreen w p - mwp = mouseWorldPos w - p2 = worldPosToScreen w mwp - thecol = if dist p mwp > 100 then red else white - return $ winScale cfig - $ setLayer FixedCoordLayer - $ color thecol - $ line [p1, p2] - <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp) - -transMidLine :: Point2 -> Point2 -> Picture -> Picture -transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2)) - where - f (V2 x y) (V2 x' y') - | y > y' && x > x' = max (-10) (x'-x) - | y > y' && x < x' = min 10 (x'-x) - | x > x' = min 10 (x-x') - | otherwise = max (-10) (x-x') - + & tgUpdate .~ TargetCursorUpdate + & tgDraw .~ SimpleDrawTarget targetRBCreatureUp :: Item -> Creature -> World -> Targeting -> (World, Targeting) targetRBCreatureUp it cr w t @@ -140,28 +106,6 @@ targetRBCreatureUp it cr w t cpos <- w ^? creatures . ix cid . crPos Just $ hasLOS cpos (_crPos cr) w -targetRBCreatureDraw :: Item -> Creature -> Configuration -> World -> Picture -targetRBCreatureDraw = targetDraw thepic - where - thepic it | _tgActive $ _itTargeting it = activeTargetCursorPic - | otherwise = targetCursorPic - -activeTargetCursorPic :: Picture -activeTargetCursorPic = pictures - [rotate a $ line [V2 15 0,V2 10 0] <> targCorner | a <- [0,0.5*pi,pi,1.5*pi]] - -targetCursorPic :: Picture -targetCursorPic = pictures - [rotate a targCorner | a <- [0,0.5*pi,pi,1.5*pi]] -targCorner :: Picture -targCorner = pictures - [line [V2 x x, V2 x (x-y)] - ,line [V2 x x, V2 (x-y) x] - ] - where - x = 10 - y = 5 - targetUpdateWith :: (World -> Targeting -> Targeting) -> Item -> Creature -> World -> Targeting -> (World,Targeting) targetUpdateWith f it _ w t diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index cab814cd8..5a50c9c81 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -71,7 +71,7 @@ unsafeBlinkGun = blinkGun forceFieldGun :: Item forceFieldGun = defaultWeapon { _itConsumption = defaultLoadable & laAmmoType .~ ForceFieldAmmo forceField - , _itTargeting = targetRBPress & tgDraw .~ targetDistanceDraw + , _itTargeting = targetRBPress & tgDraw .~ TargetDistanceDraw , _itParams = ParamMID Nothing } & itUse . rUse .~ HeldForceField --useForceFieldGun diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 358070f4b..1d816980f 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -1,6 +1,7 @@ module Dodge.Render.ShapePicture ( worldSPic ) where +import Dodge.Targeting.Draw import Dodge.RadarSweep.Draw import Dodge.Projectile.Draw import Dodge.Item.Draw.SPic @@ -72,7 +73,7 @@ anyTargeting :: Configuration -> World -> SPic anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr) where cr = you w - f it = fmap (\g -> g it cr cfig w) (it ^? itTargeting . tgDraw) + f it = fmap (\g -> drawTargeting g it cr cfig w) (it ^? itTargeting . tgDraw) drawCreature :: Creature -> SPic drawCreature cr = case _crType cr of diff --git a/src/Dodge/Targeting.hs b/src/Dodge/Targeting.hs new file mode 100644 index 000000000..e9b1b1fee --- /dev/null +++ b/src/Dodge/Targeting.hs @@ -0,0 +1,11 @@ +module Dodge.Targeting where +import Dodge.Data +import Dodge.Item.Weapon.ExtraEffect + +updateTargeting :: TargetUpdate -> Item -> Creature -> World -> Targeting -> (World, Targeting) +updateTargeting tu = case tu of + NoTargetUpdate -> \_ _ w t -> (w,t) + TargetLaserUpdate -> targetLaserUpdate + TargetRBPressUpdate -> targetUpdateWith targetRBPressUpdate + TargetRBCreatureUpdate -> targetRBCreatureUp + TargetCursorUpdate -> targetUpdateWith targetCursorUpdate diff --git a/src/Dodge/Targeting/Draw.hs b/src/Dodge/Targeting/Draw.hs new file mode 100644 index 000000000..daaa3fc9c --- /dev/null +++ b/src/Dodge/Targeting/Draw.hs @@ -0,0 +1,75 @@ +module Dodge.Targeting.Draw where +import Dodge.Data +import Dodge.Base +import Picture +import Geometry.Vector +import Geometry.Data +import LensHelp +import ShortShow + +import Data.Maybe + +drawTargeting :: TargetDraw -> Item -> Creature -> Configuration -> World -> Picture +drawTargeting td = case td of + NoTargetDraw -> \_ _ _ _ -> mempty + SimpleDrawTarget -> targetSimpleDraw + TargetRBCreatureDraw -> targetRBCreatureDraw + TargetDistanceDraw -> targetDistanceDraw + +targetSimpleDraw :: Item -> Creature -> Configuration -> World -> Picture +targetSimpleDraw = targetDraw $ const activeTargetCursorPic + +targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture +targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do + p <- itm ^? itTargeting . tgPos . _Just + let p1 = worldPosToScreen w p + mwp = mouseWorldPos w + p2 = worldPosToScreen w mwp + thecol = if dist p mwp > 100 then red else white + return $ winScale cfig + $ setLayer FixedCoordLayer + $ color thecol + $ line [p1, p2] + <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp) + +targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture +targetDraw f it _ cfig w = fromMaybe mempty $ do + p <- it ^? itTargeting . tgPos . _Just + return $ winScale cfig + $ setLayer FixedCoordLayer + $ color white + $ uncurryV translate (worldPosToScreen w p) + $ f it + +activeTargetCursorPic :: Picture +activeTargetCursorPic = pictures + [rotate a $ line [V2 15 0,V2 10 0] <> targCorner | a <- [0,0.5*pi,pi,1.5*pi]] + +transMidLine :: Point2 -> Point2 -> Picture -> Picture +transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2)) + where + f (V2 x y) (V2 x' y') + | y > y' && x > x' = max (-10) (x'-x) + | y > y' && x < x' = min 10 (x'-x) + | x > x' = min 10 (x-x') + | otherwise = max (-10) (x-x') + +targetRBCreatureDraw :: Item -> Creature -> Configuration -> World -> Picture +targetRBCreatureDraw = targetDraw thepic + where + thepic it | _tgActive $ _itTargeting it = activeTargetCursorPic + | otherwise = targetCursorPic + +targCorner :: Picture +targCorner = 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 = pictures + [rotate a targCorner | a <- [0,0.5*pi,pi,1.5*pi]] +