getting nanovg and stuff

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

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

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)

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