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
]
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" (

View file

@ -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

View file

@ -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

View file

@ -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
}