From 612ee8557993c6d6417ca56c75863a3d3261f68f Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 6 Jan 2023 11:01:32 +0000 Subject: [PATCH] Move towards allowing equipable targeting items --- src/Dodge/Bullet.hs | 6 +- src/Dodge/Combine/Combinations.hs | 9 ++ src/Dodge/Combine/Module.hs | 5 +- src/Dodge/Creature.hs | 1 + src/Dodge/Creature/State.hs | 46 +++++++-- src/Dodge/Data/Creature.hs | 10 ++ src/Dodge/Data/Item/Combine.hs | 2 + src/Dodge/Data/Item/Targeting.hs | 15 +-- src/Dodge/Data/Item/Use.hs | 4 +- src/Dodge/Data/Item/Use/Consumption/Ammo.hs | 2 +- src/Dodge/Default/Creature.hs | 4 + src/Dodge/Default/Item/Use.hs | 4 +- src/Dodge/HeldUse.hs | 4 +- src/Dodge/Item/Equipment.hs | 3 +- src/Dodge/Item/Held/Rod.hs | 3 +- src/Dodge/Item/Held/Utility.hs | 3 +- src/Dodge/Item/Info.hs | 2 + src/Dodge/Item/Targeting.hs | 13 --- src/Dodge/Item/Weapon/Targeting.hs | 6 +- src/Dodge/Projectile/Update.hs | 10 +- src/Dodge/Render/ShapePicture.hs | 5 +- src/Dodge/Targeting.hs | 109 +++++++++----------- src/Dodge/Targeting/Draw.hs | 31 +++--- 23 files changed, 152 insertions(+), 145 deletions(-) delete mode 100644 src/Dodge/Item/Targeting.hs diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 643c7ede9..89ad96178 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -71,13 +71,13 @@ useAmmoParams it cr w = settrajectory traj = case traj of BasicBulletTrajectory -> BasicBulletTrajectory MagnetTrajectory{} -> fromMaybe BasicBulletTrajectory $ do - tpos <- it ^? itUse . heldTargeting . tgPos . _Just + tpos <- cr ^? crTargeting . ctPos . _Just return $ MagnetTrajectory tpos FlechetteTrajectory{} -> fromMaybe BasicBulletTrajectory $ do - tpos <- it ^? itUse . heldTargeting . tgPos . _Just + tpos <- cr ^? crTargeting . ctPos . _Just return $ FlechetteTrajectory tpos BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do - tpos <- it ^? itUse . heldTargeting . tgPos . _Just + tpos <- cr ^? crTargeting . ctPos . _Just return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2 diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index 928dcba82..843ecf451 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -27,11 +27,20 @@ backpackCombinations = po xs it = (map o xs, it) o = (1,) +hatCombinations :: [([(ItAmount,ItemBaseType)],Item)] +hatCombinations = + [ po [EQUIP HAT, CRAFT (TARGETMODULE tt)] (targetingHat tt) | tt <- [minBound..] + ] + where + po xs it = (map o xs, it) + o = (1,) + itemCombinations :: [([(ItAmount, ItemBaseType)], Item)] itemCombinations = watchCombinations ++ backpackCombinations ++ + hatCombinations ++ [ po [CRAFT PIPE, CRAFT HARDWARE] (bangStick 1) , po [HELD (BANGSTICK 1), CRAFT TIN] pistol , po [HELD PISTOL, CRAFT SPRING] autoPistol diff --git a/src/Dodge/Combine/Module.hs b/src/Dodge/Combine/Module.hs index d2e9e3c26..d6d606f39 100644 --- a/src/Dodge/Combine/Module.hs +++ b/src/Dodge/Combine/Module.hs @@ -1,7 +1,6 @@ module Dodge.Combine.Module where import Data.Foldable -import Dodge.Item.Targeting import Dodge.Data.Beam import Dodge.Data.Item import Dodge.Tesla @@ -19,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 . heldTargeting .~ (defaultTargeting & tgType .~ t) + TARGET t -> itUse . useTargeting .~ (Just t) MAGNETTRAJ -> (itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0) . (itUse . heldConsumption . laAmmoType . amBullet . buVel .~ V2 10 0) @@ -37,7 +36,7 @@ moduleModification imt = case imt of where makeDirectedTele it = it - & itUse . heldTargeting .~ (defaultTargeting & tgType .~ TargetRBPress) + & itUse . useTargeting .~ (Just 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.hs b/src/Dodge/Creature.hs index 569a77d8f..947fa855d 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -203,6 +203,7 @@ inventoryX c = case c of ] 'K' -> [ autoRifle + , targetingHat TargetRBPress , makeTypeCraftNum 7 MICROCHIP , makeTypeCraftNum 4 HARDWARE , makeTypeCraftNum 2 MAGNET diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 7b8062348..89ad370ae 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -3,18 +3,19 @@ module Dodge.Creature.State ( doDamage, ) where -import Data.Maybe -import Dodge.Creature.Test import Data.Foldable +import Data.Maybe import Dodge.Base import Dodge.Corpse.Make import Dodge.Creature.Action import Dodge.Creature.Damage import Dodge.Creature.Impulse.Movement import Dodge.Creature.State.WalkCycle +import Dodge.Creature.Test import Dodge.Damage import Dodge.Data.World import Dodge.EnergyBall +import Dodge.Equipment import Dodge.Euse import Dodge.Hammer import Dodge.ItEffect @@ -233,11 +234,16 @@ equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEq -- a loop going over all inventory items invSideEff :: Creature -> World -> World -invSideEff cr w = weaponReloadSounds cr $ IM.foldlWithKey' f w (_crInv cr) +invSideEff cr w = + crDoTargeting cr $ + weaponReloadSounds cr $ + over (cWorld . lWorld . creatures . ix (_crID cr)) crSetTargeting $ + IM.foldl' f w (_crInv cr) where - f w' i it = + f w' it = itemInvSideEffect cr it $ - doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv) + --doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv) + w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv) itemInvSideEffect :: Creature -> Item -> World -> World itemInvSideEffect cr it @@ -269,13 +275,33 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of | l < m -> it & itUse . leftConsumption . arProgress -~ 1 _ -> it +crSetTargeting :: Creature -> Creature +crSetTargeting cr = fromMaybe cr $ do + itm <- find hastargeting $ helditem ++ IM.elems (getCrEquipment cr) + tt <- itm ^? itUse . useTargeting . _Just + return $ cr & crTargeting . ctType ?~ tt + where + hastargeting itm = isJust (itm ^? itUse . useTargeting . _Just) + helditem = fromMaybe [] $ do + i <- cr ^? crInvSel . iselPos + itm <- cr ^? crInv . ix i + return [itm] + +crDoTargeting :: Creature -> World -> World +crDoTargeting cr = fromMaybe id $ do + itm <- find hastargeting $ helditem ++ IM.elems (getCrEquipment cr) + invid <- itm ^? itLocation . ipInvID + return $ doItemTargeting invid cr + where + helditem = maybeToList $ cr ^? crInv . ix (crSel cr) + hastargeting itm = case itm ^? itUse . useTargeting of + Just _ -> True + _ -> False + doItemTargeting :: Int -> Creature -> World -> World -doItemTargeting invid cr w = case cr ^? crInv . ix invid . itUse . heldTargeting of +doItemTargeting invid cr w = case cr ^? crInv . ix invid . itUse . useTargeting . _Just of Nothing -> w - Just NoTargeting -> w - Just t -> - let (w', t') = updateTargeting (_tgType t) (_crInv cr IM.! invid) cr w t - in w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . heldTargeting .~ t' + Just t -> updateTargeting t cr w weaponReloadSounds :: Creature -> World -> World weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index 8866fe117..9e7301e75 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -72,10 +72,18 @@ data Creature = Creature , _crName :: String , _crStatistics :: CreatureStatistics , _crCamouflage :: CamouflageStatus + , _crTargeting :: CreatureTargeting } --deriving (Eq, Show, Read) --Generic, Flat) +data CreatureTargeting = CreatureTargeting + { _ctPos :: Maybe Point2 + , _ctType :: Maybe TargetType + , _ctID :: Maybe Int + , _ctActive :: Bool + } + data CreatureCorpse = MakeDefaultCorpse --deriving (Eq, Ord, Show, Read) --Generic, Flat) @@ -92,6 +100,7 @@ crSel :: Creature -> Int crSel = _iselPos . _crInvSel makeLenses ''Creature +makeLenses ''CreatureTargeting makeLenses ''Intention concat @@ -100,4 +109,5 @@ concat [ ''CreatureCorpse , ''Creature , ''Intention + , ''CreatureTargeting ] diff --git a/src/Dodge/Data/Item/Combine.hs b/src/Dodge/Data/Item/Combine.hs index c5a7cefdb..09c436187 100644 --- a/src/Dodge/Data/Item/Combine.hs +++ b/src/Dodge/Data/Item/Combine.hs @@ -79,6 +79,8 @@ data CraftType | TIMEMODULE | SIZEMODULE | GRAVITYMODULE + + | TARGETMODULE TargetType deriving (Eq,Ord,Show,Read) --deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat) diff --git a/src/Dodge/Data/Item/Targeting.hs b/src/Dodge/Data/Item/Targeting.hs index bc4440c47..c908c7420 100644 --- a/src/Dodge/Data/Item/Targeting.hs +++ b/src/Dodge/Data/Item/Targeting.hs @@ -10,25 +10,12 @@ import Data.Aeson import Data.Aeson.TH import Geometry.Data -data Targeting - = NoTargeting - | Targeting - { _tgPos :: Maybe Point2 - , _tgType :: TargetType --Item -> Creature -> World -> Targeting -> (World, Targeting) --- , _tgDraw :: TargetDraw --Item -> Creature -> Configuration -> World -> Picture - , _tgID :: Maybe Int - , _tgActive :: Bool - } - deriving (Eq, Ord, Show, Read) --Generic, Flat) - data TargetType = TargetLaser | TargetRBPress | TargetRBLine | TargetRBCreature | TargetCursor - deriving (Eq, Ord, Show, Read) --Generic, Flat) + deriving (Eq, Ord, Show, Read, Enum, Bounded) --Generic, Flat) -makeLenses ''Targeting deriveJSON defaultOptions ''TargetType -deriveJSON defaultOptions ''Targeting diff --git a/src/Dodge/Data/Item/Use.hs b/src/Dodge/Data/Item/Use.hs index 0602fad84..98a1ce373 100644 --- a/src/Dodge/Data/Item/Use.hs +++ b/src/Dodge/Data/Item/Use.hs @@ -34,7 +34,7 @@ data ItemUse , _heldAim :: AimParams , _heldScroll :: HeldScroll , _heldConsumption :: HeldConsumption - , _heldTargeting :: Targeting + , _useTargeting :: Maybe TargetType } | LeftUse { _leftUse :: Luse @@ -49,7 +49,7 @@ data ItemUse } | EquipUse { _equipEffect :: EquipEffect - , _equipTargeting :: Targeting + , _useTargeting :: Maybe TargetType } | CraftUse {_useAmount :: ItAmount} diff --git a/src/Dodge/Data/Item/Use/Consumption/Ammo.hs b/src/Dodge/Data/Item/Use/Consumption/Ammo.hs index b2de32e1f..a3774c667 100644 --- a/src/Dodge/Data/Item/Use/Consumption/Ammo.hs +++ b/src/Dodge/Data/Item/Use/Consumption/Ammo.hs @@ -24,7 +24,7 @@ data ProjectileCreate = CreateShell | CreateTrackingShell data ProjectileUpdate = PJThrust {_pjuStart :: Int, _pjuEnd :: Int} | PJSpin {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int} - | PJTrack {_pjuStart :: Int, _pjuEnd :: Int, _pjuITID :: Int} + | PJTrack {_pjuStart :: Int, _pjuEnd :: Int, _pjuCRID :: Int} | PJReduceSpin {_pjuReduceSpin :: Float} | PJRemoteDirection {_pjuStart :: Int, _pjuEnd :: Int, _pjuCID :: Int, _pjuITID :: Int} | PJSetScope {_pjuITID :: Int} diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index 555f2abaf..37b14f9f0 100644 --- a/src/Dodge/Default/Creature.hs +++ b/src/Dodge/Default/Creature.hs @@ -54,8 +54,12 @@ defaultCreature = , _crName = "DEFAULTCRNAME" , _crStatistics = CreatureStatistics 10 10 10 , _crCamouflage = FullyVisible + , _crTargeting = defaultCreatureTargeting } +defaultCreatureTargeting :: CreatureTargeting +defaultCreatureTargeting = CreatureTargeting Nothing Nothing Nothing False + defaultCreatureSkin :: CreatureType defaultCreatureSkin = Humanoid (greyN 0.9) (light4 green) (greyN 0.3) InanimateAI diff --git a/src/Dodge/Default/Item/Use.hs b/src/Dodge/Default/Item/Use.hs index fe8f2c81e..af363c03e 100644 --- a/src/Dodge/Default/Item/Use.hs +++ b/src/Dodge/Default/Item/Use.hs @@ -23,7 +23,7 @@ defaultLeftUse = defaultEquipUse :: ItemUse defaultEquipUse = EquipUse { _equipEffect = defaultEquip - , _equipTargeting = NoTargeting + , _useTargeting = Nothing } defaultHeldUse :: ItemUse @@ -36,5 +36,5 @@ defaultHeldUse = , _heldAim = defaultAimParams , _heldScroll = HeldScrollDoNothing , _heldConsumption = defaultLoadable - , _heldTargeting = NoTargeting + , _useTargeting = Nothing } diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 2579dff12..a8d6c15b1 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -348,7 +348,7 @@ useMod hm = case hm of thegapDualBeam = _dbGap . _itParams directedTelPos it cr w = (p, a) where - p = fromMaybe (_crPos cr) $ it ^? itUse . heldTargeting . tgPos . _Just + p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- p) moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x modcrpos x cr = @@ -511,7 +511,7 @@ shootTeslaArc it cr w = -- TODO investigate more and fix useForceFieldGun :: Item -> Creature -> World -> World useForceFieldGun itm cr w = fromMaybe w $ do - a <- _tgPos . _heldTargeting $ _itUse itm + a <- cr ^? crTargeting . ctPos . _Just let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a) wlline = (a, b) diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 31bdacbf6..2156d6c81 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -17,7 +17,6 @@ module Dodge.Item.Equipment ( flameShield, ) where -import Dodge.Item.Targeting import Geometry.Data import Dodge.Data.CamouflageStatus import Dodge.Data.Item @@ -93,7 +92,7 @@ targetingHat tt = defaultEquipment & itUse . equipEffect . eeSite .~ GoesOnHead & itType . iyBase .~ EQUIP (TARGETINGHAT tt) - & itUse . equipTargeting .~ (defaultTargeting & tgType .~ tt) + & itUse . useTargeting .~ (Just tt) headLamp :: Item headLamp = diff --git a/src/Dodge/Item/Held/Rod.hs b/src/Dodge/Item/Held/Rod.hs index 6d3807a97..28498172f 100644 --- a/src/Dodge/Item/Held/Rod.hs +++ b/src/Dodge/Item/Held/Rod.hs @@ -7,7 +7,6 @@ module Dodge.Item.Held.Rod ( machineGun, ) where -import Dodge.Item.Targeting import Dodge.Data.Item import Dodge.Default import Dodge.Item.Weapon.Bullet @@ -73,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 . heldTargeting .~ (defaultTargeting & tgType .~ TargetLaser) + & itUse . useTargeting .~ (Just 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 581493c2a..5ca87011e 100644 --- a/src/Dodge/Item/Held/Utility.hs +++ b/src/Dodge/Item/Held/Utility.hs @@ -1,6 +1,5 @@ module Dodge.Item.Held.Utility where -import Dodge.Item.Targeting import Dodge.Default.Item import Color import Control.Lens @@ -44,7 +43,7 @@ torch = forceFieldGun :: Item forceFieldGun = defaultWeapon - & itUse . heldTargeting .~ (defaultTargeting & tgType .~ TargetRBLine) + & itUse . useTargeting .~ Just TargetRBLine & itParams .~ ParamMID Nothing & itUse . heldUse .~ HeldForceField --useForceFieldGun & itUse . heldDelay .~ NoDelay diff --git a/src/Dodge/Item/Info.hs b/src/Dodge/Item/Info.hs index dfd631e2f..d3edd56ff 100644 --- a/src/Dodge/Item/Info.hs +++ b/src/Dodge/Item/Info.hs @@ -183,6 +183,8 @@ craftInfo fit = case fit of TIMEMODULE -> "A DEVICE THAT CAN AFFECT TEMPORALITY." SIZEMODULE -> "A DEVICE THAT CAN AFFECT PHYSICAL SIZE." GRAVITYMODULE -> "A DEVICE THAT CAN AFFECT GRAVITATIONAL FIELDS." + + TARGETMODULE _ -> "A TARGETING MODULE." detectorInfo :: Detector -> String diff --git a/src/Dodge/Item/Targeting.hs b/src/Dodge/Item/Targeting.hs deleted file mode 100644 index 645c014e9..000000000 --- a/src/Dodge/Item/Targeting.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Dodge.Item.Targeting where - -import Dodge.Data.Item.Targeting - -defaultTargeting :: Targeting -defaultTargeting = - Targeting - { _tgPos = Nothing - , _tgType = TargetRBPress - --, _tgDraw = NoTargetDraw - , _tgID = Nothing - , _tgActive = False - } diff --git a/src/Dodge/Item/Weapon/Targeting.hs b/src/Dodge/Item/Weapon/Targeting.hs index 47cb91906..ae578bf5b 100644 --- a/src/Dodge/Item/Weapon/Targeting.hs +++ b/src/Dodge/Item/Weapon/Targeting.hs @@ -1,6 +1,5 @@ module Dodge.Item.Weapon.Targeting ( useTargetPos, - removeItTarget, ) where import Control.Lens @@ -12,9 +11,6 @@ useTargetPos :: Creature -> World -> World -useTargetPos f cr w = case cr ^? crInv . ix (crSel cr) . itUse . heldTargeting . tgPos of +useTargetPos f cr w = case cr ^? crTargeting . ctPos of Nothing -> w Just p -> f p cr w - -removeItTarget :: Item -> Item -removeItTarget = itUse . heldTargeting . tgPos .~ Nothing diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index b4ecaa8db..473a3f395 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -64,8 +64,8 @@ upProjectile pu pj = case pu of PJSpin t cid spinamount | ain t -> trySpinByCID cid spinamount pj | otherwise -> id - PJTrack st et itid - | act st et -> pjTrack itid pj + PJTrack st et crid + | act st et -> pjTrack crid pj | otherwise -> id PJReduceSpin x -> reduceSpinBy x pj PJRemoteDirection st et cid itid @@ -136,10 +136,10 @@ trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin spinFactor = 5 * (6 - fromIntegral i) pjTrack :: Int -> Proj -> World -> World -pjTrack itid pj w = rotateToTarget pj w +pjTrack crid pj w = rotateToTarget pj w where rotateToTarget _ = fromMaybe id $ do - tpos <- w ^? itPoint . itUse . heldTargeting . tgPos . _Just + tpos <- w ^? cWorld . lWorld . creatures . ix crid . crTargeting . ctPos . _Just return $ cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount @@ -147,7 +147,7 @@ pjTrack itid pj w = rotateToTarget pj w (_prjPos pj) tpos (argV $ _prjAcc pj) - itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid + --itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid reduceSpinBy :: Float -> Proj -> World -> World reduceSpinBy x pj = cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin *~ x diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index ae79444e2..5fe1bd3cf 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -59,10 +59,11 @@ worldSPic cfig w = pointIsClose = cullPoint cfig w anyTargeting :: Configuration -> World -> SPic -anyTargeting cfig w = (mempty, pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr) +anyTargeting cfig w = fromMaybe mempty $ do + tt <- cr ^? crTargeting . ctType . _Just + return $ noShape $ drawTargeting tt cr cfig w where cr = you w - f it = fmap (\g -> drawTargeting g it cr cfig w) (it ^? itUse . heldTargeting . tgType) drawCreature :: Creature -> SPic drawCreature cr = case _crType cr of diff --git a/src/Dodge/Targeting.hs b/src/Dodge/Targeting.hs index 528b8f780..c41c5ffbc 100644 --- a/src/Dodge/Targeting.hs +++ b/src/Dodge/Targeting.hs @@ -1,98 +1,85 @@ module Dodge.Targeting where import Color -import Dodge.Item.Weapon.LaserPath -import Dodge.Creature.Test -import Dodge.Base.Coordinate -import Dodge.Base.Collide -import Dodge.Zoning.Creature -import Geometry.Vector -import FoldableHelp -import Dodge.Data.World -import qualified SDL import qualified Data.Map.Strict as M -import LensHelp import Data.Maybe +import Dodge.Base.Collide +import Dodge.Base.Coordinate +import Dodge.Creature.Test +import Dodge.Data.World +import Dodge.Item.Weapon.LaserPath +import Dodge.Zoning.Creature +import FoldableHelp +import Geometry.Vector +import LensHelp +import qualified SDL -updateTargeting :: TargetType -> Item -> Creature -> World -> Targeting -> (World, Targeting) +updateTargeting :: TargetType -> Creature -> World -> World updateTargeting tu = case tu of - TargetLaser -> targetLaserUpdate - TargetRBPress -> targetUpdateWith targetRBPressUpdate - TargetRBLine -> targetUpdateWith targetRBPressUpdate - TargetRBCreature -> targetRBCreatureUp - TargetCursor -> targetUpdateWith targetCursorUpdate + TargetLaser -> targetLaserUpdate' + TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting) + TargetRBLine -> upCT (flip targetRBPressUpdate . _crTargeting) + TargetRBCreature -> upCT targetRBCreatureUp + TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting) -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 `M.member` _mouseButtons (_input w) && isJust (t ^? tgID . _Just) +upCT :: (Creature -> World -> CreatureTargeting) -> Creature -> World -> World +upCT f cr w = w & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ f cr w + +targetRBCreatureUp :: Creature -> World -> CreatureTargeting +targetRBCreatureUp cr w + | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? ctID . _Just) && canSeeTarget = - (w, t & updatePos & tgActive .~ True) - | otherwise = (w, t & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False) + (t & updatePos & ctActive .~ True) + | otherwise = t & ctID .~ fmap _crID newtarg & updatePos & ctActive .~ False where + t = _crTargeting cr newtarg = safeMinimumOn (dist mwp . _crPos) . filter (canseepos . _crPos) $ crsNearCirc mwp 40 w canseepos p = hasLOS (_crPos cr) p w mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) - updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t') + updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t') posFromMaybeID Nothing = Nothing posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos canSeeTarget = fromMaybe False $ do - cid <- t ^? tgID . _Just + cid <- t ^? ctID . _Just cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos Just $ hasLOS cpos (_crPos cr) w -targetUpdateWith :: - (World -> Targeting -> Targeting) -> - Item -> - Creature -> - World -> - Targeting -> - (World, Targeting) -targetUpdateWith f it _ w t - | _itIsHeld it = (w, f w t) - | otherwise = (w, t) +targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting +targetCursorUpdate w ct = + ct + & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) + & ctActive .~ True -targetCursorUpdate :: World -> Targeting -> Targeting -targetCursorUpdate w t - | SDL.ButtonRight `M.member` _mouseButtons (_input w) = - t - & tgPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) - & tgActive .~ True - | otherwise = - t & tgPos %~ const Nothing - & tgActive .~ False - -targetRBPressUpdate :: World -> Targeting -> Targeting +targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting targetRBPressUpdate w t | SDL.ButtonRight `M.member` _mouseButtons (_input w) = t - & tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just - & tgActive .~ True + & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just + & ctActive .~ True | otherwise = - t & tgPos %~ const Nothing - & tgActive .~ False + t + & ctPos %~ const Nothing + & ctActive .~ False -targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) -targetLaserUpdate _ cr w t +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 :: Creature -> World -> CreatureTargeting -> (World, CreatureTargeting) +targetLaserUpdate cr w t | crIsAiming cr = ( addLaserPic w , t - & tgPos .~ fmap fst mp - & tgActive .~ True + & ctPos .~ fmap fst mp + & ctActive .~ True ) | otherwise = ( w - , t & tgPos %~ const Nothing - & tgActive .~ False + , t & ctPos %~ const Nothing + & ctActive .~ False ) where (mp, _) = reflectLaserAlong 0.2 sp ep w diff --git a/src/Dodge/Targeting/Draw.hs b/src/Dodge/Targeting/Draw.hs index 8bf25a4fe..2561ad332 100644 --- a/src/Dodge/Targeting/Draw.hs +++ b/src/Dodge/Targeting/Draw.hs @@ -9,21 +9,20 @@ import LensHelp import Picture import ShortShow -drawTargeting :: TargetType -> Item -> Creature -> Configuration -> World -> Picture +drawTargeting :: TargetType -> Creature -> Configuration -> World -> Picture drawTargeting td = case td of --- NoTargetDraw -> \_ _ _ _ -> mempty TargetRBCreature -> targetRBCreatureDraw TargetRBLine -> targetDistanceDraw - TargetLaser -> \_ _ _ _ -> mempty + TargetLaser -> \_ _ _ -> mempty TargetRBPress -> targetSimpleDraw TargetCursor -> targetSimpleDraw -targetSimpleDraw :: Item -> Creature -> Configuration -> World -> Picture -targetSimpleDraw = targetDraw $ const activeTargetCursorPic +targetSimpleDraw :: Creature -> Configuration -> World -> Picture +targetSimpleDraw = targetDraw $ activeTargetCursorPic -targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture -targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do - p <- itm ^? itUse . heldTargeting . tgPos . _Just +targetDistanceDraw :: Creature -> Configuration -> World -> Picture +targetDistanceDraw cr cfig w = fromMaybe mempty $ do + p <- cr ^? crTargeting . ctPos . _Just let p1 = worldPosToScreen cam p mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) p2 = worldPosToScreen cam mwp @@ -37,15 +36,15 @@ targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do where cam = w ^. cWorld . camPos -targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture -targetDraw f it _ cfig w = fromMaybe mempty $ do - p <- it ^? itUse . heldTargeting . tgPos . _Just +targetDraw :: Picture -> Creature -> Configuration -> World -> Picture +targetDraw f cr cfig w = fromMaybe mempty $ do + p <- cr ^? crTargeting . ctPos . _Just return $ winScale cfig $ setLayer FixedCoordLayer $ color white $ uncurryV translate (worldPosToScreen cam p) $ - f it + f where cam = w ^. cWorld . camPos @@ -63,11 +62,11 @@ transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +. | x > x' = min 10 (x - x') | otherwise = max (-10) (x - x') -targetRBCreatureDraw :: Item -> Creature -> Configuration -> World -> Picture -targetRBCreatureDraw = targetDraw thepic +targetRBCreatureDraw :: Creature -> Configuration -> World -> Picture +targetRBCreatureDraw cr = targetDraw thepic cr where - thepic it - | _tgActive $ _heldTargeting $ _itUse it = activeTargetCursorPic + thepic + | _ctActive $ _crTargeting $ cr = activeTargetCursorPic | otherwise = targetCursorPic targCorner :: Picture