justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor targeting

Browse Source
This commit is contained in:
justin
2022-07-21 00:10:05 +01:00
parent a89b0c784f
commit 39117b4dfe
8 changed files with 116 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/State.hs
+2 -1
View File
@@ -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
src/Dodge/Data.hs
+2 -2
View File
@@ -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
}
src/Dodge/Data/Targeting.hs
+9 -2
View File
@@ -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
src/Dodge/Item/Weapon/ExtraEffect.hs
+14 -70
View File
@@ -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
src/Dodge/Item/Weapon/Utility.hs
+1 -1
View File
@@ -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
src/Dodge/Render/ShapePicture.hs
+2 -1
View File
@@ -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
src/Dodge/Targeting.hs
+11
View File
@@ -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
src/Dodge/Targeting/Draw.hs
+75
View File
@@ -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]]