From 30ed903f316467a4daad0550b68d0a7739be2592 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Thu, 25 Apr 2019 23:47:55 -0400 Subject: Started MeshMaker rewrite. --- MeshMaker.hs | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ mainObj2.hs | 32 ++++++++++++++++++++++++++ 2 files changed, 105 insertions(+) create mode 100644 MeshMaker.hs create mode 100644 mainObj2.hs 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 + -- cgit v1.2.3