diff --git a/src/Draw.hs b/src/Draw.hs index e2ae6d9..15a5e45 100644 --- a/src/Draw.hs +++ b/src/Draw.hs @@ -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);" diff --git a/src/Main.hs b/src/Main.hs index 470771f..d34e313 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Types.hs b/src/Types.hs index 222b7fb..9a31e14 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -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 }