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
import SDL (($=), get)
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL
@ -11,6 +12,8 @@ import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromJust)
import Data.Word (Word32)
import Control.Concurrent.MVar
import Linear
@ -21,6 +24,8 @@ import Foreign
import Types
import Util
quadCoord :: [Float]
quadCoord =
[ 1 , 1 , 0
@ -29,7 +34,7 @@ quadCoord =
, (-1), 1 , 0
]
quadIndices :: [Word]
quadIndices :: [Word32]
quadIndices =
[ 0, 1, 3
, 1, 2, 3
@ -37,9 +42,11 @@ quadIndices =
initGL :: IO GLvebo
initGL = do
GL.depthFunc $= Just GL.Less
--GL.depthFunc $= Just GL.Less
vertexBufferObject <- GL.genObjectName
GL.bindBuffer GL.ArrayBuffer $= Just vertexBufferObject
withArray quadCoord $ \ptr ->
GL.bufferData GL.ArrayBuffer $=
( fromIntegral $ length quadCoord * sizeOf (0 :: Float)
@ -52,7 +59,7 @@ initGL = do
withArray quadIndices $ \ptr ->
GL.bufferData GL.ElementArrayBuffer $=
( fromIntegral $ length quadIndices * sizeOf (0 :: Word)
( fromIntegral $ length quadIndices * (sizeOf (0 :: Word32))
, ptr
, GL.StaticDraw
)
@ -61,8 +68,7 @@ initGL = do
( GL.ToFloat
, GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr
)
GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float)
@ -71,24 +77,21 @@ initGL = do
, giEBO = elementBufferObject
}
initVAO :: Word -> IO (Word, GL.VertexArrayObject)
initVAO ident = do
initVAO :: IO ()
initVAO = do
vertexArrayObject <- GL.genObjectName
GL.bindVertexArrayObject $= Just vertexArrayObject
return (ident, vertexArrayObject)
draw :: MVar State -> Word -> IO ()
draw state ident = do
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 $
stPrograms st)
-- let proj = ortho (-1) 1 (-1) (1) (-1) 1
-- model = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 0 0 0)
-- 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 ()
GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
vertexShader :: BS.ByteString
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
[ "#version 330 core"
, ""
-- , "out vec4 gl_FragColor;"
, ""
, "void main() {"
, " 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
void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
verb opts "Creating OpenGL context(s)"
context <- (SDL.glCreateContext . snd) (head wins)
-- verb opts "Creating NanoVG context"
-- _ <- glewInit
-- nano <- NVG.createGL3 (S.fromList [NVG.Antialias, NVG.StencilStrokes])
context <- (SDL.glCreateContext . snd) (last wins)
verb opts "Initializing rendering pipeline"
glInits <- mapM (initVAO . fst) wins
initVAO
vebo <- initGL
programs <- mapM (\(ident, _) -> do
ret <- GU.simpleShaderProgramBS vertexShader (fragmentShader ident)
@ -111,7 +108,7 @@ main = do
1
(last $ map fst wins)
time
glInits
wins
programs
vebo
)
@ -125,9 +122,9 @@ main = do
mapM_ (eventHandler run) =<< SDL.pollEvents
GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
draw state ident
GL.flush
SDL.glSwapWindow window
) wins
-- GL.flush
)
verb opts "Deleting context"
SDL.glDeleteContext context

View File

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