slowly working towards texture
This commit is contained in:
parent
546417d15d
commit
cb67408ca3
33
src/Draw.hs
33
src/Draw.hs
|
@ -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" (
|
||||||
|
|
|
@ -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
|
||||||
|
|
63
src/Main.hs
63
src/Main.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in a new issue