diff --git a/src/Dodge/Data/Item/Combine.hs b/src/Dodge/Data/Item/Combine.hs index d59476b6c..c5a7cefdb 100644 --- a/src/Dodge/Data/Item/Combine.hs +++ b/src/Dodge/Data/Item/Combine.hs @@ -106,6 +106,7 @@ data EquipItemType | INVISIBILITYEQUIPMENT EquipSite | BRAINHAT | HAT + | TARGETINGHAT TargetType | HEADLAMP | POWERLEGS | SPEEDLEGS diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index cfaa72e6a..796243cd8 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -38,6 +38,7 @@ itemFromEquipType et = case et of INVISIBILITYEQUIPMENT _ -> error "need to define invisibility for more than wrist" BRAINHAT -> brainHat HAT -> hat + TARGETINGHAT tt -> targetingHat tt HEADLAMP -> headLamp POWERLEGS -> powerLegs SPEEDLEGS -> speedLegs diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index 254494761..b4003a89c 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -36,6 +36,7 @@ equipItemSPic et _ = case et of INVISIBILITYEQUIPMENT _ -> noPic (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2) BRAINHAT -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4) HAT -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4) + TARGETINGHAT _ -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4) HEADLAMP -> noPic headLampShape POWERLEGS -> legsSPic yellow SPEEDLEGS -> legsSPic green diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index f5e5b0b28..31bdacbf6 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -4,6 +4,7 @@ module Dodge.Item.Equipment ( powerLegs, wristInvisibility, wristArmour, + targetingHat, hat, brainHat, frontArmour, @@ -16,6 +17,7 @@ module Dodge.Item.Equipment ( flameShield, ) where +import Dodge.Item.Targeting import Geometry.Data import Dodge.Data.CamouflageStatus import Dodge.Data.Item @@ -86,6 +88,13 @@ hat = & itUse . equipEffect . eeSite .~ GoesOnHead & itType . iyBase .~ EQUIP HAT +targetingHat :: TargetType -> Item +targetingHat tt = + defaultEquipment + & itUse . equipEffect . eeSite .~ GoesOnHead + & itType . iyBase .~ EQUIP (TARGETINGHAT tt) + & itUse . equipTargeting .~ (defaultTargeting & tgType .~ tt) + headLamp :: Item headLamp = defaultEquipment diff --git a/src/Dodge/Item/Info.hs b/src/Dodge/Item/Info.hs index 2d164c036..dfd631e2f 100644 --- a/src/Dodge/Item/Info.hs +++ b/src/Dodge/Item/Info.hs @@ -103,6 +103,7 @@ equipInfo eit = case eit of INVISIBILITYEQUIPMENT _ -> "A DEVICE THAT BENDS LIGHT AROUND ITS USER." BRAINHAT -> "AN IQ ENHANCER. USELESS." HAT -> "A HAT" + TARGETINGHAT tt -> "Headwear that "++ targetingInfo tt HEADLAMP -> "A TORCH STRAPPED TO A HAT." POWERLEGS -> "STRENGTH ENHANCING LEGS." SPEEDLEGS -> "SPEED ENHANCING LEGS." @@ -114,6 +115,14 @@ equipInfo eit = case eit of AUTODETECTOR d -> "A DEVICE THAT DETECTS "++detectorInfo d ++" IN AN EXPANDING RADIUS. PULSES AUTOMATICALLY. " +targetingInfo :: TargetType -> String +targetingInfo tt = case tt of + TargetLaser -> "creates a laser, the end of which becomes the target." + TargetRBPress -> "creates a fixed target." + TargetRBLine -> "creates a line target." + TargetRBCreature -> "targets a creature." + TargetCursor -> "creates a moving target." + consumableInfo :: ConsumableItemType -> String consumableInfo cit = case cit of MEDKIT _ -> "A SELF-USE HEALING KIT." diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 2b82f443d..5f7d49b76 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -8,30 +8,15 @@ module Dodge.Item.Weapon.ExtraEffect ( autoSonarEffect, autoEffect, autoRadarEffect, - targetLaserUpdate, - targetUpdateWith, - targetRBPressUpdate, - targetRBCreatureUp, - targetCursorUpdate, -- , rbSetTarget ) where --import Dodge.Item.Attachment.Data -import qualified Data.Map.Strict as M -import Data.Maybe -import Dodge.Base -import Dodge.Creature.Test import Dodge.Data.World -import Dodge.Item.Weapon.LaserPath import Dodge.RadarSweep import Dodge.SoundLogic -import Dodge.Zoning.Creature -import FoldableHelp -import Geometry.Vector import LensHelp -import Picture -import qualified SDL import Sound.Data autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World @@ -62,97 +47,3 @@ autoRadarEffect = autoEffect (const (aRadarPulse ObWall)) 100 click1S autoSonarEffect :: Item -> Creature -> World -> World autoSonarEffect = autoEffect (const (aRadarPulse ObCreature)) 50 click1S - - -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) - && canSeeTarget = - (w, t & updatePos & tgActive .~ True) - | otherwise = (w, t & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False) - where - 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') - posFromMaybeID Nothing = Nothing - posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos - canSeeTarget = fromMaybe False $ do - cid <- t ^? tgID . _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 -> 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 w t - | SDL.ButtonRight `M.member` _mouseButtons (_input w) = - t - & tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just - & tgActive .~ True - | otherwise = - t & tgPos %~ const Nothing - & tgActive .~ False - -targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) -targetLaserUpdate _ cr w t - | crIsAiming cr = - ( addLaserPic w - , t - & tgPos .~ fmap fst mp - & tgActive .~ True - ) - | otherwise = - ( w - , t & tgPos %~ const Nothing - & tgActive .~ False - ) - where - (mp, _) = reflectLaserAlong 0.2 sp ep w - sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) - ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- sp) - addLaserPic = - cWorld . lWorld . lasers - .:~ LaserStart - { _lpPhaseV = 1 - , _lpDir = _crDir cr - , _lpPos = sp - , _lpColor = col - , _lpType = TargetingLaser - } - --wpammo = _itConsumption it - -- reloadFrac - -- | _laLoaded wpammo == 0 = 1 - -- | otherwise = case _laTransfer wpammo of - -- Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo) - -- NoTransfer -> 1 - col = blue -- mixColors reloadFrac (1-reloadFrac) blue red diff --git a/src/Dodge/Targeting.hs b/src/Dodge/Targeting.hs index 576513c8a..528b8f780 100644 --- a/src/Dodge/Targeting.hs +++ b/src/Dodge/Targeting.hs @@ -1,7 +1,18 @@ 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 Dodge.Item.Weapon.ExtraEffect +import qualified SDL +import qualified Data.Map.Strict as M +import LensHelp +import Data.Maybe updateTargeting :: TargetType -> Item -> Creature -> World -> Targeting -> (World, Targeting) updateTargeting tu = case tu of @@ -10,3 +21,96 @@ updateTargeting tu = case tu of TargetRBLine -> targetUpdateWith targetRBPressUpdate TargetRBCreature -> targetRBCreatureUp TargetCursor -> targetUpdateWith targetCursorUpdate + +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) + && canSeeTarget = + (w, t & updatePos & tgActive .~ True) + | otherwise = (w, t & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False) + where + 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') + posFromMaybeID Nothing = Nothing + posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos + canSeeTarget = fromMaybe False $ do + cid <- t ^? tgID . _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 -> 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 w t + | SDL.ButtonRight `M.member` _mouseButtons (_input w) = + t + & tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just + & tgActive .~ True + | otherwise = + t & tgPos %~ const Nothing + & tgActive .~ False + +targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) +targetLaserUpdate _ cr w t + | crIsAiming cr = + ( addLaserPic w + , t + & tgPos .~ fmap fst mp + & tgActive .~ True + ) + | otherwise = + ( w + , t & tgPos %~ const Nothing + & tgActive .~ False + ) + where + (mp, _) = reflectLaserAlong 0.2 sp ep w + sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) + ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- sp) + addLaserPic = + cWorld . lWorld . lasers + .:~ LaserStart + { _lpPhaseV = 1 + , _lpDir = _crDir cr + , _lpPos = sp + , _lpColor = col + , _lpType = TargetingLaser + } + --wpammo = _itConsumption it + -- reloadFrac + -- | _laLoaded wpammo == 0 = 1 + -- | otherwise = case _laTransfer wpammo of + -- Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo) + -- NoTransfer -> 1 + col = blue -- mixColors reloadFrac (1-reloadFrac) blue red