{-# 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 Data.Time.Clock import System.Exit (exitFailure) import Magic -- internal imports import Events 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 "Initializing state" state <- newMVar <$> ( State <$> pure 1 <*> pure (last $ map fst wins) <*> getCurrentTime ) verb opts "Displaying window(s)" 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 mapM_ (eventHandler run) =<< SDL.pollEvents 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