diff --git a/ibis.cabal b/ibis.cabal index 450b4bb..c515b78 100644 --- a/ibis.cabal +++ b/ibis.cabal @@ -22,6 +22,7 @@ executable ibis -- other-extensions: default-extensions: OverloadedStrings build-depends: base >=4.11 + , containers , optparse-applicative , poppler , sdl2 @@ -29,5 +30,8 @@ executable ibis , monad-loops , OpenGL , text + , nanovg + , magic + , split hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs index 429d5b2..b051e33 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} module Main where import qualified SDL @@ -6,6 +7,8 @@ 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 @@ -17,6 +20,16 @@ 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 @@ -29,35 +42,60 @@ main = do ( 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 - putStrLn ("Number of displays detected: " ++ show (length disps)) - putStrLn ("Passed command line options: " ++ show opts) + 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!" - putStrLn "Creating window(s)" + 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 - [ "Ibis - " <> optFile opts - , "Ibis - " <> optFile opts <> " - Notes" - ] - (map makeWindowConfig disps) + ( 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 - GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] - GL.flush - mapM_ (SDL.glSwapWindow . snd) wins + 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 diff --git a/src/Types.hs b/src/Types.hs index 3ac586c..8646657 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -5,6 +5,7 @@ import qualified Data.Text as T data Options = Options { optFullscreen :: Bool , optFlipScreens :: Bool + , optVerbose :: Bool , optFile :: T.Text } deriving (Show) diff --git a/src/Util.hs b/src/Util.hs index 7855f74..23cacbe 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -1,15 +1,23 @@ +{-# LANGUAGE ForeignFunctionInterface #-} module Util where import qualified SDL import Options.Applicative +import Control.Monad (when) + import System.IO +import Foreign.C.Types (CInt(..)) + -- internal imports import Types +foreign import ccall unsafe "glewInit" + glewInit :: IO CInt + glWindowConfig :: SDL.WindowConfig glWindowConfig = SDL.defaultWindow { SDL.windowOpenGL = Just SDL.defaultOpenGL @@ -34,6 +42,12 @@ options = Options <> help "Flip screens" <> showDefault ) + <*> switch + ( long "verbose" + <> short 'v' + <> help "Show verbose console output" + <> showDefault + ) <*> argument str ( help "Input file" <> metavar "FILE" @@ -44,3 +58,8 @@ makeWindowConfig d = glWindowConfig { SDL.windowPosition = SDL.Absolute (SDL.displayBoundsPosition d) } + +verb :: Options -> String -> IO () +verb opts str = do + when (optVerbose opts) $ + putStrLn str