Bare-bones drawing widget.

1 files changed, 58 insertions, 0 deletions

diff --git a/Draw.hs b/Draw.hs
new file mode 100644
index 0000000..3377548
--- /dev/null
+++ b/Draw.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE LambdaCase #-}
+module Draw where
+
+import Control.Concurrent
+import Data.Int
+import Data.IORef
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import GI.Gdk.Objects
+import GI.Gtk
+import System.IO
+
+data Realized = Realized
+    {
+    }
+
+data State = State
+    { stRealized   :: MVar Realized
+    }
+
+initState :: IO State
+initState = do
+    r <- newEmptyMVar
+    return State
+        { stRealized = r
+        }
+
+realize :: State -> GLArea -> IO ()
+realize st glarea = gLAreaMakeCurrent glarea >> gLAreaGetError glarea >>= \me ->
+    maybe id (\e _ -> print e) me $ do
+    _ <- tryTakeMVar (stRealized st)
+    putMVar (stRealized st) $ Realized
+
+unrealize :: State -> GLArea -> IO ()
+unrealize st glarea = do
+    _ <- tryTakeMVar (stRealized st)
+    return ()
+
+onResize :: State -> GLArea -> Int32 -> Int32 -> IO ()
+onResize st glarea w h = do
+    return ()
+
+render :: State -> GLArea -> GLContext -> IO Bool
+render st glarea gl = do
+    return True
+
+createContext :: State -> GLArea -> IO GLContext
+createContext st glarea = do
+    widgetGetWindow glarea >>= \case
+        Just win -> windowCreateGlContext win
+        Nothing  -> do
+            oops "createContext: GLArea has no window."
+            fp <- newForeignPtr_ nullPtr
+            disown <- newIORef Nothing
+            return $ GLContext $ ManagedPtr fp disown
+
+oops :: String -> IO ()
+oops s = hPutStrLn stderr s