thanks to strfry it works now

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);"

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

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
   }