ibis/src/Main.hs

129 lines
3.3 KiB
Haskell

{-# LANGUAGE BangPatterns #-}
module Main where
import qualified SDL
import qualified SDL.Raw.Video as SDL (glSetAttribute)
import qualified SDL.Raw.Enum as SDL
import qualified SDL.Raw.Basic as SDL
import qualified Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
import qualified Graphics.GLUtil as GU
-- import qualified NanoVG as NVG
import Linear
import Options.Applicative
import Control.Monad
import Control.Monad.Loops
import Control.Concurrent.MVar
import qualified Data.Text as T
import qualified Data.Set as S
import Data.List.Split (splitOn)
import Data.Maybe
import Data.Time.Clock
import System.Exit (exitFailure)
import Foreign.C.String
import Magic
-- internal imports
import Events
import Draw
import Util
import Types
main :: IO ()
main = do
opts <- execParser $ info (options <**> helper)
( 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
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!"
verb opts "Creating window configuration(s)"
let !confs = map makeWindowConfig disps
verb opts "Creating window(s)"
wins <- zip ([0 .. ] :: [Word]) <$> mapM (uncurry SDL.createWindow) (
zip
( if length disps == 1
then
[ "Ibis - " <> optFile opts ]
else
[ "Ibis - " <> optFile opts <> " - Notes"
, "Ibis - " <> optFile opts
]
)
confs
)
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"
initVAO
vebo <- initGL
program <- GU.simpleShaderProgramBS vertexShader fragmentShader
verb opts "Initializing state"
time <- getCurrentTime
state <- newMVar (
State
1
(optFile opts)
(last $ map fst wins)
time
wins
program
vebo
)
verb opts "Displaying window(s)"
mapM_ (SDL.showWindow . snd) wins
verb opts "Entering Loop"
run <- newMVar True
whileM_ (readMVar run) (do
mapM_ (\(ident, window) -> do
SDL.glMakeCurrent window context
mapM_ (eventHandler run state) =<< SDL.pollEvents
GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
draw state ident
SDL.glSwapWindow window
) wins
)
verb opts "Deleting context"
SDL.glDeleteContext context
verb opts "Destroying window(s)"
mapM_ (SDL.destroyWindow . snd) wins