getting nanovg and stuff

This commit is contained in:
nek0 2019-01-31 14:47:18 +01:00
parent 1da8a65028
commit 57674b344d
4 changed files with 72 additions and 10 deletions

View File

@ -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

View File

@ -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

View File

@ -5,6 +5,7 @@ import qualified Data.Text as T
data Options = Options
{ optFullscreen :: Bool
, optFlipScreens :: Bool
, optVerbose :: Bool
, optFile :: T.Text
}
deriving (Show)

View File

@ -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