101 lines
4.0 KiB
Haskell
101 lines
4.0 KiB
Haskell
{- |
|
|
Effects centered on creatures.
|
|
These are typically item effects, and typical occur when an item is explictly used. -}
|
|
module Dodge.Item.Weapon.UseEffect where
|
|
import Dodge.Data
|
|
--import Dodge.Zone
|
|
--import Dodge.Picture.Layer
|
|
import Picture
|
|
import Geometry
|
|
|
|
import Data.Maybe
|
|
import Control.Lens
|
|
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 = over particles (sonarPulseAt (_crPos cr) :)
|
|
{- | Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
|
|
aRadarPulse :: Creature -> World -> World
|
|
aRadarPulse cr = over particles (radarPulseAt (_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
|
|
}
|
|
mvBlip :: 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 =
|
|
(w
|
|
, Just $ pt & ptUpdate .~ mvBlip p col maxt (t-1)
|
|
& ptDraw .~ ( const
|
|
. setDepth (-0.5)
|
|
. setLayer 1
|
|
. uncurryV translate p
|
|
. color (withAlpha (fromIntegral t / fromIntegral maxt) col)
|
|
$ circleSolid 2 )
|
|
)
|
|
{- | 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 = setDepth (-0.5) . setLayer 1 $ pictures crBlips
|
|
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 $ uncurry 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. -}
|
|
radarPulseAt :: Point2 -> Particle
|
|
radarPulseAt p = Particle
|
|
{ _ptDraw = const blank
|
|
, _ptUpdate = mvRadar 50 p
|
|
}
|
|
mvRadar
|
|
:: Int -- ^ Timer
|
|
-> Point2 -- ^ Center of expanding circle
|
|
-> World -> Particle -> (World, Maybe Particle)
|
|
mvRadar 0 _ w _ = (w, Nothing)
|
|
mvRadar _ _ w _ = (w, Nothing)
|
|
--mvRadar x p w pt = undefined
|
|
-- ( putBlips w
|
|
-- , Just $ pt {_ptDraw = const pic ,_ptUpdate = mvRadar (x-1) p }
|
|
-- )
|
|
-- where
|
|
-- pic = onLayerL [levLayer ShadowLayer, 1] $ pictures sweepPics
|
|
-- putBlips = over worldEvents ( over particles (blips ++) . )
|
|
-- blips = map (\bp -> blipAt bp (withAlpha (0.5*globalAlpha) red) 50) circPoints
|
|
-- circPoints = mapMaybe (\wl -> uncurry collidePointCircCorrect (_wlLine wl) r p)
|
|
-- $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
|
|
-- ++ IM.elems (wallsAlongCirc p r w)
|
|
-- swp (a,b) = (b,a)
|
|
-- r = fromIntegral (800 - x*16)
|
|
-- sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15
|
|
-- --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5
|
|
-- --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5
|
|
-- ]
|
|
-- globalAlpha | x > 10 = 1
|
|
-- | otherwise = fromIntegral x / 10
|
|
-- --colHelper y = color (withAlpha (y * globalAlpha) red)
|