{-# 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 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 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)" 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] draw state 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