module Dodge.WorldEvent.SpawnParticle where import Dodge.Data import Dodge.Base import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.Flash import Dodge.WorldEvent.HelperParticle import Dodge.WorldEvent.Bullet import Dodge.SoundLogic import Dodge.RandomHelp import Dodge.Debug import Picture import Geometry import Control.Lens import qualified Data.IntMap.Strict as IM import System.Random import Control.Monad.State import Data.Function (on) import Data.List import Data.Maybe -- take out the flame particle from makeFlame aFlameParticle :: Int -> Point2 -> Point2 -> Maybe Int -> Particle' aFlameParticle t pos vel maycid = Pt' { _ptDraw = drawFlame vel , _ptUpdate' = moveFlame vel , _btVel' = vel , _btColor' = red , _btPos' = pos , _btPassThrough' = maycid , _btWidth' = 4 , _btTimer' = t , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff } makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World makeFlame pos vel maycid = over particles' (aFlameParticle 100 pos vel maycid : ) drawFlame :: Point2 -> Particle' -> Picture drawFlame rotd pt = thePic where ep = _btPos' pt thePic = pictures [ glow , aPic prot2 0.2998 (scaleChange + 1,2) red , aPic prot 0.2996 (scaleChange + 0.5,1.5) orange , aPic prot3 0.2994 (scaleChange,1) white ] aPic :: (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture aPic offset depth (scalex,scaley) col = setLayer 1 . setDepth depth . uncurry translate (offset ep) . rotate (pi * 0.5 + argV rotd) . scale scalex scaley . color col $ circleSolid 5 glow = setLayer 1 $ setDepth 0.3 $ uncurry translate ep $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50 time = _btTimer' pt scaleChange | time < 80 = 3 | otherwise = 3 - (fromIntegral time - 80) * 0.2 prot p' = p' +.+ rotateV (fromIntegral time * 1) (0,1) prot2 p' = p' +.+ rotateV (negate $ fromIntegral time * 1) (0,1) prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2) moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle') moveFlame rotd w pt | time <= 0 = (smokeGen w, Nothing) | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of ((p,(E3x1 cr)):_) -> (soundAndGlare damcrs , mvPt') (thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs , rfl wl p) _ -> (soundAndGlare damcrs , mvPt) where time = _btTimer' pt soundAndGlare = soundFrom Flame fireSound 2 500 . over worldEvents ((.) $ flameGlareAt ep) sp = _btPos' pt vel = _btVel' pt ep = sp +.+ vel mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep , _btPassThrough' = Nothing ,_btVel' = 0.98 *.* vel} mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep , _btPassThrough' = Nothing ,_btVel' = 0.7 *.* vel} damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs $ IM.elems $ _creatures w closeCrs cr = dist ep (_crPos cr) < _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80)) + 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd) angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi)) hiteff = _btHitEffect' pt pt rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p , _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p } pOut p = p +.+ safeNormalizeV (sp -.- p) reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) vel ) +.+ (0.2 *.* vel) smokeGen = makeFlamerSmokeAt ep makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World makeFlameletTimed pos vel maycid size time w = set randGen g $ over particles' ((:) theFlamelet) w where theFlamelet = Pt' { _ptDraw = drawFlamelet rot , _ptUpdate' = moveFlamelet , _btVel' = vel , _btColor' = red , _btPos' = pos , _btPassThrough' = maycid , _btWidth' = size , _btTimer' = time , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff } (rot ,g) = randomR (0,3) $ _randGen w drawFlamelet :: Float -> Particle' -> Picture drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow] where sp = _btPos' pt vel = _btVel' pt ep = sp +.+ vel size = _btWidth' pt siz2 = size + 0.2 time = _btTimer' pt glow = setDepth 0.336 $ uncurry translate ep $ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30 piu = setDepth 0.334 $ uncurry translate ep $ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time)) $ scale s1 s1 $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) pi2 = setDepth 0.332 $ uncurry translate ep $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) orange (dark red) ) $ rotate (0 - (rot + 0.2 * fromIntegral time)) $ scale s2 s2 $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) pic = setDepth 0.33 $ uncurry translate ep $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) white (dark red) ) $ rotate (0 - ( 0.1 * fromIntegral time + rot)) $ scale sc sc $ polygon [(-size,-size),(size,-size),(size,size),(-size,size)] sc = (*) 2 $ log $ 1 + fromIntegral time / 20 s1 = (*) 2 $ log $ 2 + fromIntegral time / 40 s2 = 0.5 * (sc + s1) thepicture = pictures [pic , piu , pi2 , glow] moveFlamelet :: World -> Particle' -> (World, Maybe Particle') moveFlamelet w pt | _btTimer' pt <= 0 = ( w, Nothing) | otherwise = (damcrs, mvPt) where sp = _btPos' pt vel = _btVel' pt ep = sp +.+ vel size = _btWidth' pt mvPt = Just $ pt & btTimer' -~ 1 & btPos' .~ ep & btPassThrough' .~ Nothing & btVel' .~ 0.8 *.* vel damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w closeCrs cr = dist ep (_crPos cr) < _crRad cr + size dodam cr = over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Flaming 3 sp ep ep) makeGasCloud :: Point2 -> Point2 -> World -> World makeGasCloud pos vel w = over clouds (IM.insert i theCloud) $ set randGen g w where i = newKey $ _clouds w theCloud = Cloud { _clID = i , _clPos = pos , _clVel = vel , _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col) $ circleSolid 20 , _clRad = 20 , _clTimer = 400 , _clEffect = cloudPoisonDamage } (col, g) = runState (takeOne [green,yellow]) $ _randGen w cloudPoisonDamage :: Cloud -> World -> World cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1) makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile makeTeslaArcAt i pos dir = Projectile { _pjPos = pos , _pjStartPos = pos , _pjVel = (0,0) , _pjPict = onLayer PtLayer $ line [(0,0),(0,0)] , _pjID = i , _pjUpdate = moveTeslaArc pos dir i } moveTeslaArc :: Point2 -> Float -> Int -> World -> World moveTeslaArc p d i w = set (projectiles . ix i . pjPict) pic $ set (projectiles . ix i . pjUpdate) (pjTimer 2 i) $ set randGen g $ createSpark 8 nc q2 (argV sv + d1) Nothing $ foldr damCrs w hitCrs where pic = setLayer 1 $ pictures [ onLayer PtLayer $ color (f2 nc) $ line ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps' ] ps' = lightningMids d pers ps ps = take 15 $ p : map f (crsLightChain p d 0 w) f (E3x1 cr) = _crPos cr f (E3x2 p1) = p1 f (E3x3 p1) = p1 pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w (nc,g) = randomR (0::Int,11) $ _randGen w f1 (E3x1 cr) = Just $ _crID cr f1 _ = Nothing hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w damCrs i = over (creatures . ix i . crHP) (\hp -> hp - 5) f2 0 = cyan f2 1 = azure f2 _ = white sID = newProjectileKey w q1 = last $ init ps' q2 = last ps' hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w (d1,_) = randomR (-0.7,0.7) $ _randGen w sv = fromMaybe (q2 -.- q1) $ fmap snd hitWall lightningMid :: Float -> Point2 -> Point2 -> Point2 lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3 where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2 lightningMids :: Float -> [Point2] -> [Point2] -> [Point2] lightningMids d1 (p:pers) (p1:p3:ps) = let p2 = p +.+ lightningMid d1 p1 p3 d2 = argV $ p3 -.- p2 in p1 : p2 : lightningMids d2 pers (p3:ps) lightningMids _ _ ps = ps crsLightChain' :: Point2 -> Float -> World -> [Either3 Creature Point2 Point2] crsLightChain' p d w = case crOrWall p d w of E3x1 cr -> E3x1 cr : crsLightChain' (_crPos cr) (argV (_crPos cr -.- p)) w E3x2 p1 -> [E3x2 p1] E3x3 p1 -> E3x3 p1 : crsLightChain' p1 (dChange + argV (p1 -.- p)) (set randGen g w) -- where (dChange, g) = (0, _randGen w) where (dChange, g) = randomR (-0.05,0.05) $ _randGen w crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2] crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) (min 1 (wlAttract + 0.3)) w E3x2 p1 -> [E3x2 p1] E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w) -- where (dChange, g) = (0, _randGen w) where (dChange, g) = randomR (-0.05,0.05) $ _randGen w crOrWallSensitive :: Point2 -> Float -> Float -> World -> Either3 Creature Point2 Point2 crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0)) $ listToMaybe $ sortBy (compare `on` g) $ catMaybes [cr,wlp] where cr = fmap E3x1 $ nearestCrInFront p dir 100 w wlp = fmap E3x2 $ listToMaybe $ sortBy (compare `on` dist p) $ mapMaybe ( fmap fst . (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w) . (+.+) p . (\d -> rotateV d (100,0)) . (+) dir ) (fmap (*wlAttract) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]) --[-pi/4,-pi/8,0,pi/8,pi/4] g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first --g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first g (E3x1 cr1) = dist p $ _crPos cr1 (arcLen,_) = randomR (25,50) $ _randGen w -- BUG: can hit crs through walls crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2 crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0)) $ listToMaybe $ sortBy (compare `on` g) $ catMaybes [cr,wlp] where cr = fmap E3x1 $ nearestCrInFront p dir 100 w wlp = fmap E3x2 $ listToMaybe $ sortBy (compare `on` dist p) $ mapMaybe ( fmap fst . (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w) . (+.+) p . (\d -> rotateV d (100,0)) . (+) dir ) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8] --[-pi/4,-pi/8,0,pi/8,pi/4] g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first --g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first g (E3x1 cr1) = dist p $ _crPos cr1 (arcLen,_) = randomR (25,50) $ _randGen w -- if the spark is created by another Particle', it cannot be directly added to -- the list, hence the redirect through worldEvents createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World createSpark time colid pos dir maycid w = over worldEvents ((.) $ ( over particles' ((:) spark) -- . flareAt' white 0.02 0.05 pos') . sparkFlashAt pos') ) w where spark = Bul' { _ptDraw = drawBul , _ptUpdate' = mvGenBullet' , _btVel' = rotateV dir (5,0) , _btColor' = numColor colid , _btTrail' = [pos] , _btPassThrough' = maycid , _btWidth' = 1 , _btTimer' = time , _btHitEffect' = destroyOnImpact sparkEff noEff noEff } x = fst $ randomR (0,20) $ _randGen w pos' = pos +.+ rotateV dir (x,0) sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ SparkDam 1 sp p ep) where sp = head (_btTrail' bt) ep = sp +.+ _btVel' bt drawBul :: Particle' -> Picture drawBul pt = setLayer 1 . color white $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)