Unify and cleanup radars
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user