add state and event handling basics

This commit is contained in:
nek0 2019-01-31 16:01:01 +01:00
parent 57674b344d
commit 756d63a2d6
5 changed files with 63 additions and 4 deletions

View file

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

18
src/Events.hs Normal file
View file

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

View file

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

View file

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

View file

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