{- | 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.Picture.Layer 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 -> 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) 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 $ reflectPointWalls 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]