make affection multi-window capable

This commit is contained in:
nek0 2019-01-30 12:00:28 +01:00
parent 486a7ef012
commit 510e7e922d
6 changed files with 69 additions and 40 deletions

View file

@ -105,11 +105,16 @@ main = do
let conf = AffectionConfig
{ initComponents = All
, windowTitle = "affection: example00"
, windowConfig = SDL.defaultWindow
, windowConfigs =
[
( 0
, SDL.defaultWindow
{ SDL.windowOpenGL = Just SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
}
}
)
]
, initScreenMode = SDL.Windowed
, canvasSize = Nothing
, loadState = load

View file

@ -36,13 +36,18 @@ main = do
let conf = AffectionConfig
{ initComponents = All
, windowTitle = "affection: example01"
, windowConfig = SDL.defaultWindow
, windowConfigs =
[
( 0
, SDL.defaultWindow
{ SDL.windowOpenGL = Just SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
}
, SDL.windowInitialSize = SDL.V2 600 600
, SDL.windowResizable = True
}
)
]
, initScreenMode = SDL.Windowed
, canvasSize = Nothing
, loadState = load

View file

@ -39,13 +39,18 @@ main = do
let conf = AffectionConfig
{ initComponents = All
, windowTitle = "affection: example01"
, windowConfig = SDL.defaultWindow
, windowConfigs =
[
( 0
, SDL.defaultWindow
{ SDL.windowOpenGL = Just SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
}
, SDL.windowInitialSize = SDL.V2 600 600
, SDL.windowResizable = True
}
)
]
, initScreenMode = SDL.Windowed
, canvasSize = Nothing
, loadState = load

View file

@ -53,16 +53,19 @@ withAffection AffectionConfig{..} = do
when (renderQuality /= SDL.ScaleLinear) $
logIO Warn "Linear texture filtering not enabled!"
-- construct window
liftIO $ logIO Debug "Creating Window"
window <- SDL.createWindow windowTitle windowConfig
SDL.showWindow window
liftIO $ logIO Debug "Creating Window(s)"
windows <- zip (map fst windowConfigs) <$>
mapM
(\wc -> SDL.createWindow windowTitle (snd wc))
windowConfigs
mapM_ (SDL.showWindow . snd) windows
_ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
context <- SDL.glCreateContext window
let SDL.V2 (CInt rw) (CInt rh) = SDL.windowInitialSize windowConfig
(w, h) = case canvasSize of
Just (cw, ch) -> (cw, ch)
Nothing -> (fromIntegral rw, fromIntegral rh)
SDL.setWindowMode window initScreenMode
contexts <- zip (map fst windows) <$> mapM (SDL.glCreateContext . snd) windows
-- let SDL.V2 (CInt rw) (CInt rh) = SDL.windowInitialSize windowConfigs
-- (w, h) = case canvasSize of
-- Just (cw, ch) -> (cw, ch)
-- Nothing -> (fromIntegral rw, fromIntegral rh)
mapM_ (flip SDL.setWindowMode initScreenMode . snd) windows
-- SDL.swapInterval $= SDL.SynchronizedUpdates -- <- causes Problems with windows
liftIO $ logIO Debug "Getting Time"
-- get current time
@ -71,11 +74,8 @@ withAffection AffectionConfig{..} = do
initContainer <- (\x -> AffectionData
{ quitEvent = False
, userState = x
, drawWindow = window
, glContext = context
, drawDimensions = case canvasSize of
Just (cw, ch) -> (cw, ch)
Nothing -> (w, h)
, drawWindows = windows
, glContext = contexts
, screenMode = initScreenMode
, elapsedTime = 0
, deltaTime = 0
@ -111,7 +111,7 @@ withAffection AffectionConfig{..} = do
drawLoop
liftIO GL.flush
-- actual displaying of newly drawn frame
SDL.glSwapWindow window
mapM_ (SDL.glSwapWindow . snd) windows
-- save new time
ad3 <- get
when (sysTime ad == sysTime ad3) (
@ -124,7 +124,7 @@ withAffection AffectionConfig{..} = do
liftIO $ logIO Debug "Loop ended. Cleaning"
cleanUp $ userState nState
liftIO $ logIO Debug "Destroying Window"
SDL.glDeleteContext context
SDL.destroyWindow window
mapM_ (SDL.glDeleteContext . snd) contexts
mapM_ (SDL.destroyWindow . snd) windows
-- SDL.quit -- <- This causes segfaults depending on hardware
liftIO $ logIO Debug "This is the end"

View file

@ -33,8 +33,13 @@ data AffectionConfig us = AffectionConfig
-- ^ SDL components to initialize at startup
, windowTitle :: T.Text
-- ^ Window title
, windowConfig :: SDL.WindowConfig
-- ^ Window configuration
, windowConfigs ::
[
( Word -- ^ Window identifier
, SDL.WindowConfig -- ^ Window config for given window
)
]
-- ^ Window configurations
, canvasSize :: Maybe (Int, Int)
-- ^ size of the texture canvas
, initScreenMode :: SDL.WindowMode
@ -62,10 +67,19 @@ data InitComponents
data AffectionData us = AffectionData
{ quitEvent :: Bool -- ^ Loop breaker.
, userState :: us -- ^ State data provided by user
, drawWindow :: SDL.Window -- ^ SDL window
, glContext :: SDL.GLContext -- ^ OpenGL rendering context
, drawWindows ::
[
( Word -- ^ Window identifier
, SDL.Window -- ^ Window linked with identifier
)
] -- ^ SDL windows
, glContext ::
[
( Word -- ^ Window identifier
, SDL.GLContext -- ^ Associated OpenGL context
)
] -- ^ OpenGL rendering contexts
, screenMode :: SDL.WindowMode -- ^ current screen mode
, drawDimensions :: (Int, Int) -- ^ Dimensions of target surface
, elapsedTime :: Double -- ^ Elapsed time in seconds
, deltaTime :: Double -- ^ Elapsed time in seconds since last tick
, sysTime :: TimeSpec -- ^ System time (NOT the time on the clock)

View file

@ -57,10 +57,10 @@ toggleScreen = do
ad <- get
newMode <- case screenMode ad of
SDL.Windowed -> do
SDL.setWindowMode (drawWindow ad) SDL.FullscreenDesktop
mapM_ (flip SDL.setWindowMode SDL.FullscreenDesktop . snd) (drawWindows ad)
return SDL.FullscreenDesktop
SDL.FullscreenDesktop -> do
SDL.setWindowMode (drawWindow ad) SDL.Windowed
mapM_ (flip SDL.setWindowMode SDL.Windowed . snd) (drawWindows ad)
return SDL.Windowed
x -> do
liftIO $ logIO Warn ("Unexpected Screen mode: " ++ show x)