From a853c2d946cb219b1bf56a5c48fe0202d86f7af3 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 23 Feb 2021 22:18:35 +0100 Subject: [PATCH] Commit before introducing layers to pictures --- app/Main.hs | 1 - src/Dodge/LoadSound.hs | 16 ----------- src/Dodge/Weapons.hs | 5 ++-- src/EventHelper.hs | 11 -------- src/Picture/Render.hs | 60 +++++++++++++++++++++--------------------- 5 files changed, 33 insertions(+), 60 deletions(-) delete mode 100644 src/EventHelper.hs diff --git a/app/Main.hs b/app/Main.hs index 2fb1fb07c..c140a4dba 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,7 +1,6 @@ module Main where import Loop -import EventHelper import Shaders import Shapes diff --git a/src/Dodge/LoadSound.hs b/src/Dodge/LoadSound.hs index 6db2dc724..2791f0846 100644 --- a/src/Dodge/LoadSound.hs +++ b/src/Dodge/LoadSound.hs @@ -102,22 +102,6 @@ loadSounds = do , foamSpray' ] --- updateSound :: World -> IO World --- updateSound w --- = do forM_ (_soundQueue w) (\n -> Mix.playOn (-1) 0 (_loadedSounds w IM.! n)) --- fmap (set soundQueue creatureSounds) $ stepSoundTimers $ w --- -- = return $ set soundQueue creatureSounds w --- -- = do forM_ (_soundQueue w) (\n -> Mix.playOn (-1) (_loadedSounds w IM.! n) 0) --- -- fmap (set soundQueue creatureSounds) $ return w --- where creatureSounds = [] - ---playSounds :: a -> World -> IO () ---playSounds _ w = do --- forM_ (_soundQueue w) (\n -> Mix.playOn (-1) 0 (_loadedSounds w IM.! n)) --- -- = return $ set soundQueue creatureSounds w --- -- = do forM_ (_soundQueue w) (\n -> Mix.playOn (-1) (_loadedSounds w IM.! n) 0) --- -- fmap (set soundQueue creatureSounds) $ return w --- where creatureSounds = [] soundOnce :: Int -> World -> World soundOnce i = over soundQueue ((:) i) diff --git a/src/Dodge/Weapons.hs b/src/Dodge/Weapons.hs index d305fd4f7..a46910665 100644 --- a/src/Dodge/Weapons.hs +++ b/src/Dodge/Weapons.hs @@ -714,8 +714,9 @@ aTeslaArc cid w = aTeslaArc' cid $ soundFrom (CrWeaponSound cid) 25 1 0 w aTeslaArc' :: Int -> World -> World -aTeslaArc' cid w = over particles (IM.insert i (makeTeslaArcAt i pos dir)) - $ flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle dir) +aTeslaArc' cid w = + flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle dir) + $ over particles (IM.insert i (makeTeslaArcAt i pos dir)) $ set randGen g w where cr = (_creatures w IM.! cid) i = newParticleKey w diff --git a/src/EventHelper.hs b/src/EventHelper.hs deleted file mode 100644 index cef256c18..000000000 --- a/src/EventHelper.hs +++ /dev/null @@ -1,11 +0,0 @@ -module EventHelper where -import SDL - -stripTimestamp :: (world -> EventPayload -> Maybe world) - -> world -> Event -> Maybe world -stripTimestamp f w e = f w (eventPayload e) - -test :: world -> EventPayload -> Maybe world -test w e = case e of - KeyboardEvent (KeyboardEventData _ Pressed _ (Keysym _ KeycodeReturn _)) -> Nothing - _ -> Just w diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 34bb01acf..769477622 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -30,14 +30,6 @@ import qualified Data.DList as DL import Control.DeepSeq -concat34 :: (Point3,RGBA) -> [Float] -concat34 ((x,y,z),(r,g,b,a)) = [x,y,z,r,g,b,a] - - -toVec2 (x,y) = Vector2 x y -toVec3 (x,y,z) = Vector3 x y z -toVec4 (x,y,z,w) = Vector4 x y z w - polyToTris :: [s] -> [s] {-# INLINE polyToTris #-} polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as)) @@ -247,11 +239,13 @@ threePtrsVAO :: VAO -> (Ptr Float, Ptr Float,Ptr Float) threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of (a:b:c:_) -> (a,b,c) + renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> [(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO () renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do depthFunc $= Just Lequal +-- draw lightmap bindVertexArrayObject $= Just (_vao $ _wallVAO pdata) let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1 @@ -282,12 +276,12 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p blendFuncSeparate $= ((Zero,Zero),(Zero, OneMinusSrcAlpha)) drawArrays Points (fromIntegral 0) (fromIntegral 1) +-- draw picture -- set drawing for on top blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) clear [DepthBuffer] - let firstIndex = 0 - +-- poke necessary data (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) -- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata) <- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata) @@ -308,27 +302,26 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata textureBinding Texture2D $= Just (_textures pdata !! 1) drawArrays Points (fromIntegral 0) (fromIntegral 1) - -- draw triangles currentProgram $= Just (_basicShader pdata) bindVertexArrayObject $= Just (_vao $ _triVAO pdata) bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata - drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs) + drawArrays Triangles 0 (fromIntegral $ nTriVs) -- draw circles currentProgram $= Just (_circShader pdata) uniform (_uniWinSize pdata) $= Vector2 winx winy uniform (_csZoomUni pdata) $= zoom bindVertexArrayObject $= Just (_vao $ _circVAO pdata) bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata - drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs) + drawArrays Points 0 (fromIntegral $ numCircVs) -- draw arcs currentProgram $= Just (_arcShader pdata) uniform (_asWinUni pdata) $= Vector2 winx winy uniform (_asZoomUni pdata) $= zoom bindVertexArrayObject $= Just (_vao $ _arcVAO pdata) bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata - drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs) + drawArrays Points 0 (fromIntegral $ nArcVs) -- reset blend so that light map doesn't apply blendFunc $= (SrcAlpha,OneMinusSrcAlpha) @@ -337,22 +330,26 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p currentProgram $= Just (_basicShader pdata) bindVertexArrayObject $= Just (_vao $ _lineVAO pdata) bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata - drawArrays Lines (fromIntegral firstIndex) (fromIntegral $ nLineVs) + drawArrays Lines 0 (fromIntegral $ nLineVs) -- draw text currentProgram $= Just (_textShader pdata) bindVertexArrayObject $= Just (_vao $ _textVAO pdata) bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata textureBinding Texture2D $= Just (_textures pdata !! 0) - drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs) + drawArrays Points 0 (fromIntegral $ nTextVs) bufferOffset :: Integral a => a -> Ptr b bufferOffset = plusPtr nullPtr . fromIntegral -renderPicture :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> Picture -> IO () -renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do - let firstIndex = 0 +-- the following code draws a picture +-- it does not set nor change the blend function or depth buffer +renderPicture :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) + -> Picture -> IO () +renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do + +-- poke necessary data (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) -- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata) <- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata) @@ -363,7 +360,7 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do ) $ picToFTree pic depthFunc $= Just Less - + currentProgram $= Just (_backShader pdata) bindVertexArrayObject $= Just (_vao $ _backVAO pdata) let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata @@ -373,35 +370,38 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata textureBinding Texture2D $= Just (_textures pdata !! 1) drawArrays Points (fromIntegral 0) (fromIntegral 1) - -- draw triangles currentProgram $= Just (_basicShader pdata) bindVertexArrayObject $= Just (_vao $ _triVAO pdata) bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata - drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs) --- draw lines, don't need to change the program or vaos, just need to bind the --- vbos and draw - bindVertexArrayObject $= Just (_vao $ _lineVAO pdata) - bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata - drawArrays Lines (fromIntegral firstIndex) (fromIntegral $ nLineVs) + drawArrays Triangles 0 (fromIntegral $ nTriVs) -- draw circles currentProgram $= Just (_circShader pdata) uniform (_uniWinSize pdata) $= Vector2 winx winy uniform (_csZoomUni pdata) $= zoom bindVertexArrayObject $= Just (_vao $ _circVAO pdata) bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata - drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs) + drawArrays Points 0 (fromIntegral $ numCircVs) -- draw arcs currentProgram $= Just (_arcShader pdata) uniform (_asWinUni pdata) $= Vector2 winx winy uniform (_asZoomUni pdata) $= zoom bindVertexArrayObject $= Just (_vao $ _arcVAO pdata) bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata - drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs) + drawArrays Points 0 (fromIntegral $ nArcVs) + +-- reset blend so that light map doesn't apply + blendFunc $= (SrcAlpha,OneMinusSrcAlpha) + +-- draw lines + currentProgram $= Just (_basicShader pdata) + bindVertexArrayObject $= Just (_vao $ _lineVAO pdata) + bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata + drawArrays Lines 0 (fromIntegral $ nLineVs) -- draw text currentProgram $= Just (_textShader pdata) bindVertexArrayObject $= Just (_vao $ _textVAO pdata) bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata textureBinding Texture2D $= Just (_textures pdata !! 0) - drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs) + drawArrays Points 0 (fromIntegral $ nTextVs)