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 :: * type ShaderObjects a :: *
init :: IO () init :: VertexObjects a -> ShaderObjects a -> a -> IO ()
draw :: 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 SDL (($=))
import qualified SDL import qualified SDL
import qualified Rendering.Graphics.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
import Codec.Picture import Codec.Picture
import Control.Monad (void) import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.STM import Control.Concurrent.STM
@ -19,6 +20,9 @@ import qualified Data.Map.Strict as M
-- internal imports -- internal imports
import Types import Types
import Types.Sprite
import Renderer
import Classes.Renderable as CR
main :: IO () main :: IO ()
main = main =
@ -27,9 +31,9 @@ main =
, windowTitle = "canvas" , windowTitle = "canvas"
, windowConfigs = , windowConfigs =
[ ( 0 [ ( 0
, SDL.DefaultWindow , SDL.defaultWindow
{ SDL.windowInitialSize = SDL.V2 1600 900 { 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 { SDL.glProfile = SDL.Core SDL.Normal 3 3
} }
} }
@ -37,20 +41,20 @@ main =
] ]
, initScreenMode = SDL.FullscreenDesktop , initScreenMode = SDL.FullscreenDesktop
, preLoop = return () , preLoop = return ()
, eventLoop = MapM_ handle , eventLoop = mapM_ handle
, updateLoop = updateLoop , updateLoop = updateLoopImpl
, drawLoop = drawLoop , drawLoop = drawLoopImpl
, loadState = loadState , loadState = loadStateImpl
, cleanUp = (\_ -> return ()) , cleanUp = (\_ -> return ())
, canvasSize = Nothing , canvasSize = Nothing
} }
loadState :: IO UserData loadStateImpl :: IO UserData
loadState = do loadStateImpl = do
void $ SDL.setMouseLocationMode SDL.RelativeLocation void $ SDL.setMouseLocationMode SDL.RelativeLocation
GL.depthFunc $= Just GL.Less GL.depthFunc $= Just GL.Less
subs <- Subsystms subs <- Subsystems
<$> (SubWindow <$> newTVarIO []) <$> (SubWindow <$> newTVarIO [])
<*> (SubMouse <$> 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 ud@(UserData subs rassets) <- getAffection
let (RenderAssets sDetails@(svo sso sdo)) = rassets let (RenderAssets sDetails@(AssetDetails svo sso sdo)) = rassets
mapM_ (draw svo sso) (assocs sdo) 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 SDL (($=))
import qualified Graphics.Rendering.OpenGL as GL 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 qualified Data.ByteString as BS
import Codec.Picture
import Linear
import Foreign import Foreign
-- internal imports -- internal imports
@ -36,7 +43,7 @@ initSpriteRenderObjects = do
GL.bindBuffer GL.ArrayBuffer $= Nothing GL.bindBuffer GL.ArrayBuffer $= Nothing
GL.bindVertexArrayObject $= Nothing GL.bindVertexArrayObject $= Nothing
return (RenderObjects quadVAO quadVBO) return (SpriteRenderObjects quadVAO quadVBO)
where where
rawVertices :: [Float] rawVertices :: [Float]
rawVertices = rawVertices =
@ -53,33 +60,19 @@ initSpriteShaderObjects = do
vertexShaderSrc <- BS.readFile "shader/vertex.sl" vertexShaderSrc <- BS.readFile "shader/vertex.sl"
fragmentShaderSrc <- BS.readFile "shader/fragment.sl" fragmentShaderSrc <- BS.readFile "shader/fragment.sl"
vertexShader <- GL.createShader Gl.VertexShader shaderProgram <- GLU.simpleShaderProgramBS vertexShaderSrc fragmentShaderSrc
fragmentShader <- GL.createShader Gl.FragmentShader
GL.shaderSourceBS vertexShader $= vertexShaderSrc return (SpriteShaderObjects shaderProgram)
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)
loadSprites :: IO (AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite) loadSprites :: IO (AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite)
loadSprites = do loadSprites = do
rawImg <- readImage "assets/img/lynx.jpg" rawImg <- readImage "assets/img/lynx.jpg"
let img = case eRawImg of let img = case rawImg of
Left err -> error err Left err -> error err
Right dynImg -> convertRGBA8 dynImg Right dynImg -> convertRGBA8 dynImg
vertObj <- initSpriteRenderObjects vertObj <- initSpriteRenderObjects
shadObj <- initSpriteShaderobjects shadObj <- initSpriteShaderObjects
return AssetDetails return AssetDetails
{ adVertObj = vertObj { adVertObj = vertObj

View file

@ -1,9 +1,10 @@
{-# LANGUAGE TypeFamilies #-}
module Types.Sprite where module Types.Sprite where
import SDL (get, ($=)) import SDL (get, ($=))
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GLUtil as GLUtil import qualified Graphics.GLUtil as GLU
import Codec.Picture import Codec.Picture
@ -18,15 +19,13 @@ data SpriteRenderObjects = SpriteRenderObjects
, roVBO :: GL.BufferObject , roVBO :: GL.BufferObject
} }
data SpriteShaderObjects = SpriteShaderobjects data SpriteShaderObjects = SpriteShaderObjects
{ soVertexShader :: GL.Shader { soProgram :: GLU.ShaderProgram
, soFragmentShader :: GL.Shader
, soProgram :: GL.Program
} }
data Sprite = Sprite data Sprite = Sprite
{ spritePosition :: V2 Int { spritePosition :: V2 Int
, SpriteImage :: Image PixelRGBA8 , spriteImage :: Image PixelRGBA8
} }
instance Renderable Sprite where instance Renderable Sprite where
@ -34,22 +33,20 @@ instance Renderable Sprite where
type ShaderObjects Sprite = SpriteShaderObjects type ShaderObjects Sprite = SpriteShaderObjects
init (SpriteRenderObjects vao vbo) = do init (SpriteRenderObjects vao vbo) (SpriteShaderObjects prog) _ = do
GL.currenProgram $= Just prog GL.currentProgram $= Just (GLU.program prog)
GL.bindVertexArrayObject $= Just vao GL.bindVertexArrayObject $= Just vao
draw draw
(SpriteRenderObjects vao vbo) (SpriteRenderObjects vao vbo)
(SpriteShaderObjects vs fs prog) (SpriteShaderObjects prog)
(Sprite pos@(V2 px py) img) = do (Sprite pos@(V2 px py) img) = do
let model = mkTransformation 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) (fmap fromIntegral $ V3 px py 0 :: V3 Float)
GLU.setUniform program "model" model GLU.setUniform prog "model" model
uLoc <- get (GL.uniformLocation prog "model")
GL.uniform uLoc $= model
GL.drawArrays GL.Triangles 0 6 GL.drawArrays GL.Triangles 0 6
clean = clean _ = do
GL.currenProgram $= Nothing GL.currentProgram $= (Nothing :: Maybe GL.Program)
GL.bindVertexArrayObject $= Nothing GL.bindVertexArrayObject $= (Nothing :: Maybe GL.VertexArrayObject)

View file

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

View file

@ -29,10 +29,12 @@ executable canvas
, affection , affection
, sdl2 ^>=2.5.0.0 , sdl2 ^>=2.5.0.0
, OpenGL , OpenGL
, GLUtil
, JuicyPixels , JuicyPixels
, JuicyPixels-extra , JuicyPixels-extra
, stm , stm
, containers , containers
, linear , linear
, bytestring
hs-source-dirs: app hs-source-dirs: app
default-language: Haskell2010 default-language: Haskell2010

View file

@ -3,10 +3,10 @@ in vec2 TexCoords;
out vec4 color; out vec4 color;
uniform sampler2D image; uniform sampler2D image;
#uniform vec3 spriteColor; //uniform vec3 spriteColor;
void main() void main()
{ {
#color = vec4(spriteColor, 1.0) * texture(image, TexCoords); //color = vec4(spriteColor, 1.0) * texture(image, TexCoords);
color = texture(image, TexCoords); color = texture(image, TexCoords);
} }