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 executable ibis
main-is: Main.hs main-is: Main.hs
other-modules: Util other-modules: Events
, Util
, Types , Types
-- other-extensions: -- other-extensions:
default-extensions: OverloadedStrings default-extensions: OverloadedStrings
@ -33,5 +34,6 @@ executable ibis
, nanovg , nanovg
, magic , magic
, split , split
, time
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 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.Maybe
import Data.Time.Clock
import System.Exit (exitFailure) import System.Exit (exitFailure)
import Magic import Magic
-- internal imports -- internal imports
import Events
import Util import Util
import Types import Types
@ -82,7 +86,14 @@ main = do
verb opts "Creating NanoVG context" verb opts "Creating NanoVG context"
_ <- glewInit _ <- glewInit
nano <- NVG.createGL3 (S.fromList [NVG.Antialias, NVG.StencilStrokes]) 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 mapM_ (SDL.showWindow . snd) wins
verb opts "Entering Loop" verb opts "Entering Loop"
run <- newMVar True run <- newMVar True
@ -90,6 +101,7 @@ main = do
mapM_ (\(ident, context) -> do mapM_ (\(ident, context) -> do
let win = fromJust (lookup ident wins) let win = fromJust (lookup ident wins)
SDL.glMakeCurrent win context SDL.glMakeCurrent win context
mapM_ eventHandler =<< SDL.pollEvents
GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
GL.flush GL.flush
SDL.glSwapWindow win SDL.glSwapWindow win

View file

@ -2,6 +2,8 @@ module Types where
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Clock
data Options = Options data Options = Options
{ optFullscreen :: Bool { optFullscreen :: Bool
, optFlipScreens :: Bool , optFlipScreens :: Bool
@ -9,3 +11,9 @@ data Options = Options
, optFile :: T.Text , optFile :: T.Text
} }
deriving (Show) deriving (Show)
data State = State
{ stCurrentPage :: Word
, stPresentationWindow :: Word
, stStartTime :: UTCTime
} deriving (Show)

View file

@ -1,7 +1,11 @@
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
module Util where 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 import Options.Applicative
@ -11,6 +15,8 @@ import System.IO
import Foreign.C.Types (CInt(..)) import Foreign.C.Types (CInt(..))
import Linear
-- internal imports -- internal imports
import Types import Types
@ -20,7 +26,8 @@ foreign import ccall unsafe "glewInit"
glWindowConfig :: SDL.WindowConfig glWindowConfig :: SDL.WindowConfig
glWindowConfig = SDL.defaultWindow glWindowConfig = SDL.defaultWindow
{ SDL.windowOpenGL = Just SDL.defaultOpenGL { SDL.windowResizable = True
, SDL.windowOpenGL = Just SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 3 { SDL.glProfile = SDL.Core SDL.Normal 3 3
} }
} }
@ -63,3 +70,15 @@ verb :: Options -> String -> IO ()
verb opts str = do verb opts str = do
when (optVerbose opts) $ when (optVerbose opts) $
putStrLn str 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)