Merge pull request #8 from nek0/multiwindow

Multiwindow

.gitignore

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

examples/example00/Main.hs

@@ -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

examples/example01/Main.hs

@@ -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

examples/example02/Main.hs

@@ -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

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"
+  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
-  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
   liftIO $ logIO Debug "Getting Time"
   -- get current time
@@ -71,11 +74,8 @@ withAffection AffectionConfig{..} = do
   initContainer <- (\x -> AffectionData
     { quitEvent       = False
     , userState       = x
-    , drawWindow      = window
+    , drawWindows     = windows
-    , glContext       = context
+    , glContext       = contexts
-    , drawDimensions  = case canvasSize of
-        Just (cw, ch) -> (cw, ch)
-        Nothing       -> (w, h)
     , 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
+  mapM_ (SDL.glDeleteContext . snd) contexts
-  SDL.destroyWindow window
+  mapM_ (SDL.destroyWindow . snd) windows
   -- SDL.quit -- <- This causes segfaults depending on hardware
   liftIO $ logIO Debug "This is the end"

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
+  , windowConfigs  ::
-      -- ^ Window configuration
+      [
+      ( 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
+  , 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
-  , 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)

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)