nek0/affection
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Merge pull request #8 from nek0/multiwindow

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

5
.gitignore vendored
View file

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

7
examples/example00/Main.hs
View file

@ -107,11 +107,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

7
examples/example01/Main.hs
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

7
examples/example02/Main.hs
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

34
src/Affection.hs
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"

24
src/Affection/Types.hs
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)

4
src/Affection/Util.hs
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)