From 510e7e922dfc50198881ad35bee4bf146f07bbe8 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 30 Jan 2019 12:00:28 +0100 Subject: [PATCH 1/2] make affection multi-window capable --- examples/example00/Main.hs | 13 +++++++++---- examples/example01/Main.hs | 17 +++++++++++------ examples/example02/Main.hs | 17 +++++++++++------ src/Affection.hs | 34 +++++++++++++++++----------------- src/Affection/Types.hs | 24 +++++++++++++++++++----- src/Affection/Util.hs | 4 ++-- 6 files changed, 69 insertions(+), 40 deletions(-) diff --git a/examples/example00/Main.hs b/examples/example00/Main.hs index c496e67..52f1bd9 100644 --- a/examples/example00/Main.hs +++ b/examples/example00/Main.hs @@ -105,11 +105,16 @@ main = do let conf = AffectionConfig { initComponents = All , windowTitle = "affection: example00" - , windowConfig = SDL.defaultWindow - { SDL.windowOpenGL = Just SDL.defaultOpenGL - { SDL.glProfile = SDL.Core SDL.Normal 3 3 + , windowConfigs = + [ + ( 0 + , SDL.defaultWindow + { SDL.windowOpenGL = Just SDL.defaultOpenGL + { SDL.glProfile = SDL.Core SDL.Normal 3 3 + } } - } + ) + ] , initScreenMode = SDL.Windowed , canvasSize = Nothing , loadState = load diff --git a/examples/example01/Main.hs b/examples/example01/Main.hs index 9dfd6c2..5c1fabe 100644 --- a/examples/example01/Main.hs +++ b/examples/example01/Main.hs @@ -36,13 +36,18 @@ main = do let conf = AffectionConfig { initComponents = All , windowTitle = "affection: example01" - , windowConfig = SDL.defaultWindow - { SDL.windowOpenGL = Just SDL.defaultOpenGL - { SDL.glProfile = SDL.Core SDL.Normal 3 3 + , 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 } - , SDL.windowInitialSize = SDL.V2 600 600 - , SDL.windowResizable = True - } + ) + ] , initScreenMode = SDL.Windowed , canvasSize = Nothing , loadState = load diff --git a/examples/example02/Main.hs b/examples/example02/Main.hs index 7a32bb2..028e4ad 100644 --- a/examples/example02/Main.hs +++ b/examples/example02/Main.hs @@ -39,13 +39,18 @@ main = do let conf = AffectionConfig { initComponents = All , windowTitle = "affection: example01" - , windowConfig = SDL.defaultWindow - { SDL.windowOpenGL = Just SDL.defaultOpenGL - { SDL.glProfile = SDL.Core SDL.Normal 3 3 + , 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 } - , SDL.windowInitialSize = SDL.V2 600 600 - , SDL.windowResizable = True - } + ) + ] , initScreenMode = SDL.Windowed , canvasSize = Nothing , loadState = load diff --git a/src/Affection.hs b/src/Affection.hs index bcfc44c..3d79aae 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -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" diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index 32210de..9cc11e7 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -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) diff --git a/src/Affection/Util.hs b/src/Affection/Util.hs index f8e13a7..6c35fdf 100644 --- a/src/Affection/Util.hs +++ b/src/Affection/Util.hs @@ -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) From b7e776f8239daa5f6a06562ebf36431e021ca4e9 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 23 Apr 2019 23:52:01 +0200 Subject: [PATCH 2/2] hey! I'm ignoring you! --- .gitignore | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.gitignore b/.gitignore index df67c56..fa507cf 100644 --- a/.gitignore +++ b/.gitignore @@ -11,3 +11,8 @@ dist/ *.hp *.ps *.swp +.ghc* +cabal.project.local* +dist*/ +report.html +*.bak