Merge pull request #8 from nek0/multiwindow

Multiwindow
This commit is contained in:
rys ostrovid 2019-04-29 18:59:44 +02:00 committed by GitHub
commit c1ed74bb66
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
7 changed files with 74 additions and 40 deletions

5
.gitignore vendored
View file

@ -11,3 +11,8 @@ dist/
*.hp *.hp
*.ps *.ps
*.swp *.swp
.ghc*
cabal.project.local*
dist*/
report.html
*.bak

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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