diff --git a/ibis.cabal b/ibis.cabal index c515b78..03d4db0 100644 --- a/ibis.cabal +++ b/ibis.cabal @@ -17,7 +17,8 @@ extra-source-files: CHANGELOG.md executable ibis main-is: Main.hs - other-modules: Util + other-modules: Events + , Util , Types -- other-extensions: default-extensions: OverloadedStrings @@ -33,5 +34,6 @@ executable ibis , nanovg , magic , split + , time hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Events.hs b/src/Events.hs new file mode 100644 index 0000000..9d66c70 --- /dev/null +++ b/src/Events.hs @@ -0,0 +1,18 @@ +module Events where + +import qualified SDL + +import Linear + +-- internal impomrts + +import Util + +eventHandler :: SDL.Event -> IO () +eventHandler (SDL.Event _ payload) = + handlePayload payload + +handlePayload :: SDL.EventPayload -> IO () +handlePayload (SDL.WindowResizedEvent (SDL.WindowResizedEventData _ dim)) = + fitViewport (800 / 600) dim +handlePayload _ = return () diff --git a/src/Main.hs b/src/Main.hs index b051e33..33c8d8f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -26,12 +26,16 @@ import Data.List.Split (splitOn) import Data.Maybe +import Data.Time.Clock + import System.Exit (exitFailure) import Magic -- internal imports +import Events + import Util import Types @@ -82,7 +86,14 @@ main = do verb opts "Creating NanoVG context" _ <- glewInit nano <- NVG.createGL3 (S.fromList [NVG.Antialias, NVG.StencilStrokes]) - verb opts "Creating windows" + 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 @@ -90,6 +101,7 @@ main = do mapM_ (\(ident, context) -> do let win = fromJust (lookup ident wins) SDL.glMakeCurrent win context + mapM_ eventHandler =<< SDL.pollEvents GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] GL.flush SDL.glSwapWindow win diff --git a/src/Types.hs b/src/Types.hs index 8646657..1c87915 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -2,6 +2,8 @@ module Types where import qualified Data.Text as T +import Data.Time.Clock + data Options = Options { optFullscreen :: Bool , optFlipScreens :: Bool @@ -9,3 +11,9 @@ data Options = Options , optFile :: T.Text } deriving (Show) + +data State = State + { stCurrentPage :: Word + , stPresentationWindow :: Word + , stStartTime :: UTCTime + } deriving (Show) diff --git a/src/Util.hs b/src/Util.hs index 23cacbe..97adcd4 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -1,7 +1,11 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Util where -import qualified SDL +import qualified SDL hiding (V2) + +import qualified Graphics.Rendering.OpenGL as GL + +import Data.Int (Int32(..)) import Options.Applicative @@ -11,6 +15,8 @@ import System.IO import Foreign.C.Types (CInt(..)) +import Linear + -- internal imports import Types @@ -20,7 +26,8 @@ foreign import ccall unsafe "glewInit" glWindowConfig :: SDL.WindowConfig glWindowConfig = SDL.defaultWindow - { SDL.windowOpenGL = Just SDL.defaultOpenGL + { SDL.windowResizable = True + , SDL.windowOpenGL = Just SDL.defaultOpenGL { SDL.glProfile = SDL.Core SDL.Normal 3 3 } } @@ -63,3 +70,15 @@ verb :: Options -> String -> IO () verb opts str = do when (optVerbose opts) $ putStrLn str + +fitViewport :: Double -> V2 Int32 -> IO () +fitViewport ratio (V2 w h) = do + if fromIntegral w / fromIntegral h > ratio + then do + let nw = floor (fromIntegral h * ratio) + dw = floor ((fromIntegral w - fromIntegral nw) / 2 :: Double) + GL.viewport SDL.$= (GL.Position dw 0, GL.Size nw h) + else do + let nh = floor (fromIntegral w / ratio) + dh = floor ((fromIntegral h - fromIntegral nh) / 2 :: Double) + GL.viewport SDL.$= (GL.Position 0 dh, GL.Size w nh)