slowly working towards texture

src/Draw.hs

@@ -40,7 +40,17 @@ quadIndices =
   , 1, 2, 3
   ]
 
-initGL :: IO GLvebo
+uvCoord :: [Float]
+uvCoord =
+  [ 0, 0
+  , 1, 0
+  , 0, 1
+  , 1, 0
+  , 1, 1
+  , 0, 1
+  ]
+
+initGL :: IO GLbo
 initGL = do
   --GL.depthFunc $= Just GL.Less
 
@@ -70,11 +80,28 @@ initGL = do
     )
   GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
 
+  textureBufferObject <- GL.genObjectName
+  GL.bindBuffer GL.ArrayBuffer $= Just textureBufferObject
+
+  withArray uvCoord $ \ptr ->
+    GL.bufferData GL.ArrayBuffer $=
+      ( fromIntegral $ length uvCoord * sizeOf (0 :: Float)
+      , ptr
+      , GL.StaticDraw
+      )
+
+  GL.vertexAttribPointer (GL.AttribLocation 2) $=
+    ( GL.ToFloat
+    , GL.VertexArrayDescriptor 2 GL.Float 0 nullPtr
+    )
+  GL.vertexAttribArray (GL.AttribLocation 2) $= GL.Enabled
+
   GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float)
 
-  return GLvebo
+  return GLbo
     { glVBO = vertexBufferObject
     , glEBO = elementBufferObject
+    , glTBO = textureBufferObject
     }
 
 initVAO :: IO ()
@@ -87,7 +114,7 @@ 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)
+  fitViewport (stAspectRatio st) (fmap fromIntegral dim)
   GL.currentProgram $= (Just . GU.program $ stProgram st)
 
   GU.setUniform (stProgram st) "ident" (

src/Events.hs

@@ -20,8 +20,9 @@ eventHandler run state (SDL.Event _ payload) =
 
 handlePayload :: MVar Bool -> MVar State -> SDL.EventPayload -> IO ()
 
-handlePayload _ _ (SDL.WindowResizedEvent (SDL.WindowResizedEventData _ dim)) =
-  fitViewport (800 / 600) dim
+-- handlePayload _ state (SDL.WindowResizedEvent (SDL.WindowResizedEventData _ dim)) = do
+--   st <- readMVar state
+--   fitViewport (stAspectRatio st) dim
 
 handlePayload run _ (SDL.WindowClosedEvent _) = do
   _ <- swapMVar run False

src/Main.hs

@@ -10,6 +10,9 @@ import qualified Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
 
 import qualified Graphics.GLUtil as GU
 
+import Graphics.UI.Gtk.Poppler.Page
+import Graphics.UI.Gtk.Poppler.Document
+
 -- import qualified NanoVG as NVG
 
 import Linear
@@ -56,26 +59,18 @@ main = do
     ( fullDesc
     <> progDesc "A simple PDF presenter written in Haskell using poppler and SDL2"
     )
-  magic <- magicOpen [MagicMime]
-  magicLoadDefault magic
-  mime <- head <$> splitOn ";" <$> magicFile magic (T.unpack $ optFile opts)
-  -- when (mime /= "application/pdf") $ do
-  --   verb opts ("Not a PDF file: " ++ T.unpack (optFile opts))
-  --   exitFailure
-  SDL.initializeAll
-  SDL.screenSaverEnabled SDL.$= False
-  disps <- SDL.getDisplays
+  checkMagic opts
+  disps <- sdlInit
   verb opts ("Number of displays detected: " ++ show (length disps))
   verb opts ("Passed command line options: " ++ show opts)
-  -- set Render quality
-  SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear
-  uncurry SDL.setHint =<< (,)
-    <$> newCString "SDL_VIDEO_MINIMIZE_ON_FOCUS_LOSS"
-    <*> newCString "0"
-  -- check render quality
-  renderQuality <- SDL.get SDL.HintRenderScaleQuality
-  when (renderQuality /= SDL.ScaleLinear) $
-    putErrLn "Linear texture filtering not enabled!"
+  mdoc <- documentNewFromFile (T.unpack $ "file://" <> optFile opts) Nothing
+  document <- case mdoc of
+    Just d  -> return d
+    Nothing -> do
+      putErrLn ("Could not open file: " ++ T.unpack (optFile opts))
+      exitFailure
+  aspect <- fmap (\(w, h) -> w / h) (pageGetSize =<< documentGetPage document 0)
+  npag <- documentGetNPages document
   verb opts "Creating window configuration(s)"
   let !confs = map makeWindowConfig disps
   verb opts "Creating window(s)"
@@ -93,7 +88,6 @@ main = do
     )
   when (optFullscreen opts) $
     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) (last wins)
   verb opts "Initializing rendering pipeline"
@@ -104,7 +98,9 @@ main = do
   time <- SDL.ticks
   state <- newMVar (
     State 
-      1
+      0
+      (fromIntegral $ npag - 1)
+      aspect
       (optFile opts)
       (last $ map fst wins)
       time
@@ -136,3 +132,30 @@ main = do
   SDL.glDeleteContext context
   verb opts "Destroying window(s)"
   mapM_ (SDL.destroyWindow . snd) wins
+
+checkMagic :: Options -> IO ()
+checkMagic opts = do
+  magic <- magicOpen [MagicMime]
+  magicLoadDefault magic
+  mime <- head <$> splitOn ";" <$> magicFile magic (T.unpack $ optFile opts)
+  when (mime /= "application/pdf") $ do
+    putErrLn ("Not a PDF file: " ++ T.unpack (optFile opts))
+    exitFailure
+
+sdlInit :: IO [SDL.Display]
+sdlInit = do
+  SDL.initializeAll
+  SDL.screenSaverEnabled SDL.$= False
+  SDL.cursorVisible SDL.$= False
+  disps <- SDL.getDisplays
+  -- set Render quality
+  SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear
+  -- check render quality
+  renderQuality <- SDL.get SDL.HintRenderScaleQuality
+  when (renderQuality /= SDL.ScaleLinear) $
+    putErrLn "Linear texture filtering not enabled!"
+  uncurry SDL.setHint =<< (,)
+    <$> newCString "SDL_VIDEO_MINIMIZE_ON_FOCUS_LOSS"
+    <*> newCString "0"
+  void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
+  return disps

src/Types.hs

@@ -22,16 +22,19 @@ data Options = Options
 
 data State = State
   { stCurrentPage :: Word
+  , stMaxPage :: Word
+  , stAspectRatio :: Double
   , stFilename :: T.Text
   , stPresentationWindow :: Word
   , stStartTime :: Word32
   , stLastTime :: Word32
   , stWindows :: [(Word, SDL.Window)]
   , stProgram :: GU.ShaderProgram
-  , stVEBO :: GLvebo
+  , stBO :: GLbo
   }
 
-data GLvebo = GLvebo
+data GLbo = GLbo
   { glVBO :: GL.BufferObject
   , glEBO :: GL.BufferObject
+  , glTBO :: GL.BufferObject
   }