{- | Creation of particles in the world. -} module Dodge.WorldEvent.SpawnParticle ( makeGasCloud , aFlameParticle , makeFlameletTimed ) 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.SoundLogic import Dodge.RandomHelp --import Dodge.Debug import Picture import Geometry import Geometry.Vector3D --import Geometry.Data import qualified IntMapHelp as IM import Control.Lens import System.Random import Control.Monad.State import Data.Tuple aFlameParticle :: Int -- ^ Timer -> Point2 -- ^ Position -> Point2 -- ^ Velocity -> Maybe Int -- ^ Creature id -> Particle aFlameParticle t pos vel maycid = PtZ { _ptDraw = drawFlame vel , _ptUpdate = moveFlame vel , _btVel' = vel , _btColor' = red , _btPos' = pos , _btPassThrough' = maycid , _btWidth' = 4 , _btTimer' = t , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff , _ptZ = 20 } drawFlame :: Point2 -- ^ Rotate direction -> Particle -> Picture drawFlame rotd pt = thePic where ep = _btPos' pt thePic = pictures [ glow , aPic 3 prot2 25 (V2 (scaleChange + 1) 2 ) $ V4 2 (-1) (-1) 0.5 , aPic 3 prot 22 (V2 (scaleChange + 0.5) 1) $ V4 1 0.5 0 2 , aPic 1 prot3 20 (V2 scaleChange 0.5 ) $ V4 1 1 1 1 ] aPic :: Int -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture aPic lay offset depth (V2 scalex scaley) col = setLayer lay . setDepth depth . uncurryV translate (offset ep) . rotate (pi * 0.5 + argV rotd) . scale scalex scaley . color col $ circleSolid 5 glow = setLayer 1 $ setDepth 0.3 $ uncurryV 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) (V2 0 1) prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (V2 0 1) prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (V2 0 2) {- TODO: add generalised area damage particles/hiteffects. -} moveFlame :: Point2 -- ^ Rotation direction -> World -> Particle -> (World, Maybe Particle) moveFlame rotd w pt | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing) | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of ((_,Left _):_) -> (doSound damcrs , mvPt 0.7) (thing@(p,Right wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p) _ -> (flameFlicker pt $ doSound damcrs , mvPt 0.98) where time = _btTimer' pt doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2) sp@(V2 x y) = _btPos' pt vel = _btVel' pt ep = sp +.+ vel mvPt speed = Just $ pt { _btTimer' = time - 1 , _btPos' = ep , _btPassThrough' = Nothing , _btVel' = speed *.* vel } damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w $ IM.filter closeCrs $ _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 } pOut p = p +.+ safeNormalizeV (sp -.- p) reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel ) +.+ (0.2 *.* vel) makeFlameletTimed :: Point2 -- ^ Position -> Float -- ^ z position -> Point2 -- ^ Velocity -> Maybe Int -- ^ Creature id -> Float -- ^ Size -> Int -- ^ Timer -> World -> World makeFlameletTimed (V2 x y) z vel maycid size time w = w & randGen .~ g & particles %~ (theFlamelet :) where theFlamelet = PtZ { _ptDraw = drawFlameletZ rot , _ptUpdate = moveFlamelet , _btVel' = vel , _btColor' = red , _btPos' = V2 x y , _btPassThrough' = maycid , _btWidth' = size , _btTimer' = time , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff , _ptZ = z } (rot ,g) = randomR (0,3) $ _randGen w drawFlameletZ :: Float -- ^ Rotation -> Particle -> Picture drawFlameletZ rot pt = pictures [ setLayer 1 pic , setLayer 3 piu , setLayer 3 pi2 ] where z = _ptZ pt sp = _btPos' pt vel = _btVel' pt ep = sp +.+ vel size = _btWidth' pt siz2 = size + 0.2 time = _btTimer' pt piu = setDepth (z + 25) . uncurryV translate ep . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) (V4 2 0 0 1) (V4 2 0 0 0) ) . rotate (negate (rot - 0.1 * fromIntegral time)) . scale s1 s1 $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) pi2 = setDepth (z + 25) . uncurryV translate ep . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) (V4 2 1 0 0.5) (V4 0 0 0 0) ) . rotate (negate (rot + 0.2 * fromIntegral time)) . scale s2 s2 $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) pic = setDepth (z + 20) . uncurryV translate ep . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) (V4 1 1 1 3) (V4 1 0 0 1) ) . rotate (negate ( 0.1 * fromIntegral time + rot)) . scale (0.5* sc) (0.5 *sc) $ polygon $ map toV2 [(-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) {- Update of a flamelet. Applies movement and attaches damage to nearby creatures. -} moveFlamelet :: World -> Particle -> (World, Maybe Particle) moveFlamelet w pt | _btTimer' pt <= 0 = ( w, Nothing) | otherwise = (flameFlicker pt 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 = w & creatures %~ IM.map damifclose isClose cr = dist ep (_crPos cr) < _crRad cr + size damifclose cr | isClose cr = cr & crState . crDamage %~ ( Flaming 3 sp ep ep : ) | otherwise = cr -- | At writing the radius is half the size of the effect area makeGasCloud :: Point2 -- ^ Position -> Point2 -- ^ Velocity -> World -> World makeGasCloud pos vel w = w & clouds %~ (theCloud :) & randGen .~ g where theCloud = Cloud { _clPos = addZ 20 pos , _clVel = addZ 0 vel , _clPict = \_ -> setLayer 2 . setDepth 30 $ color (withAlpha 0.05 col) $ circleSolid 20 , _clRad = 10 , _clAlt = 25 , _clTimer = 400 , _clType = GasCloud , _clEffect = cloudPoisonDamage } (col, g) = runState (takeOne [green,yellow]) $ _randGen w {- Attach poison cloud damage to creatures near cloud. -} cloudPoisonDamage :: Cloud -> World -> World cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (stripZ $ _clPos c) w f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 doDam cr = cr & crState . crDamage %~ (PoisonDam 1 :)