thanks to strfry it works now

This commit is contained in:
nek0 2019-02-03 00:57:52 +01:00
parent 6a11ba265f
commit 08e69c5064
3 changed files with 25 additions and 24 deletions

View file

@ -1,6 +1,7 @@
module Draw where module Draw where
import SDL (($=), get) import SDL (($=), get)
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
@ -11,6 +12,8 @@ import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Word (Word32)
import Control.Concurrent.MVar import Control.Concurrent.MVar
import Linear import Linear
@ -21,6 +24,8 @@ import Foreign
import Types import Types
import Util
quadCoord :: [Float] quadCoord :: [Float]
quadCoord = quadCoord =
[ 1 , 1 , 0 [ 1 , 1 , 0
@ -29,7 +34,7 @@ quadCoord =
, (-1), 1 , 0 , (-1), 1 , 0
] ]
quadIndices :: [Word] quadIndices :: [Word32]
quadIndices = quadIndices =
[ 0, 1, 3 [ 0, 1, 3
, 1, 2, 3 , 1, 2, 3
@ -37,9 +42,11 @@ quadIndices =
initGL :: IO GLvebo initGL :: IO GLvebo
initGL = do initGL = do
GL.depthFunc $= Just GL.Less --GL.depthFunc $= Just GL.Less
vertexBufferObject <- GL.genObjectName vertexBufferObject <- GL.genObjectName
GL.bindBuffer GL.ArrayBuffer $= Just vertexBufferObject
withArray quadCoord $ \ptr -> withArray quadCoord $ \ptr ->
GL.bufferData GL.ArrayBuffer $= GL.bufferData GL.ArrayBuffer $=
( fromIntegral $ length quadCoord * sizeOf (0 :: Float) ( fromIntegral $ length quadCoord * sizeOf (0 :: Float)
@ -52,7 +59,7 @@ initGL = do
withArray quadIndices $ \ptr -> withArray quadIndices $ \ptr ->
GL.bufferData GL.ElementArrayBuffer $= GL.bufferData GL.ElementArrayBuffer $=
( fromIntegral $ length quadIndices * sizeOf (0 :: Word) ( fromIntegral $ length quadIndices * (sizeOf (0 :: Word32))
, ptr , ptr
, GL.StaticDraw , GL.StaticDraw
) )
@ -61,8 +68,7 @@ initGL = do
( GL.ToFloat ( GL.ToFloat
, GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr , GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr
) )
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float) GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float)
@ -71,24 +77,21 @@ initGL = do
, giEBO = elementBufferObject , giEBO = elementBufferObject
} }
initVAO :: Word -> IO (Word, GL.VertexArrayObject) initVAO :: IO ()
initVAO ident = do initVAO = do
vertexArrayObject <- GL.genObjectName vertexArrayObject <- GL.genObjectName
GL.bindVertexArrayObject $= Just vertexArrayObject GL.bindVertexArrayObject $= Just vertexArrayObject
return (ident, vertexArrayObject)
draw :: MVar State -> Word -> IO () draw :: MVar State -> Word -> IO ()
draw state ident = do draw state ident = do
st <- readMVar state st <- readMVar state
let win = fromJust (lookup ident $ stWindows st)
dim <- get (SDL.windowSize win)
fitViewport (800/600) (fmap fromIntegral dim)
GL.currentProgram $= (Just . GU.program $ fromJust $ lookup ident $ GL.currentProgram $= (Just . GU.program $ fromJust $ lookup ident $
stPrograms st) stPrograms st)
-- let proj = ortho (-1) 1 (-1) (1) (-1) 1
-- model = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 0 0 0) GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
-- view = lookAt (V3 0 0 0) (V3 0 0 0) (V3 0 0 0)
-- pvm = proj !*! view !*! model
GL.bindVertexArrayObject $= lookup ident (stVAOs st)
GL.drawArrays GL.Triangles 0 (fromIntegral $ length quadCoord)
return ()
vertexShader :: BS.ByteString vertexShader :: BS.ByteString
vertexShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty vertexShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty
@ -105,7 +108,6 @@ fragmentShader :: Word -> BS.ByteString
fragmentShader ident = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty fragmentShader ident = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty
[ "#version 330 core" [ "#version 330 core"
, "" , ""
-- , "out vec4 gl_FragColor;"
, "" , ""
, "void main() {" , "void main() {"
, " gl_FragColor = vec4(" `BS.append` BC.pack (show (fromIntegral ident * (1 :: Float))) `BS.append` ", 0.5, 0.2, 1.0);" , " gl_FragColor = vec4(" `BS.append` BC.pack (show (fromIntegral ident * (1 :: Float))) `BS.append` ", 0.5, 0.2, 1.0);"

View file

@ -92,12 +92,9 @@ main = do
mapM_ (flip SDL.setWindowMode SDL.FullscreenDesktop . snd) wins mapM_ (flip SDL.setWindowMode SDL.FullscreenDesktop . snd) wins
void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1 void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
verb opts "Creating OpenGL context(s)" verb opts "Creating OpenGL context(s)"
context <- (SDL.glCreateContext . snd) (head wins) context <- (SDL.glCreateContext . snd) (last wins)
-- verb opts "Creating NanoVG context"
-- _ <- glewInit
-- nano <- NVG.createGL3 (S.fromList [NVG.Antialias, NVG.StencilStrokes])
verb opts "Initializing rendering pipeline" verb opts "Initializing rendering pipeline"
glInits <- mapM (initVAO . fst) wins initVAO
vebo <- initGL vebo <- initGL
programs <- mapM (\(ident, _) -> do programs <- mapM (\(ident, _) -> do
ret <- GU.simpleShaderProgramBS vertexShader (fragmentShader ident) ret <- GU.simpleShaderProgramBS vertexShader (fragmentShader ident)
@ -111,7 +108,7 @@ main = do
1 1
(last $ map fst wins) (last $ map fst wins)
time time
glInits wins
programs programs
vebo vebo
) )
@ -125,9 +122,9 @@ main = do
mapM_ (eventHandler run) =<< SDL.pollEvents mapM_ (eventHandler run) =<< SDL.pollEvents
GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
draw state ident draw state ident
GL.flush
SDL.glSwapWindow window SDL.glSwapWindow window
) wins ) wins
-- GL.flush
) )
verb opts "Deleting context" verb opts "Deleting context"
SDL.glDeleteContext context SDL.glDeleteContext context

View file

@ -1,5 +1,7 @@
module Types where module Types where
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GLUtil as GU import qualified Graphics.GLUtil as GU
@ -20,7 +22,7 @@ data State = State
{ stCurrentPage :: Word { stCurrentPage :: Word
, stPresentationWindow :: Word , stPresentationWindow :: Word
, stStartTime :: UTCTime , stStartTime :: UTCTime
, stVAOs :: [(Word, GL.VertexArrayObject)] , stWindows :: [(Word, SDL.Window)]
, stPrograms :: [(Word, GU.ShaderProgram)] , stPrograms :: [(Word, GU.ShaderProgram)]
, stVEBO :: GLvebo , stVEBO :: GLvebo
} }