Started MeshMaker rewrite.

2 files changed, 105 insertions, 0 deletions

diff --git a/MeshMaker.hs b/MeshMaker.hs
new file mode 100644
index 0000000..36ea2db
--- /dev/null
+++ b/MeshMaker.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE LambdaCase       #-}
+{-# LANGUAGE OverloadedLabels #-}
+module MeshMaker where
+
+import Control.Monad
+import Data.Coerce
+import Data.IORef
+import Foreign.C.Types
+import GI.Gdk
+import GI.GObject.Functions
+import GI.Gtk
+
+data MeshMaker = MeshMaker
+    { mmWidget   :: GLArea
+    , mmRealized :: IORef (Maybe State)
+    }
+
+data State = State
+    {
+    }
+
+new :: IO GLArea
+new = do
+    w <- gLAreaNew
+    ref <- newIORef Nothing
+    let st = MeshMaker w ref
+    -- _ <- on w #createContext $ onCreateContext st
+    _ <- on w #realize   $ onRealize st
+    _ <- on w #unrealize $ onUnrealize st
+    return w
+
+onRealize :: MeshMaker -> IO ()
+onRealize mm@(MeshMaker w ref) = do
+    readIORef ref >>= \case
+        Just st -> onUnrealize mm -- Shouldn't happen.
+        Nothing -> return ()
+    writeIORef ref $ Just State
+        {
+        }
+
+onUnrealize :: MeshMaker -> IO ()
+onUnrealize (MeshMaker w ref) = do
+    readIORef ref >>= \case
+        Just st -> do
+            return ()
+        Nothing -> return () -- Shouldn't happen.
+    writeIORef ref Nothing
+
+
+onRender :: MeshMaker -> GLContext -> IO Bool
+onRender (MeshMaker w ref) gl = do
+    return True
+
+onScroll :: MeshMaker -> EventScroll -> IO Bool
+onScroll (MeshMaker w ref) ev = do
+    dx <- get ev #deltaX
+    dy <- get ev #deltaY
+    x <- get ev #x
+    y <- get ev #y
+    y_root <- get ev #yRoot
+    d <- get ev #direction
+    -- onScroll! ((0.0,0.0),(11.057525634765625,5.210357666015625),79.21035766601563)
+    putStrLn $ "onScroll! " ++ show (d,(dx,dy),(x,y),y_root)
+    return True
+
+onTouch :: MeshMaker -> Event -> IO Bool
+onTouch (MeshMaker w ref) ev = do
+    putStrLn $ "onTouch!"
+    return True
+
+onMotion :: MeshMaker -> EventMotion -> IO Bool
+onMotion (MeshMaker w ref) ev = do
+    return True
diff --git a/mainObj2.hs b/mainObj2.hs
new file mode 100644
index 0000000..6195950
--- /dev/null
+++ b/mainObj2.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import GI.Gtk as Gtk hiding (main)
+import qualified GI.Gtk as Gtk
+import GI.GObject.Functions
+import GI.GObject.Flags
+import Data.GI.Base.GType
+
+import Foreign.Ptr
+
+import qualified MeshMaker
+
+
+main = do
+    _ <- Gtk.init Nothing
+
+    let mkChild = MeshMaker.new
+
+    window <- do
+        w <- windowNew WindowTypeToplevel
+        windowSetDefaultSize    w 720 720
+        windowSetTitle          w "Mesh Maker"
+        _ <- on w #deleteEvent $ \_ -> mainQuit >> return True
+        child <- mkChild
+        containerAdd w child
+        return w
+
+    widgetShowAll window
+    Gtk.main
+