schnell schnell

This commit is contained in:
nek0 2020-02-07 14:57:09 +01:00
parent 96476ac52e
commit 0d7f79ba99
7 changed files with 61 additions and 55 deletions

View file

@ -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 ()

View file

@ -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)

View file

@ -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
let img = case rawImg of
Left err -> error err
Right dynImg -> convertRGBA8 dynImg
vertObj <- initSpriteRenderObjects
shadObj <- initSpriteShaderobjects
shadObj <- initSpriteShaderObjects
return AssetDetails
{ adVertObj = vertObj

View file

@ -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)

View file

@ -16,6 +16,8 @@ import Codec.Picture
import Types.Sprite
import Classes.Renderable
data UserData = UserData
{ udSubsystems :: Subsystems
, udRenderAssets :: RenderAssets

View file

@ -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

View file

@ -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);
}