200 lines
7.4 KiB
Haskell
200 lines
7.4 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.Base
|
|
import Dodge.Item.Weapon.Decoration
|
|
import Dodge.Item.Weapon.TriggerType
|
|
import Dodge.WorldEvent.Flash
|
|
import Dodge.WorldEvent.ThingsHit
|
|
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 :: Int -> World -> World
|
|
aSonarPulse cid w = over particles ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w
|
|
|
|
{- |
|
|
Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
|
|
aRadarPulse :: Int -> World -> World
|
|
aRadarPulse cid w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
|
|
|
|
{- |
|
|
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 p col maxt 0 w pt = (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
|
|
$ uncurry 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))
|
|
$ uncurry 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 x p w pt = (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 (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50)
|
|
$ circPoints
|
|
circPoints = mapMaybe (\wl -> collidePointCircCorrect (_wlLine wl !! 0) (_wlLine wl !! 1) r p)
|
|
$ (map (over wlLine reverse) $ IM.elems $ wallsAlongCirc p r w)
|
|
++ (IM.elems $ wallsAlongCirc p r w)
|
|
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)
|
|
|
|
aTractorBeam
|
|
:: Int -- ^ Color id
|
|
-> Int -- ^ Creature id
|
|
-> World
|
|
-> World
|
|
aTractorBeam col cid w
|
|
= set (creatures . ix cid . crInv . ix itRef . wpFire)
|
|
(shoot $ aTractorBeam ((col + 1) `mod` 10))
|
|
$ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
|
|
where
|
|
i = newProjectileKey w
|
|
cr = (_creatures w IM.! cid)
|
|
pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir)
|
|
dir = _crDir cr
|
|
itRef = _crInvSel cr
|
|
|
|
tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile
|
|
tractorBeamAt colID i pos dir = Projectile
|
|
{ _pjPos = pos
|
|
, _pjStartPos = p'
|
|
, _pjVel = d
|
|
, _pjPict = blank
|
|
, _pjID = i
|
|
, _pjUpdate = updateTractor colID 10 i
|
|
}
|
|
where
|
|
d = unitVectorAtAngle dir
|
|
p' = pos +.+ 400 *.* d
|
|
|
|
{- |
|
|
The interaction of this with objects, walls etc needs more thought. -}
|
|
updateTractor :: Int -> Int -> Int -> World -> World
|
|
updateTractor colID time i w
|
|
| time > 0 = set (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i)
|
|
$ set (projectiles . ix i . pjPict) pic
|
|
$ over creatures (IM.map tractCr)
|
|
$ over floorItems (IM.map tractFlIt)
|
|
w
|
|
| otherwise = over projectiles (IM.delete i) w
|
|
where
|
|
tractCr cr
|
|
| circOnSeg p1 p2 cP 10
|
|
= over crPos (\p ->
|
|
p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4))
|
|
) cr
|
|
| otherwise = cr
|
|
where
|
|
x = abs y + 1
|
|
y = errorClosestPointOnLineParam 1 p1 p3 cP
|
|
cP = _crPos cr
|
|
m | dist cP p1 < 350 = 1
|
|
| otherwise = (400 - dist cP p1) / 50
|
|
tractFlIt it | circOnSeg p1 p2 iP 10
|
|
= over flItPos (\p -> p -.- m *.*
|
|
( (0.3/ x) *.* q +.+ (f y *.* p4))
|
|
) it
|
|
| otherwise = it
|
|
where x = abs y + 1
|
|
y = errorClosestPointOnLineParam 2 p1 p3 iP
|
|
iP = _flItPos it
|
|
m | dist iP p1 < 350 = 1
|
|
| otherwise = (410 - dist iP p1) / 60
|
|
pj = _projectiles w IM.! i
|
|
q = _pjVel pj
|
|
p1 = _pjPos pj
|
|
p' = _pjStartPos pj
|
|
p2 = maybe p' fst $ collidePointWalls p1 p' $ wallsNearPoint p' w
|
|
p4 = vNormal p5
|
|
p5 = errorNormalizeV 12 $ p2 -.- p1
|
|
p3 = p1 +.+ p4
|
|
g x | x > 5 = (10 - x) / 5
|
|
| x > 1 = 1
|
|
| x > -1 = x
|
|
| x > -5 = -1
|
|
| otherwise = (x - 10) / 5
|
|
d = errorNormalizeV 13 $ p' -.- p1
|
|
f x = g x / 50
|
|
cID = fromIntegral colID / 10
|
|
col = mixColors 0.5 0.5 white blue
|
|
px z = (fromIntegral time + 5) *.* z
|
|
pz z = fromIntegral time * 10 *.* z
|
|
pic = setLayer 1 $ onLayer PtLayer $ color (withAlpha 0.05 col)
|
|
$ polygon [ p1 +.+ px p4
|
|
, p1 -.- 10 *.* p5
|
|
, p1 -.- px p4
|
|
, (p' -.- pz p5) -.- px p4
|
|
, (p' -.- pz p5) +.+ px p4]
|