diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 7f042d776..1d3d5af4f 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -790,13 +790,14 @@ moveShell time i cid rot accel w _ -> 0 (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[]) - (t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w - (s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[]) -- ((r1:r2:r3:_),_) = runState ((sequence . repeat . randInCirc) 10) $ _randGen w -- v1 = fst $ runState (randInCirc 0.5) $ _randGen w - smokeGen = makeSmokeAt'' v1 s1 t1 (newPos +.+ r1) - . makeSmokeAt'' v2 s2 t2 (newPos +.+ r2) - -- . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3) + smokeGen = makeSmokeCloud (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) +-- (t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w +-- (s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[]) +-- smokeGen = makeSmokeAt'' v1 s1 t1 (newPos +.+ r1) +-- . makeSmokeAt'' v2 s2 t2 (newPos +.+ r2) +-- -- . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3) normalizeAnglePi angle | normalizeAngle angle > pi = normalizeAngle angle - 2*pi @@ -984,11 +985,12 @@ moveFlame rotd w pt = scaleChange | time < 80 = 3 | otherwise = 3 - (fromIntegral time - 80) * 0.2 g = _randGen w - tms = randomRs (15,20) g - scs = randomRs (0.1,0.5) g + -- tms = randomRs (15,20) g +-- scs = randomRs (0.1,0.5) g (rs,g1) = runState ((sequence . take 5 . repeat . randInCirc) 20) $ _randGen w f sc tm r = makeColorSmokeAt (greyN 0.3) (0.5 *.* vel) sc tm (ep +.+ r) - smokeGen w = set randGen g1 $ foldr ($) w (zipWith3 f scs tms rs) + -- smokeGen w = set randGen g1 $ foldr ($) w (zipWith3 f scs tms rs) + smokeGen = makeFlamerSmoke ep flamerAngle = 0.3 diff --git a/src/Dodge/LevelGen/WindowBlock.hs b/src/Dodge/LevelGen/WindowBlock.hs index 82d5c5ec5..7be3d6033 100644 --- a/src/Dodge/LevelGen/WindowBlock.hs +++ b/src/Dodge/LevelGen/WindowBlock.hs @@ -17,7 +17,7 @@ basePane :: Wall basePane = Block { _wlLine = [] , _wlID = 0 - , _wlColor = withAlpha 0.5 cyan + , _wlColor = withAlpha 0.2 cyan , _wlDraw = Nothing , _wlSeen = False , _blIDs = [] diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index bba30af45..4bbb7eb60 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -5,6 +5,7 @@ module Dodge.WorldEvent , module Dodge.WorldEvent.ThingsHit , module Dodge.WorldEvent.HelperParticle , module Dodge.WorldEvent.Projectile + , module Dodge.WorldEvent.Cloud ) where @@ -13,6 +14,7 @@ import Dodge.WorldEvent.Bullet import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.HelperParticle +import Dodge.WorldEvent.Cloud import Dodge.LightSources import Dodge.Data diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs new file mode 100644 index 000000000..59c09d83f --- /dev/null +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -0,0 +1,41 @@ +module Dodge.WorldEvent.Cloud + where + +import Dodge.Data +import Dodge.Base + +import Geometry + +import Picture + +import Control.Lens +import qualified Data.IntMap as IM + +makeSmokeCloud :: Point2 -> World -> World +makeSmokeCloud pos w = w & clouds %~ IM.insert i theCloud + where i = newKey $ _clouds w + theCloud = Cloud { _clID = i + , _clPos = pos + , _clVel = (0,0) + , _clPict = fadeOutPict (-0.5) + , _clRad = 10 + , _clTimer = 200 + , _clEffect = const id + } + +fadeOutPict :: Float -> Cloud -> Picture +fadeOutPict dpth cl = setLayer 2 . setDepth dpth . color (withAlpha a $ greyN 0.5) $ circleSolid (2 * _clRad cl) + where a = fromIntegral (_clTimer cl) / 200 + +makeFlamerSmoke :: Point2 -> World -> World +makeFlamerSmoke pos w = w & clouds %~ IM.insert i theCloud + where i = newKey $ _clouds w + theCloud = Cloud { _clID = i + , _clPos = pos + , _clVel = (0,0) + , _clPict = fadeOutPict 0 + , _clRad = 5 + , _clTimer = 200 + , _clEffect = const id + } + diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index a3a447d13..37781e6ab 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -62,11 +62,12 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol renderFoldable pdata $ picToLTree (Just 0) pic -- reset blend so that light map doesn't apply - blendFunc $= (SrcAlpha,OneMinusSrcAlpha) +-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha) + blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One)) renderFoldable pdata $ picToLTree (Just 1) pic -- set drawing for on top --- blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) + blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) renderFoldable pdata $ picToLTree (Just 2) pic @@ -190,6 +191,8 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints -- blendFunc $= (Zero,One) bindFramebuffer Framebuffer $= defaultFramebufferObject + + colorMask $= (Color4 Disabled Disabled Disabled Enabled) -- -- blendFunc $= (SrcAlpha, OneMinusSrcAlpha) bindShaderBuffers [_fullscreenShader pdata] [4] @@ -197,6 +200,8 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints -- blendFunc $= (One, Zero) drawShader (_fullscreenShader pdata) 4 + colorMask $= (Color4 Enabled Enabled Enabled Enabled) + blend $= Enabled renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()