{-# 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