slowly working towards texture

This commit is contained in:
nek0 2019-02-08 16:10:52 +01:00
parent 546417d15d
commit cb67408ca3
4 changed files with 81 additions and 27 deletions

View file

@ -40,7 +40,17 @@ quadIndices =
, 1, 2, 3 , 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 initGL = do
--GL.depthFunc $= Just GL.Less --GL.depthFunc $= Just GL.Less
@ -70,11 +80,28 @@ initGL = do
) )
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled 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) GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float)
return GLvebo return GLbo
{ glVBO = vertexBufferObject { glVBO = vertexBufferObject
, glEBO = elementBufferObject , glEBO = elementBufferObject
, glTBO = textureBufferObject
} }
initVAO :: IO () initVAO :: IO ()
@ -87,7 +114,7 @@ draw state ident = do
st <- readMVar state st <- readMVar state
let win = fromJust (lookup ident $ stWindows st) let win = fromJust (lookup ident $ stWindows st)
dim <- get (SDL.windowSize win) dim <- get (SDL.windowSize win)
fitViewport (800/600) (fmap fromIntegral dim) fitViewport (stAspectRatio st) (fmap fromIntegral dim)
GL.currentProgram $= (Just . GU.program $ stProgram st) GL.currentProgram $= (Just . GU.program $ stProgram st)
GU.setUniform (stProgram st) "ident" ( GU.setUniform (stProgram st) "ident" (

View file

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

View file

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

View file

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