ibis/src/Main.hs

102 lines
2.8 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 Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
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 System.Exit (exitFailure)
import Magic
-- internal imports
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
-- 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)"
contexts <- zip (map fst wins) <$> mapM (SDL.glCreateContext . snd) wins
verb opts "Creating NanoVG context"
_ <- glewInit
nano <- NVG.createGL3 (S.fromList [NVG.Antialias, NVG.StencilStrokes])
verb opts "Creating windows"
mapM_ (SDL.showWindow . snd) wins
verb opts "Entering Loop"
run <- newMVar True
whileM_ (readMVar run) (do
mapM_ (\(ident, context) -> do
let win = fromJust (lookup ident wins)
SDL.glMakeCurrent win context
GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
GL.flush
SDL.glSwapWindow win
) contexts
)
verb opts "Deleting context(s)"
mapM_ (SDL.glDeleteContext . snd) contexts
verb opts "Destroying window(s)"
mapM_ (SDL.destroyWindow . snd) wins