From 79b3a865202e67bf3b36ab94769e4662e679fcc3 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 27 May 2022 18:49:54 +0100 Subject: [PATCH] Improve detector equipment, various cleanup --- src/Dodge/Combine/Data.hs | 13 ++++- src/Dodge/Creature.hs | 16 +++--- src/Dodge/Creature/ChaseCrit.hs | 8 +++ src/Dodge/Creature/Picture.hs | 14 +++-- src/Dodge/Data.hs | 24 +++----- src/Dodge/Default.hs | 1 + src/Dodge/Equipment/Data.hs | 18 ++++++ src/Dodge/Floor.hs | 2 +- src/Dodge/Item/Equipment.hs | 33 +++++------ src/Dodge/Item/Equipment/Shape.hs | 29 ++++++++++ src/Dodge/Item/Weapon/ExtraEffect.hs | 8 +-- src/Dodge/Item/Weapon/Radar.hs | 84 +++++++++------------------- src/Dodge/Item/Weapon/UseEffect.hs | 59 ++++++++++++------- src/Dodge/Machine.hs | 5 +- src/Dodge/SoundLogic.hs | 4 +- 15 files changed, 180 insertions(+), 138 deletions(-) create mode 100644 src/Dodge/Equipment/Data.hs create mode 100644 src/Dodge/Item/Equipment/Shape.hs diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 0d09c31bd..bbe37dcba 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -1,6 +1,8 @@ module Dodge.Combine.Data (CombineType (..) + ,Detector (..) ) where +import Dodge.Equipment.Data -- TODO make this an enum somehow...? data CombineType = NOTDEFINED @@ -74,12 +76,13 @@ data CombineType | FORCEFIELDGUN | SHRINKER -- Equipment - | RADAR - | ITEMFINDER + | CLICKDETECTOR Detector + | AUTODETECTOR Detector | MAGSHIELD | FLAMESHIELD | FRONTARMOUR | WRISTARMOUR + | INVISIBILITYEQUIPMENT EquipSite | BRAINHAT | HEADLAMP | POWERLEGS @@ -139,3 +142,9 @@ data CombineType -- | NoCombineType deriving (Eq,Ord,Show) + +data Detector + = ITEMDETECTOR + | CREATUREDETECTOR + | WALLDETECTOR + deriving (Eq,Ord,Show) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 22037ddae..8422832d4 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -1,14 +1,13 @@ module Dodge.Creature ( module Dodge.Creature + , module Dodge.Creature.ChaseCrit , module Dodge.Creature.Inanimate , launcherCrit , pistolCrit , ltAutoCrit , spreadGunCrit , autoCrit - , chaseCrit , armourChaseCrit - , smallChaseCrit ) where import Dodge.Creature.State.Data import Dodge.Creature.Update @@ -166,7 +165,8 @@ startInventory :: IM.IntMap Item startInventory = IM.fromList $ zip [0..] startInvList inventoryA :: IM.IntMap Item inventoryA = IM.fromList $ zip [0..] - [ makeTypeCraftNum 1 TRANSFORMER + [ clickDetector ITEMDETECTOR + , makeTypeCraftNum 1 TRANSFORMER , makeTypeCraftNum 2 CAN , makeTypeCraftNum 2 PIPE ] @@ -187,9 +187,10 @@ inventoryB = IM.fromList $ zip [0..] ] inventoryC :: IM.IntMap Item inventoryC = IM.fromList $ zip [0..] - [ autoRadar - , autoSonar - , itemFinder + [ autoDetector CREATUREDETECTOR + , autoDetector WALLDETECTOR + , autoDetector ITEMDETECTOR + , wristInvisibility ] testInventory :: IM.IntMap Item @@ -197,8 +198,7 @@ testInventory = IM.fromList $ zip [0..] [ makeTypeCraftNum 9 PIPE , brainHat , headLamp - , autoSonar - , autoRadar + , autoDetector WALLDETECTOR , magShield , frontArmour , wristArmour diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 4ecdb51bc..0b5d3147e 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -1,5 +1,6 @@ module Dodge.Creature.ChaseCrit (smallChaseCrit + ,invisibleChaseCrit ,chaseCrit ) where import Dodge.Data @@ -10,6 +11,7 @@ import Dodge.Creature.ReaderUpdate import Dodge.Creature.Action import Dodge.Creature.Perception import Dodge.Item.Consumable +import Dodge.Item.Equipment import Dodge.SoundLogic --import Geometry import Picture @@ -28,6 +30,12 @@ smallChaseCrit = chaseCrit , _crInv = IM.fromList [(0,medkit 200)] , _crCorpse = setDepth 5 $ color (greyN 0.5) $ circleSolid 4 } +invisibleChaseCrit :: Creature +invisibleChaseCrit = chaseCrit + & crCamouflage .~ Invisible + & crInv . at 0 ?~ wristInvisibility + & crEquipment . at OnLeftWrist ?~ 0 + & crInvEquipped . at 0 ?~ OnLeftWrist chaseCrit :: Creature chaseCrit = defaultCreature { _crUpdate = defaultImpulsive diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 6246a5aca..87a5cde4e 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -61,12 +61,14 @@ basicCrShape :: Color -- ^ Creature color -> Creature -> Shape -basicCrShape col cr = tr . scaleSH (V3 crsize crsize crsize) $ mconcat - [ --rotdir . _spShape $ drawEquipment cr - rotdir . dm . translateSHz 20 $ scalp cr - , rotdir . dm $ upperBody col cr - , dm . rotmdir $ feet cr - ] +basicCrShape col cr + | _crCamouflage cr == Invisible = mempty + | otherwise = tr . scaleSH (V3 crsize crsize crsize) $ mconcat + [ --rotdir . _spShape $ drawEquipment cr + rotdir . dm . translateSHz 20 $ scalp cr + , rotdir . dm $ upperBody col cr + , dm . rotmdir $ feet cr + ] where crsize = 0.1 * _crRad cr dm = damageModSH cr diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 8d70dd9e8..bdec05b0a 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -20,6 +20,7 @@ module Dodge.Data , module Dodge.Item.Attachment.Data , module Dodge.Item.Data , module Dodge.Config.Data + , module Dodge.Equipment.Data ) where import Dodge.ShortShow import Dodge.Creature.State.Data @@ -27,6 +28,7 @@ import Dodge.Creature.Stance.Data import Dodge.Creature.Perception.Data import Dodge.Creature.Memory.Data import Dodge.Distortion.Data +import Dodge.Equipment.Data import Dodge.Data.SoundOrigin import Dodge.Data.DamageType import Dodge.Combine.Data @@ -335,7 +337,12 @@ data Creature = Creature , _crHammerPosition :: HammerPosition , _crName :: String , _crStatistics :: CreatureStatistics + , _crCamouflage :: CamouflageStatus } +data CamouflageStatus + = FullyVisible + | Invisible + deriving (Eq,Ord,Enum) data CreatureStatistics = CreatureStatistics { _crStrength :: Int , _crDexterity :: Int @@ -432,23 +439,6 @@ data ItemUse , _eqParams :: EquipParams } | NoUse -data EquipSite - = GoesOnHead - | GoesOnChest - | GoesOnBack - | GoesOnWrist - | GoesOnLegs - | GoesOnSpecial - deriving (Eq,Ord,Show) -data EquipPosition - = OnHead - | OnChest - | OnBack - | OnLeftWrist - | OnRightWrist - | OnLegs - | OnSpecial - deriving (Eq,Ord,Show) _itUseAimStance :: Item -> AimStance _itUseAimStance = _aimStance . _useAim . _itUse data ItemConsumption diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index ec0ea00e4..c9065ce67 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -64,6 +64,7 @@ defaultCreature = Creature , _crHammerPosition = HammerUp , _crName = "DEFAULTCRNAME" , _crStatistics = CreatureStatistics 10 10 10 + , _crCamouflage = FullyVisible } defaultInanimate :: Creature defaultInanimate = defaultCreature & crActionPlan .~ Inanimate diff --git a/src/Dodge/Equipment/Data.hs b/src/Dodge/Equipment/Data.hs new file mode 100644 index 000000000..b31b94e9a --- /dev/null +++ b/src/Dodge/Equipment/Data.hs @@ -0,0 +1,18 @@ +module Dodge.Equipment.Data where +data EquipSite + = GoesOnHead + | GoesOnChest + | GoesOnBack + | GoesOnWrist + | GoesOnLegs + | GoesOnSpecial + deriving (Eq,Ord,Show) +data EquipPosition + = OnHead + | OnChest + | OnBack + | OnLeftWrist + | OnRightWrist + | OnLegs + | OnSpecial + deriving (Eq,Ord,Show) diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index b77358029..e6f822920 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -40,7 +40,7 @@ initialAnoTree :: Tree [Annotation] initialAnoTree = padSucWithDoors $ treeFromPost [[AnoApplyInt 0 startRoom] , [SpecificRoom $ return (return . UseAll $ roomRectAutoLinks 400 400 - & rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit chaseCrit) + & rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit invisibleChaseCrit) , spNoID anyUnusedSpot (PutCrit armourChaseCrit) ] , TreeSubLabelling "chaseCrit+armourChaseCrit rectRoom" Nothing) diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 054403c5d..b01b4f636 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -1,6 +1,7 @@ module Dodge.Item.Equipment where import Dodge.Data import Dodge.Item.Draw +import Dodge.Item.Equipment.Shape import Dodge.Item.Weapon.InventoryDisplay import Dodge.LightSource import Dodge.Default @@ -58,7 +59,6 @@ frontArmour = defaultEquipment [color thecol $ thickArc 0 (pi/2) 10 5 ,color thecol $ thickArc (3*pi/2) (2*pi) 10 5 ]) - , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqSite .~ GoesOnChest @@ -70,7 +70,6 @@ wristArmour = defaultEquipment { _itType = WRISTARMOUR , _itName = "WRISTARMOUR" , _itEquipPict = spicForWrist mempty - , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqSite .~ GoesOnWrist @@ -109,22 +108,6 @@ setWristShieldPos itm cr w = w | otherwise = id f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr -spicForWrist :: SPic -> Creature -> Item -> SPic -spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4)) -pictureOnEquip :: SPic -> Creature -> Item -> SPic -pictureOnEquip sp cr itm = fromMaybe mempty $ do - i <- _itInvPos itm - epos <- cr^? crInvEquipped . ix i - return $ equipPosition epos cr sp -equipPosition :: EquipPosition -> Creature -> SPic -> SPic -equipPosition epos cr sh = case epos of - OnLeftWrist -> translateToLeftHand cr sh - OnRightWrist -> translateToRightHand cr sh - OnLegs -> translateToLeftLeg cr sh <> - translateToRightLeg cr (mirrorSPxz sh) - OnHead -> translateToHead cr sh - OnChest -> translateToChest cr sh - _ -> sh flatShield :: Item flatShield = defaultEquipment @@ -306,3 +289,17 @@ jumpLegs = powerLegs { _itType = JUMPLEGS , _itName = "JUMPLEGS" } + +wristInvisibility :: Item +wristInvisibility = defaultEquipment + { _itType = INVISIBILITYEQUIPMENT GoesOnWrist + , _itName = "WRISTINVISIBILITY" + , _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2) + , _itID = Nothing + } + & itUse . eqSite .~ GoesOnWrist + & itUse . eqOnEquip .~ overCID (crCamouflage .~ Invisible) + & itUse . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible) + +overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World +overCID f _ cr = creatures . ix (_crID cr) %~ f diff --git a/src/Dodge/Item/Equipment/Shape.hs b/src/Dodge/Item/Equipment/Shape.hs new file mode 100644 index 000000000..0c6267a20 --- /dev/null +++ b/src/Dodge/Item/Equipment/Shape.hs @@ -0,0 +1,29 @@ +module Dodge.Item.Equipment.Shape where +import Dodge.Data +import Dodge.Creature.HandPos +import Shape +import ShapePicture +import Geometry +import LensHelp + +import Data.Maybe + +shapeForWrist :: Shape -> Creature -> Item -> SPic +shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4)) + +spicForWrist :: SPic -> Creature -> Item -> SPic +spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4)) +pictureOnEquip :: SPic -> Creature -> Item -> SPic +pictureOnEquip sp cr itm = fromMaybe mempty $ do + i <- _itInvPos itm + epos <- cr^? crInvEquipped . ix i + return $ equipPosition epos cr sp +equipPosition :: EquipPosition -> Creature -> SPic -> SPic +equipPosition epos cr sh = case epos of + OnLeftWrist -> translateToLeftHand cr sh + OnRightWrist -> translateToRightHand cr sh + OnLegs -> translateToLeftLeg cr sh <> + translateToRightLeg cr (mirrorSPxz sh) + OnHead -> translateToHead cr sh + OnChest -> translateToChest cr sh + _ -> sh diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 21c9fe62f..51691d3e2 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -34,9 +34,9 @@ import Data.Maybe --import qualified Control.Foldl as L import qualified Data.Set as S import qualified SDL -autoEffect :: (Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World +autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World autoEffect eff t sid itm cr w - | _eparamInt (_eqParams (_itUse itm)) < 1 = eff cr w + | _eparamInt (_eqParams (_itUse itm)) < 1 = eff itm cr w & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) . itUse . eqParams . eparamInt .~ t & soundStart OnceSound (_crPos cr) sid Nothing @@ -46,10 +46,10 @@ autoEffect eff t sid itm cr w {- | Automatically send out radar pulses that detect walls. -} autoRadarEffect :: Item -> Creature -> World -> World -autoRadarEffect = autoEffect aWallPulse 100 click1S +autoRadarEffect = autoEffect (const aWallPulse) 100 click1S {- | Automatically send out sonar pulses that detect creatures. -} autoSonarEffect :: Item -> Creature -> World -> World -autoSonarEffect = autoEffect aSonarPulse 50 click1S +autoSonarEffect = autoEffect (const aSonarPulse) 50 click1S defaultTargeting :: Targeting defaultTargeting = Targeting { _tgPos = Nothing diff --git a/src/Dodge/Item/Weapon/Radar.hs b/src/Dodge/Item/Weapon/Radar.hs index cb1e3ea71..4d0207338 100644 --- a/src/Dodge/Item/Weapon/Radar.hs +++ b/src/Dodge/Item/Weapon/Radar.hs @@ -3,7 +3,8 @@ import Dodge.Data --import Dodge.Picture.Layer import Dodge.Default import Dodge.Item.Draw -import Dodge.Item.Equipment +--import Dodge.Item.Equipment +import Dodge.Item.Equipment.Shape import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.UseEffect @@ -14,22 +15,22 @@ import Dodge.SoundLogic import Geometry import Picture import Shape -import ShapePicture +--import ShapePicture import Control.Lens {- | Sends out pulses that display walls. -} -radar :: Item -radar = defaultGun - { _itName = "RADAR" - , _itType = RADAR +clickDetector :: Detector -> Item +clickDetector dt = defaultGun + { _itName = show dt + , _itType = CLICKDETECTOR dt , _itConsumption = defaultAmmo { _ammoBaseMax = 100 , _ammoLoaded = 100 , _reloadTime = 200 } - , _itUse = ruseRate 120 (const aWallPulse) upHammer + , _itUse = ruseRate 20 (detectorEffect dt) upHammer [ ammoUseCheck ] & useAim . aimRange .~ 1 @@ -37,62 +38,27 @@ radar = defaultGun -- , _itZoom = defaultItZoom { _itZoomMax = 1} , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } -{- | -Sends out pulses that display creatures. -} -sonar :: Item -sonar = defaultGun - { _itName = "SONAR" - , _itType = RADAR - , _itConsumption = defaultAmmo - { _ammoBaseMax = 100 - , _ammoLoaded = 100 - , _reloadTime = 200 - } - , _itUse = ruseRate 120 (const aSonarPulse) upHammer - [ ammoUseCheck - ] - & useAim . aimRange .~ 1 - & useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1} - , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) - } -{- | -Automatically sends out pulses that display creatures. -} -autoSonar :: Item -autoSonar = defaultEquipment - { _itType = RADAR - , _itName = "AUTOSONAR" - , _itEquipPict = shapeForWrist (colorSH red $ upperPrismPoly 3 $ rectWH 2 2) - , _itID = Nothing - } & itUse . eqSite .~ GoesOnWrist - & itUse . eqUse .~ autoSonarEffect - & itUse . eqParams .~ EquipCounter 0 -{- | -Automatically sends out pulses that display walls. -} -autoRadar :: Item -autoRadar = defaultEquipment - { _itType = RADAR - , _itName = "WALLFINDER" - , _itEquipPict = shapeForWrist (colorSH red $ upperPrismPoly 3 $ rectWH 2 2) + +autoDetector :: Detector -> Item +autoDetector dt = defaultEquipment + { _itType = AUTODETECTOR dt + , _itName = "AUTO-" ++ show dt + , _itEquipPict = shapeForWrist (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2) -- , _itEffect = autoRadarEffect , _itID = Nothing } & itUse . eqSite .~ GoesOnWrist - & itUse . eqUse .~ autoRadarEffect + & itUse . eqUse .~ autoEffect (detectorEffect dt) 100 click1S & itUse . eqParams .~ EquipCounter 0 -{- | -Automatically sends out pulses that display walls. -} -itemFinder :: Item -itemFinder = defaultEquipment - { _itType = ITEMFINDER - , _itName = "ITEMFINDER" - , _itEquipPict = shapeForWrist (colorSH blue $ upperPrismPoly 3 $ rectWH 2 2) --- , _itEffect = autoRadarEffect - , _itID = Nothing - } - & itUse . eqSite .~ GoesOnWrist - & itUse . eqUse .~ autoEffect anItemFindPulse 100 click1S - & itUse . eqParams .~ EquipCounter 0 +detectorColor :: Detector -> Color +detectorColor dt = case dt of + ITEMDETECTOR -> blue + CREATUREDETECTOR -> green + WALLDETECTOR -> red -shapeForWrist :: Shape -> Creature -> Item -> SPic -shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4)) +detectorEffect :: Detector -> Item -> Creature -> World -> World +detectorEffect dt = case dt of + ITEMDETECTOR -> const anItemFindPulse + CREATUREDETECTOR -> const aSonarPulse + WALLDETECTOR -> const aWallPulse diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index d6cdc14cc..a03af3502 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -16,17 +16,15 @@ import Data.Maybe import qualified Data.IntMap.Strict as IM {- | Creates an outwardly increasing circle that draws creatures, even those behind walls. -} aSonarPulse :: Creature -> World -> World ---aSonarPulse cr = instantParticles .:~ sonarPulseAt (_crPos cr) -aSonarPulse = aRadarPulse crBlips (blipAt 8) green +aSonarPulse = aRadarPulse crBlips (blipAt 8) (withAlpha 0.2 green) aWallPulse :: Creature -> World -> World aWallPulse = aRadarPulse wallBlips (blipAt 2) red {- | Creates an outwardly increasing circle that displays items. -} anItemFindPulse :: Creature -> World -> World -anItemFindPulse = aRadarPulse itemBlips (blipAt 6) blue +anItemFindPulse = aRadarPulse itemBlips (openBlipAt 6) blue -{- | Creates an outwardly increasing circle that displays walls, even those behind other walls. -} aRadarPulse :: (Point2 -> Float -> World -> [Point2]) -> (Point2 -> Color -> Int -> Particle) -> Color @@ -37,7 +35,7 @@ aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle , _ptUpdate = mvRadar blipsF bf col (_crPos cr) , _ptTimer = 100 , _ptRad = 0 - , _ptPos = (_crPos cr) + , _ptPos = _crPos cr } drawPulse :: Color -> Particle -> Picture drawPulse col pt = setLayer DebugLayer $ pictures sweepPics @@ -63,17 +61,39 @@ mvBlip :: Float -> Int -- ^ Max possible timer value -> Int -- ^ Current timer value -> World -> Particle -> (World, Maybe Particle) -mvBlip _ _ _ _ 0 w _ = (w, Nothing) -mvBlip r p col maxt t w pt = - (w - , Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1) - & ptDraw .~ ( const - . setDepth (-0.5) - . setLayer DebugLayer - . uncurryV translate p - . color (withAlpha (fromIntegral t / fromIntegral maxt) col) - $ circleSolid r ) - ) +mvBlip r p col maxt t w pt = case t of + 0 -> (w, Nothing) + _ -> (w + , Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1) + & ptDraw .~ ( const + . setDepth (-0.5) + . setLayer DebugLayer + . uncurryV translate p + . color (withAlpha (fromIntegral t / fromIntegral maxt) col) + $ circleSolid r ) + ) +{- | Radar blip at a point. -} +openBlipAt :: Float -> Point2 -> Color -> Int -> Particle +openBlipAt r p col i = Particle + {_ptDraw = const blank + ,_ptUpdate = mvOpenBlip r p col i i + } +mvOpenBlip :: Float + -> Point2 -> Color + -> Int -- ^ Max possible timer value + -> Int -- ^ Current timer value + -> World -> Particle -> (World, Maybe Particle) +mvOpenBlip r p col maxt t w pt = case t of + 0 -> (w, Nothing) + _ -> (w + , Just $ pt & ptUpdate .~ mvOpenBlip r p col maxt (t-1) + & ptDraw .~ ( const + . setDepth (-0.5) + . setLayer DebugLayer + . uncurryV translate p + . color (withAlpha (fromIntegral t / fromIntegral maxt) col) + $ thickCircle r 3) + ) mvRadar :: (Point2 -> Float -> World -> [Point2]) @@ -102,13 +122,14 @@ itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems f q = dist p q <= r && dist p q > r - 4 wallBlips :: Point2 -> Float -> World -> [Point2] -wallBlips p r w = mapMaybe (\wl -> uncurry (intersectCircSegFirst p r) (_wlLine wl)) +wallBlips p r w = mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine) $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w) ++ IM.elems (wallsAlongCirc p r w) where swp (a,b) = (b,a) crBlips :: Point2 -> Float -> World -> [Point2] -crBlips p r = IM.elems . IM.filter f . fmap _crPos . _creatures +crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures where - f q = dist p q <= r && dist p q > r - 4 + f q = dist p q <= r && dist p q > r - 100 + g cr = _crID cr /= 0 diff --git a/src/Dodge/Machine.hs b/src/Dodge/Machine.hs index b4e6e3065..dfdf51f6d 100644 --- a/src/Dodge/Machine.hs +++ b/src/Dodge/Machine.hs @@ -35,8 +35,9 @@ machineUpdateDeathEff f mc machineAddSound :: SoundID -> (Machine -> World -> World) -> Machine -> World -> World machineAddSound sid f mc w - | dist (_crPos $ you w) (_mcPos mc) < 100 - = soundContinue (MachineSound mid) (_mcPos mc) sid (Just 2) $ f mc w + | d < 200 + = soundContinueVol (1-0.005*d) (MachineSound mid) (_mcPos mc) sid (Just 2) $ f mc w | otherwise = f mc w where + d = dist (_crPos $ you w) (_mcPos mc) mid = _mcID mc diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 882c70565..e5a726749 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -54,7 +54,7 @@ soundWithStatusVolume -> Maybe Int -- ^ Frames to play sound for, Nothing for until finished -> World -> World -soundWithStatusVolume vol status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w +soundWithStatusVolume vol status so pos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound where sound = Sound { _soundChunkID = sType @@ -90,7 +90,7 @@ soundStart -> World -> World soundStart = soundWithStatus ToStart -soundContinue +soundContinue :: SoundOrigin -- ^ \"Creator\" of sound -> Point2 -- ^ Position of sound -> SoundID -- ^ ID of sound to be played