Updated gix family of demos.

1 files changed, 12 insertions, 1 deletions

diff --git a/Triangle.hs b/Triangle.hs
index 175446c..1a7a58e 100644
--- a/Triangle.hs
+++ b/Triangle.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE QuasiQuotes, LambdaCase #-}
 module Triangle where
 
+import Data.GI.Base.ManagedPtr (newManagedPtr)
 import Graphics.Rendering.OpenGL as GL
 import GI.Gtk as Gtk
 import GI.Gdk.Objects
@@ -115,3 +116,13 @@ realize svar w = do
 unrealize :: MVar State -> GLArea -> IO ()
 unrealize _ _ = do
     putStrLn "unrealize!"
+
+createContext :: MVar State -> GLArea -> IO GLContext
+createContext st glarea = do
+    st <- readMVar st
+    widgetGetWindow glarea >>= \case
+        Just win -> windowCreateGlContext win
+        Nothing  -> do
+            putStrLn "createContext: GLArea has no window."
+            mptr <- newManagedPtr nullPtr (return ())
+            return $ GLContext mptr