justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor flame draw

Browse Source
This commit is contained in:
justin
2021-03-24 19:51:10 +01:00
parent 3a52f3feaf
commit 7c9cba9ee1
3 changed files with 30 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+7 -4
View File
@@ -27,6 +27,8 @@ import Preload
import Control.Concurrent import Control.Concurrent
import Control.Lens import Control.Lens
import Control.Monad (when)
import System.Random import System.Random
@@ -44,10 +46,6 @@ main = do
(fmap (setWindowSize sizex sizey) firstWorld) (fmap (setWindowSize sizex sizey) firstWorld)
( \preData w -> do ( \preData w -> do
startTicks <- SDL.ticks startTicks <- SDL.ticks
errs <- errors
if length errs > 0
then putStrLn $ "GLerror during doLoop: " ++ (unwords $ map show errs)
else return ()
clear [ColorBuffer,DepthBuffer] clear [ColorBuffer,DepthBuffer]
(lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData) (lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData)
(_cameraRot w) (_cameraZoom w) (_cameraRot w) (_cameraZoom w)
@@ -76,6 +74,11 @@ main = do
(\w -> Just $ update w) (\w -> Just $ update w)
Mix.closeAudio Mix.closeAudio
checkForGlErrors :: IO ()
checkForGlErrors = do
errs <- errors
when (length errs > 0) $ putStrLn $ "GLerror during doLoop: " ++ (unwords $ map show errs)
setWindowSize :: Int -> Int -> World -> World setWindowSize :: Int -> Int -> World -> World
setWindowSize x y w = w & windowX .~ fromIntegral x setWindowSize x y w = w & windowX .~ fromIntegral x
& windowY .~ fromIntegral y & windowY .~ fromIntegral y
src/Dodge/Item/Weapon.hs
+22 -59
View File
@@ -866,8 +866,6 @@ aFlame a cid w
cr = (_creatures w IM.! cid) cr = (_creatures w IM.! cid)
dir = _crDir cr + angle dir = _crDir cr + angle
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
pos2 = (0.5 *.* vel) +.+
_crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
w1 = set randGen g w w1 = set randGen g w
i = newProjectileKey w1 i = newProjectileKey w1
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
@@ -878,7 +876,7 @@ aFlame a cid w
makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World
makeFlame pos vel maycid = over particles' ((:) theFlame) makeFlame pos vel maycid = over particles' ((:) theFlame)
where theFlame = where theFlame =
Pt' { _ptDraw = drawFlame Pt' { _ptDraw = drawFlame vel
, _ptUpdate' = moveFlame vel , _ptUpdate' = moveFlame vel
, _btVel' = vel , _btVel' = vel
, _btColor' = red , _btColor' = red
@@ -889,37 +887,30 @@ makeFlame pos vel maycid = over particles' ((:) theFlame)
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
} }
drawFlame :: Particle' -> Picture drawFlame :: Point2 -> Particle' -> Picture
drawFlame pt = thePic ep drawFlame rotd pt = thePic
where ep = _btPos' pt where ep = _btPos' pt
rotd = _btVel' pt thePic = pictures
thePic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ] [ glow
pic p' = setLayer 1 . setDepth 0.2994 $ uncurry translate (prot3 p') , aPic prot2 0.2998 (scaleChange + 1,2) red
$ rotate (pi * 0.5 + argV rotd) , aPic prot 0.2996 (scaleChange + 0.5,1.5) orange
$ scale scaleChange 1 , aPic prot3 0.2994 (scaleChange,1) white
$ pictures $ reverse [color white $ circleSolid 4 ]
,color (withAlpha 0.5 white) $ circleSolid 5 aPic :: (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
] aPic offset depth (scalex,scaley) col
piu p' = setLayer 1 . setDepth 0.2998 $ uncurry translate (prot2 p') = setLayer 1
$ rotate (pi*0.5 + argV rotd) . setDepth depth
$ scale (scaleChange + 1) 2 . uncurry translate (offset ep)
$ pictures $ reverse [color red $ circleSolid 4.5 . rotate (pi * 0.5 + argV rotd)
,color (withAlpha 0.5 red) $ circleSolid 5 . scale scalex scaley
] . color col
pi2 p' = setLayer 1 $ circleSolid 5
. setDepth 0.2996 glow = setLayer 1 $ setDepth 0.3 $ uncurry translate ep
. uncurry translate (prot p')
$ rotate (pi * 0.5 + argV rotd)
$ scale (scaleChange + 0.5) 1.5
$ pictures $ reverse [color orange $ circleSolid 4.5
,color (withAlpha 0.5 orange) $ circleSolid 5
]
glow p' = setLayer 1 $ setDepth 0.3 $ uncurry translate p'
$ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50 $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
time = _btTimer' pt time = _btTimer' pt
scaleChange | time < 80 = 3 scaleChange | time < 80 = 3
| otherwise = 3 - (fromIntegral time - 80) * 0.2 | otherwise = 3 - (fromIntegral time - 80) * 0.2
prot p' = p' +.+ rotateV (fromIntegral time * 1) (0,1) prot p' = p' +.+ rotateV (fromIntegral time * 1) (0,1)
prot2 p' = p' +.+ rotateV (negate $ 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) prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
@@ -936,10 +927,10 @@ moveFlame rotd w pt
sp = _btPos' pt sp = _btPos' pt
vel = _btVel' pt vel = _btVel' pt
ep = sp +.+ vel ep = sp +.+ vel
mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep--, _ptDraw = const $ thepic ep mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep
, _btPassThrough' = Nothing , _btPassThrough' = Nothing
,_btVel' = 0.98 *.* vel} ,_btVel' = 0.98 *.* vel}
mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep--, _ptDraw = const $ thepic ep mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep
, _btPassThrough' = Nothing , _btPassThrough' = Nothing
,_btVel' = 0.7 *.* vel} ,_btVel' = 0.7 *.* vel}
damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs
@@ -949,42 +940,14 @@ moveFlame rotd w pt
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd) + 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi)) angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi))
hiteff = _btHitEffect' pt pt hiteff = _btHitEffect' pt pt
thepic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ]
pic p' = setLayer 1 . setDepth 0.2994 $ uncurry translate (prot3 p')
$ rotate (pi * 0.5 + argV rotd)
$ scale scaleChange 1
$ pictures $ reverse [color white $ circleSolid 4
,color (withAlpha 0.5 white) $ circleSolid 5
]
pi2 p' = setLayer 1
. setDepth 0.2996
. uncurry translate (prot p')
$ rotate (pi * 0.5 + argV rotd)
$ scale (scaleChange + 0.5) 1.5
$ pictures $ reverse [color orange $ circleSolid 4.5
,color (withAlpha 0.5 orange) $ circleSolid 5
]
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)
piu p' = setLayer 1 . setDepth 0.2998 $ uncurry translate (prot2 p')
$ rotate (pi*0.5 + argV rotd)
$ scale (scaleChange + 1) 2
$ pictures $ reverse [color red $ circleSolid 4.5
,color (withAlpha 0.5 red) $ circleSolid 5
]
rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p
, _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p , _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p
} }
glow p' = setLayer 1 $ setDepth 0.3 $ uncurry translate p'
$ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
pOut p = p +.+ safeNormalizeV (sp -.- p) pOut p = p +.+ safeNormalizeV (sp -.- p)
reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
vel ) vel )
+.+ +.+
(0.2 *.* vel) (0.2 *.* vel)
scaleChange | time < 80 = 3
| otherwise = 3 - (fromIntegral time - 80) * 0.2
smokeGen = makeFlamerSmokeAt ep smokeGen = makeFlamerSmokeAt ep
src/Picture/Render.hs
+1
View File
@@ -38,6 +38,7 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
viewFroms@(viewFromx,viewFromy) pic = do viewFroms@(viewFromx,viewFromy) pic = do
let wallPoints = map fst wallPointsCol let wallPoints = map fst wallPointsCol
startTicks <- SDL.ticks startTicks <- SDL.ticks
setCommonUniforms pdata rot zoom trans wins setCommonUniforms pdata rot zoom trans wins
depthFunc $= Just Less depthFunc $= Just Less