add state and event handling basics

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

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 ()

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

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)

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)