diff --git a/app/Classes/Renderable.hs b/app/Classes/Renderable.hs index be77aad..ba5943d 100644 --- a/app/Classes/Renderable.hs +++ b/app/Classes/Renderable.hs @@ -7,6 +7,6 @@ class Renderable a where type ShaderObjects a :: * - type RenderableInfo a :: * + init :: IO () - draw :: VertexObjects a -> ShaderObjects a -> RenderableInfo a -> IO () + draw :: VertexObjects a -> ShaderObjects a -> a -> IO () diff --git a/app/Main.hs b/app/Main.hs index d886782..d0f1de9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,10 +1,73 @@ +{-# LANGUAGE OverloadedStrings #-} module Main where import Affection +import SDL (($=)) +import qualified SDL + +import qualified Rendering.Graphics.OpenGL as GL + +import Codec.Picture + +import Control.Monad (void) + +import Control.Concurrent.STM + +import qualified Data.Map.Strict as M + -- internal imports import Types main :: IO () -main = putStrLn "Hello, Haskell!" +main = + withAffection AffectionConfig + { initComponents = All + , windowTitle = "canvas" + , windowConfigs = + [ ( 0 + , SDL.DefaultWindow + { SDL.windowInitialSize = SDL.V2 1600 900 + , SDL.windowGraphicsContext = SL.OpenGLContext SDL.defaultOpenGL + { SDL.glProfile = SDL.Core SDL.Normal 3 3 + } + } + ) + ] + , initScreenMode = SDL.FullscreenDesktop + , preLoop = return () + , eventLoop = MapM_ handle + , updateLoop = updateLoop + , drawLoop = drawLoop + , loadState = loadState + , cleanUp = (\_ -> return ()) + , canvasSize = Nothing + } + +loadState :: IO UserData +loadState = do + void $ SDL.setMouseLocationMode SDL.RelativeLocation + GL.depthFunc $= Just GL.Less + + subs <- Subsystms + <$> (SubWindow <$> newTVarIO []) + <*> (SubMouse <$> newTVarIO []) + + rawImg <- readImage "assets/img/lynx.jpg" + let img = case eRawImg of + Left err -> error err + Right dynImg -> convertRGBA8 dynImg + + return UserData + { udSubsystems = subs + , udAssetSprites = M.singleton "lynx" (Sprite (V2 0 0) img) + } + +handle = return () + +updateLoop = return () + +drawLoop = do + ud@(UserData subs sprites) <- getAffection + draw diff --git a/app/Renderer.hs b/app/Renderer.hs index 8d4d358..d33b0c3 100644 --- a/app/Renderer.hs +++ b/app/Renderer.hs @@ -4,9 +4,15 @@ import SDL (($=)) import qualified Graphics.Rendering.OpenGL as GL +import qualified Data.ByteString as BS + import Foreign -initSpriteRenderData = do +-- internal imports + +import Types + +initSpriteRenderObjects = do quadVAO <- GL.genObjectName quadVBO <- GL.genObjectName @@ -29,6 +35,8 @@ initSpriteRenderData = do GL.bindBuffer GL.ArrayBuffer $= Nothing GL.bindVertexArrayObject $= Nothing + + return (RenderObjects quadVAO quadVBO) where rawVertices :: [Float] rawVertices = @@ -40,3 +48,23 @@ initSpriteRenderData = do , 1, 1, 1, 1 , 1, 0, 1, 0 ] + +initSpriteShaderObjects = do + vertexShaderSrc <- BS.readFile "shader/vertex.sl" + fragmentShaderSrc <- BS.readFile "shader/fragment.sl" + + vertexShader <- GL.createShader Gl.VertexShader + fragmentShader <- GL.createShader Gl.FragmentShader + + 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 diff --git a/app/Types.hs b/app/Types.hs index 66645ec..f6ce908 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -3,3 +3,4 @@ module Types ) where import Types.UserData as T +import Types.Sprite as T diff --git a/app/Types/Renderer.hs b/app/Types/Renderer.hs deleted file mode 100644 index 5342eba..0000000 --- a/app/Types/Renderer.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Types.Renderer where - -import Graphics.Rendering.OpenGL as GL - -data RenderObjects = RenderObjects - { roVAO :: GL.VertexArrayObject - , roVBO :: GL.BufferObject - } - -data GL.Uniform u => ShaderObjects u = Shaderobjects - { soVertexShader :: GL.Shader - , soFragmentShader :: GL.Shader - , soProgram :: GL.Program - , soUniforms :: [(String, u)] - } diff --git a/app/Types/Sprite.hs b/app/Types/Sprite.hs new file mode 100644 index 0000000..97f032c --- /dev/null +++ b/app/Types/Sprite.hs @@ -0,0 +1,55 @@ +module Types.Sprite where + +import SDL (get, ($=)) + +import qualified Graphics.Rendering.OpenGL as GL +import qualified Graphics.GLUtil as GLUtil + +import Codec.Picture + +import Linear + +-- internal imports + +import Classes.Renderable + +data SpriteRenderObjects = SpriteRenderObjects + { roVAO :: GL.VertexArrayObject + , roVBO :: GL.BufferObject + } + +data SpriteShaderObjects = SpriteShaderobjects + { soVertexShader :: GL.Shader + , soFragmentShader :: GL.Shader + , soProgram :: GL.Program + } + +data Sprite = Sprite + { spritePosition :: V2 Int + , SpriteImage :: Image PixelRGBA8 + } + +instance Renderable Sprite where + type VertexObjects Sprite = SpriteRenderObjects + + type ShaderObjects Sprite = SpriteShaderObjects + + init (SpriteRenderObjects vao vbo) = do + GL.currenProgram $= Just prog + GL.bindVertexArrayObject $= Just vao + + draw + (SpriteRenderObjects vao vbo) + (SpriteShaderObjects vs fs prog) + (Sprite pos@(V2 px py) img) = do + let model = mkTransformation + (Quaternion (V3 0 0 0) 1 :: 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 + GL.drawArrays GL.Triangles 0 6 + + clean = + GL.currenProgram $= Nothing + GL.bindVertexArrayObject $= Nothing diff --git a/app/Types/UserData.hs b/app/Types/UserData.hs index 8d9668c..1769851 100644 --- a/app/Types/UserData.hs +++ b/app/Types/UserData.hs @@ -12,9 +12,13 @@ import qualified Data.Map.Strict as M import Codec.Picture +-- internal imports + +import Types.Sprite + data UserData = UserData { udSubsystems :: Subsystems - , udAssetImages :: M.Map ImgId (Image PixelRGBA8) + , udAssetSprites :: M.Map ImgId Sprite } type ImgId = String diff --git a/assets/img/lynx.jpg b/assets/img/lynx.jpg new file mode 100644 index 0000000..1c18abd Binary files /dev/null and b/assets/img/lynx.jpg differ diff --git a/canvas.cabal b/canvas.cabal index 12b8541..6a6b89c 100644 --- a/canvas.cabal +++ b/canvas.cabal @@ -21,6 +21,7 @@ executable canvas main-is: Main.hs other-modules: Types Types.UserData + Types.Sprite Classes.Renderable Renderer -- other-extensions: @@ -30,7 +31,8 @@ executable canvas , OpenGL , JuicyPixels , JuicyPixels-extra - , stm - , containers + , stm + , containers + , linear hs-source-dirs: app default-language: Haskell2010 diff --git a/shader/fragment.sl b/shader/fragment.sl index 985c155..5dc8b0d 100644 --- a/shader/fragment.sl +++ b/shader/fragment.sl @@ -3,9 +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); }