diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index f0f03753b..22037ddae 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -185,6 +185,12 @@ inventoryB = IM.fromList $ zip [0..] , makeTypeCraftNum 2 PIPE , makeTypeCraftNum 1 CREATURESENSOR ] +inventoryC :: IM.IntMap Item +inventoryC = IM.fromList $ zip [0..] + [ autoRadar + , autoSonar + , itemFinder + ] testInventory :: IM.IntMap Item testInventory = IM.fromList $ zip [0..] diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 90dcbc97a..8d70dd9e8 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -605,9 +605,16 @@ data BeamType Update themselves, perhaps with side effects. -} data Particle = Particle - { _ptDraw :: Particle -> Picture + { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) } + | RadarCircleParticle + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptTimer :: Int + , _ptRad :: Float + , _ptPos :: Point2 + } | LaserParticle { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index 589907cc9..b8d430468 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -25,6 +25,8 @@ applyTerminalString "LA" = (uvWorld . creatures . ix 0 . crInv .~ inventoryA) . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) applyTerminalString "LB" = (uvWorld . creatures . ix 0 . crInv .~ inventoryB) . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) +applyTerminalString "LC" = (uvWorld . creatures . ix 0 . crInv .~ inventoryC) + . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) applyTerminalString "GODON" = uvWorld . creatures . ix 0 . crApplyDamage .~ applyNoDamage applyTerminalString "GODOFF" = uvWorld . creatures . ix 0 . crApplyDamage .~ defaultApplyDamage applyTerminalString "LOADTEST" = (uvWorld . creatures . ix 0 . crInv .~ testInventory) diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 3e59b7f18..21c9fe62f 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -46,7 +46,7 @@ autoEffect eff t sid itm cr w {- | Automatically send out radar pulses that detect walls. -} autoRadarEffect :: Item -> Creature -> World -> World -autoRadarEffect = autoEffect aRadarPulse 100 click1S +autoRadarEffect = autoEffect aWallPulse 100 click1S {- | Automatically send out sonar pulses that detect creatures. -} autoSonarEffect :: Item -> Creature -> World -> World autoSonarEffect = autoEffect aSonarPulse 50 click1S diff --git a/src/Dodge/Item/Weapon/Radar.hs b/src/Dodge/Item/Weapon/Radar.hs index b7a13bcae..cb1e3ea71 100644 --- a/src/Dodge/Item/Weapon/Radar.hs +++ b/src/Dodge/Item/Weapon/Radar.hs @@ -29,7 +29,7 @@ radar = defaultGun , _ammoLoaded = 100 , _reloadTime = 200 } - , _itUse = ruseRate 120 (const aRadarPulse) upHammer + , _itUse = ruseRate 120 (const aWallPulse) upHammer [ ammoUseCheck ] & useAim . aimRange .~ 1 diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index c42595c9b..d6cdc14cc 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -1,7 +1,11 @@ {- | Effects centered on creatures. These are typically item effects, and typical occur when an item is explictly used. -} -module Dodge.Item.Weapon.UseEffect where +module Dodge.Item.Weapon.UseEffect + ( anItemFindPulse + , aWallPulse + , aSonarPulse + ) where import Dodge.Data import Dodge.Zone import Picture @@ -12,102 +16,88 @@ 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) -{- | Creates an outwardly increasing circle that displays walls, even those behind other walls. -} -aRadarPulse :: Creature -> World -> World -aRadarPulse cr = instantParticles .:~ radarPulseAt (_crPos cr) +--aSonarPulse cr = instantParticles .:~ sonarPulseAt (_crPos cr) +aSonarPulse = aRadarPulse crBlips (blipAt 8) green + +aWallPulse :: Creature -> World -> World +aWallPulse = aRadarPulse wallBlips (blipAt 2) red + {- | Creates an outwardly increasing circle that displays items. -} anItemFindPulse :: Creature -> World -> World -anItemFindPulse cr = instantParticles .:~ itemFindPulseAt (_crPos cr) -{- | Radar blip at a point. -} -blipAt :: Point2 -> Color -> Int -> Particle -blipAt p col i = Particle - {_ptDraw = const blank - ,_ptUpdate = mvBlip p col i i +anItemFindPulse = aRadarPulse itemBlips (blipAt 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 + -> Creature + -> World -> World +aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle + { _ptDraw = drawPulse col + , _ptUpdate = mvRadar blipsF bf col (_crPos cr) + , _ptTimer = 100 + , _ptRad = 0 + , _ptPos = (_crPos cr) } -mvBlip :: Point2 -> Color +drawPulse :: Color -> Particle -> Picture +drawPulse col pt = setLayer DebugLayer $ pictures sweepPics + where + p = _ptPos pt + r = _ptRad pt + sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15 + ,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5 + ,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5 + ] + colHelper y = color (withAlpha (y * globalAlpha) col) + globalAlpha | x > 10 = 1 + | otherwise = fromIntegral x / 10 + x = _ptTimer pt +{- | Radar blip at a point. -} +blipAt :: Float -> Point2 -> Color -> Int -> Particle +blipAt r p col i = Particle + {_ptDraw = const blank + ,_ptUpdate = mvBlip r p col i i + } +mvBlip :: Float + -> Point2 -> Color -> Int -- ^ Max possible timer value -> Int -- ^ Current timer value -> World -> Particle -> (World, Maybe Particle) -mvBlip _ _ _ 0 w _ = (w, Nothing) -mvBlip p col maxt t w pt = +mvBlip _ _ _ _ 0 w _ = (w, Nothing) +mvBlip r p col maxt t w pt = (w - , Just $ pt & ptUpdate .~ mvBlip p col maxt (t-1) + , 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 2 ) + $ circleSolid r ) ) -{- | An outwardly increasing circle that draws creatures, even those behind walls. -} -sonarPulseAt :: Point2 -> Particle -sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate = mvSonar 100 p } -mvSonar - :: Int -- ^ Timer - -> Point2 -- ^ Center of expanding circle - -> World -> Particle -> (World, Maybe Particle) -mvSonar 0 _ w _ = (w, Nothing) -mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic - ,_ptUpdate = mvSonar (x-1) p - } - ) - where - pic = setLayer DebugLayer $ pictures crBlips - <> sweepPics - crBlips = mapMaybe crBlip $ IM.elems $ _creatures w - crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100) - = Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100)) - $ uncurryV translate cpos $ circleSolid crad - | otherwise = Nothing - where crad = _crRad cr - cpos = _crPos cr - r = fromIntegral (500 - x*5) - sweepPics = colHelper 0.05 $ uncurryV translate p $ thickCircle r 5 - globalAlpha | x > 10 = 1 - | otherwise = fromIntegral x / 10 - colHelper y = color (withAlpha (y * globalAlpha) green) -{- | -An outwardly increasing circle that displays walls, even those behind other walls. -} -itemFindPulseAt :: Point2 -> Particle -itemFindPulseAt p = Particle - { _ptDraw = const blank - , _ptUpdate = mvRadar 100 p - } -{- | -An outwardly increasing circle that displays walls, even those behind other walls. -} -radarPulseAt :: Point2 -> Particle -radarPulseAt p = Particle - { _ptDraw = const blank - , _ptUpdate = mvRadar 100 p - } mvRadar - :: Int -- ^ Timer + :: (Point2 -> Float -> World -> [Point2]) + -> (Point2 -> Color -> Int -> Particle) + -> Color -> Point2 -- ^ Center of expanding circle -> World -> Particle -> (World, Maybe Particle) -mvRadar 0 _ w _ = (w, Nothing) ---mvRadar _ _ w _ = (w, Nothing) -mvRadar x p w pt = - ( putBlips w - , Just $ pt {_ptDraw = const pic ,_ptUpdate = mvRadar (x-1) p } - ) - where - pic = setLayer DebugLayer $ pictures sweepPics +mvRadar blipsF bf col p w pt + | x < 1 = (w, Nothing) + | otherwise = + ( putBlips w + , Just $ pt & ptRad .~ r & ptTimer .~ (x-1) + ) + where + x = _ptTimer pt putBlips = over worldEvents ( over instantParticles (blips ++) . ) - blips = map (\bp -> blipAt bp (withAlpha (0.5*globalAlpha) red) 50) circPoints - circPoints = wallBlips p r w + blips = map (\bp -> bf bp (withAlpha (0.5*globalAlpha) col) 50) circPoints + circPoints = blipsF p r w r = fromIntegral (400 - x*4) - sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15 - ,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5 - ,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5 - ] globalAlpha | x > 10 = 1 | otherwise = fromIntegral x / 10 - colHelper y = color (withAlpha (y * globalAlpha) red) -itemBlips :: Point2 -> Float -> World -> IM.IntMap Point2 -itemBlips p r = IM.filter f . fmap _flItPos . _floorItems +itemBlips :: Point2 -> Float -> World -> [Point2] +itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems where f q = dist p q <= r && dist p q > r - 4 @@ -117,3 +107,8 @@ wallBlips p r w = mapMaybe (\wl -> uncurry (intersectCircSegFirst p r) (_wlLine ++ 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 + where + f q = dist p q <= r && dist p q > r - 4