From 0d7f79ba997de15121f139acafcfe1ed7791cc47 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 7 Feb 2020 14:57:09 +0100 Subject: [PATCH] schnell schnell --- app/Classes/Renderable.hs | 4 +++- app/Main.hs | 40 ++++++++++++++++++++++++--------------- app/Renderer.hs | 35 ++++++++++++++-------------------- app/Types/Sprite.hs | 29 +++++++++++++--------------- app/Types/UserData.hs | 2 ++ canvas.cabal | 2 ++ shader/fragment.sl | 4 ++-- 7 files changed, 61 insertions(+), 55 deletions(-) diff --git a/app/Classes/Renderable.hs b/app/Classes/Renderable.hs index ba5943d..ffafcf2 100644 --- a/app/Classes/Renderable.hs +++ b/app/Classes/Renderable.hs @@ -7,6 +7,8 @@ class Renderable a where type ShaderObjects a :: * - init :: IO () + init :: VertexObjects a -> ShaderObjects a -> a -> IO () draw :: VertexObjects a -> ShaderObjects a -> a -> IO () + + clean :: a -> IO () diff --git a/app/Main.hs b/app/Main.hs index ce1eec7..35348cf 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,11 +6,12 @@ import Affection import SDL (($=)) import qualified SDL -import qualified Rendering.Graphics.OpenGL as GL +import qualified Graphics.Rendering.OpenGL as GL import Codec.Picture import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) import Control.Concurrent.STM @@ -19,6 +20,9 @@ import qualified Data.Map.Strict as M -- internal imports import Types +import Types.Sprite +import Renderer +import Classes.Renderable as CR main :: IO () main = @@ -27,9 +31,9 @@ main = , windowTitle = "canvas" , windowConfigs = [ ( 0 - , SDL.DefaultWindow + , SDL.defaultWindow { SDL.windowInitialSize = SDL.V2 1600 900 - , SDL.windowGraphicsContext = SL.OpenGLContext SDL.defaultOpenGL + , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL { SDL.glProfile = SDL.Core SDL.Normal 3 3 } } @@ -37,20 +41,20 @@ main = ] , initScreenMode = SDL.FullscreenDesktop , preLoop = return () - , eventLoop = MapM_ handle - , updateLoop = updateLoop - , drawLoop = drawLoop - , loadState = loadState + , eventLoop = mapM_ handle + , updateLoop = updateLoopImpl + , drawLoop = drawLoopImpl + , loadState = loadStateImpl , cleanUp = (\_ -> return ()) , canvasSize = Nothing } -loadState :: IO UserData -loadState = do +loadStateImpl :: IO UserData +loadStateImpl = do void $ SDL.setMouseLocationMode SDL.RelativeLocation GL.depthFunc $= Just GL.Less - subs <- Subsystms + subs <- Subsystems <$> (SubWindow <$> newTVarIO []) <*> (SubMouse <$> newTVarIO []) @@ -63,11 +67,17 @@ loadState = do } } -handle = return () +handle event = return () -updateLoop = return () +updateLoopImpl dt = return () -drawLoop = do +drawLoopImpl = do ud@(UserData subs rassets) <- getAffection - let (RenderAssets sDetails@(svo sso sdo)) = rassets - mapM_ (draw svo sso) (assocs sdo) + let (RenderAssets sDetails@(AssetDetails svo sso sdo)) = rassets + liftIO $ do + CR.init + (svo :: VertexObjects Sprite) + (sso :: ShaderObjects Sprite) + (head $ M.elems sdo) + mapM_ (draw (svo :: VertexObjects Sprite) (sso :: ShaderObjects Sprite)) (M.elems sdo) + clean (head $ M.elems sdo) diff --git a/app/Renderer.hs b/app/Renderer.hs index 0062c66..27dea55 100644 --- a/app/Renderer.hs +++ b/app/Renderer.hs @@ -3,9 +3,16 @@ module Renderer where import SDL (($=)) import qualified Graphics.Rendering.OpenGL as GL +import qualified Graphics.GLUtil as GLU + +import qualified Data.Map.Strict as M import qualified Data.ByteString as BS +import Codec.Picture + +import Linear + import Foreign -- internal imports @@ -36,7 +43,7 @@ initSpriteRenderObjects = do GL.bindBuffer GL.ArrayBuffer $= Nothing GL.bindVertexArrayObject $= Nothing - return (RenderObjects quadVAO quadVBO) + return (SpriteRenderObjects quadVAO quadVBO) where rawVertices :: [Float] rawVertices = @@ -53,33 +60,19 @@ initSpriteShaderObjects = do vertexShaderSrc <- BS.readFile "shader/vertex.sl" fragmentShaderSrc <- BS.readFile "shader/fragment.sl" - vertexShader <- GL.createShader Gl.VertexShader - fragmentShader <- GL.createShader Gl.FragmentShader + shaderProgram <- GLU.simpleShaderProgramBS vertexShaderSrc fragmentShaderSrc - GL.shaderSourceBS vertexShader $= vertexShaderSrc - GL.ShaderSourceBS fragmentShader $= fragmentShaderSrc - - GL.compileShader vertexShader - GL.compileShader fragmentShader - - shaderProgram <- GL.createProgram - - GL.attachShader shaderProgram vertexShader - GL.attachShader shaderProgram fragmentShader - - GL.linkProgram shaderProgram - - return (SpriteShaderObjects vertexShader fragmentShader shaderProgram) + return (SpriteShaderObjects shaderProgram) loadSprites :: IO (AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite) loadSprites = do rawImg <- readImage "assets/img/lynx.jpg" - let img = case eRawImg of - Left err -> error err - Right dynImg -> convertRGBA8 dynImg + let img = case rawImg of + Left err -> error err + Right dynImg -> convertRGBA8 dynImg vertObj <- initSpriteRenderObjects - shadObj <- initSpriteShaderobjects + shadObj <- initSpriteShaderObjects return AssetDetails { adVertObj = vertObj diff --git a/app/Types/Sprite.hs b/app/Types/Sprite.hs index 97f032c..ba08a22 100644 --- a/app/Types/Sprite.hs +++ b/app/Types/Sprite.hs @@ -1,9 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} module Types.Sprite where import SDL (get, ($=)) import qualified Graphics.Rendering.OpenGL as GL -import qualified Graphics.GLUtil as GLUtil +import qualified Graphics.GLUtil as GLU import Codec.Picture @@ -18,15 +19,13 @@ data SpriteRenderObjects = SpriteRenderObjects , roVBO :: GL.BufferObject } -data SpriteShaderObjects = SpriteShaderobjects - { soVertexShader :: GL.Shader - , soFragmentShader :: GL.Shader - , soProgram :: GL.Program +data SpriteShaderObjects = SpriteShaderObjects + { soProgram :: GLU.ShaderProgram } data Sprite = Sprite { spritePosition :: V2 Int - , SpriteImage :: Image PixelRGBA8 + , spriteImage :: Image PixelRGBA8 } instance Renderable Sprite where @@ -34,22 +33,20 @@ instance Renderable Sprite where type ShaderObjects Sprite = SpriteShaderObjects - init (SpriteRenderObjects vao vbo) = do - GL.currenProgram $= Just prog + init (SpriteRenderObjects vao vbo) (SpriteShaderObjects prog) _ = do + GL.currentProgram $= Just (GLU.program prog) GL.bindVertexArrayObject $= Just vao draw (SpriteRenderObjects vao vbo) - (SpriteShaderObjects vs fs prog) + (SpriteShaderObjects prog) (Sprite pos@(V2 px py) img) = do let model = mkTransformation - (Quaternion (V3 0 0 0) 1 :: Quaternion Float) + (Quaternion 1 (V3 0 0 0) :: Quaternion Float) (fmap fromIntegral $ V3 px py 0 :: V3 Float) - GLU.setUniform program "model" model - uLoc <- get (GL.uniformLocation prog "model") - GL.uniform uLoc $= model + GLU.setUniform prog "model" model GL.drawArrays GL.Triangles 0 6 - clean = - GL.currenProgram $= Nothing - GL.bindVertexArrayObject $= Nothing + clean _ = do + GL.currentProgram $= (Nothing :: Maybe GL.Program) + GL.bindVertexArrayObject $= (Nothing :: Maybe GL.VertexArrayObject) diff --git a/app/Types/UserData.hs b/app/Types/UserData.hs index ebf3a25..e565347 100644 --- a/app/Types/UserData.hs +++ b/app/Types/UserData.hs @@ -16,6 +16,8 @@ import Codec.Picture import Types.Sprite +import Classes.Renderable + data UserData = UserData { udSubsystems :: Subsystems , udRenderAssets :: RenderAssets diff --git a/canvas.cabal b/canvas.cabal index 6a6b89c..758dffd 100644 --- a/canvas.cabal +++ b/canvas.cabal @@ -29,10 +29,12 @@ executable canvas , affection , sdl2 ^>=2.5.0.0 , OpenGL + , GLUtil , JuicyPixels , JuicyPixels-extra , stm , containers , linear + , bytestring hs-source-dirs: app default-language: Haskell2010 diff --git a/shader/fragment.sl b/shader/fragment.sl index 5dc8b0d..a67f6ff 100644 --- a/shader/fragment.sl +++ b/shader/fragment.sl @@ -3,10 +3,10 @@ in vec2 TexCoords; out vec4 color; uniform sampler2D image; -#uniform vec3 spriteColor; +//uniform vec3 spriteColor; void main() { - #color = vec4(spriteColor, 1.0) * texture(image, TexCoords); + //color = vec4(spriteColor, 1.0) * texture(image, TexCoords); color = texture(image, TexCoords); }