From cb67408ca39a22159b96a516da0ae6815661fd81 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 8 Feb 2019 16:10:52 +0100 Subject: [PATCH] slowly working towards texture --- src/Draw.hs | 33 ++++++++++++++++++++++++--- src/Events.hs | 5 ++-- src/Main.hs | 63 +++++++++++++++++++++++++++++++++++---------------- src/Types.hs | 7 ++++-- 4 files changed, 81 insertions(+), 27 deletions(-) diff --git a/src/Draw.hs b/src/Draw.hs index a8dc679..94f26b9 100644 --- a/src/Draw.hs +++ b/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" ( diff --git a/src/Events.hs b/src/Events.hs index c9ec694..df1ef6d 100644 --- a/src/Events.hs +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index d64e79f..617ad01 100644 --- a/src/Main.hs +++ b/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 diff --git a/src/Types.hs b/src/Types.hs index fba1b35..3b21fab 100644 --- a/src/Types.hs +++ b/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 }