moffy-samples-gtk3-run 0.1.0.4 → 0.1.0.6

raw patch · 5 files changed

+35/−3 lines, 5 files

Files

• moffy-samples-gtk3-run.cabal +2/−1
• src/Control/Moffy/Samples/Run/Gtk3.hs +10/−1
• src/Stopgap/Graphics/UI/Gdk/Window.hsc +14/−0
• src/Stopgap/Graphics/UI/Gtk/Widget.hsc +8/−1
• src/Stopgap/Graphics/UI/Gtk/Window.hsc +1/−0

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           moffy-samples-gtk3-run-version:        0.1.0.4+version:        0.1.0.6 synopsis:       Package to run moffy samples - GTK3 version description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/moffy-samples-gtk3-run#readme> category:       Control@@ -34,6 +34,7 @@       Stopgap.Graphics.UI.Gdk.Event       Stopgap.Graphics.UI.Gdk.Event.Button       Stopgap.Graphics.UI.Gdk.Event.Motion+      Stopgap.Graphics.UI.Gdk.Window       Stopgap.Graphics.UI.Gtk       Stopgap.Graphics.UI.Gtk.Container       Stopgap.Graphics.UI.Gtk.DrawingArea

@@ -48,6 +48,7 @@ import Stopgap.Graphics.UI.Gdk.Event qualified as Gdk.Event import Stopgap.Graphics.UI.Gdk.Event.Button qualified as Gdk.Event.Button import Stopgap.Graphics.UI.Gdk.Event.Motion qualified as Gdk.Event.Motion+import Stopgap.Graphics.UI.Gdk.Window qualified as Gdk.Window  type Events = CalcTextExtents :- 	Mouse.Move :- Mouse.Down :- Mouse.Up :- Singleton DeleteEvent@@ -89,6 +90,9 @@ movePoint :: Gdk.Event.Motion.M -> Point movePoint em = (Gdk.Event.Motion.mX em, Gdk.Event.Motion.mY em) +deleteHandle :: a -> b -> IO Bool+deleteHandle x y = pure False+ runSingleWin :: 	TChan (EvReqs Events) -> TChan (EvOccs Events) -> TChan View -> IO () runSingleWin cer ceo cv = do@@ -98,6 +102,7 @@ 	join $ Gtk.init <$> getProgName <*> getArgs  	w <- Gtk.Window.new Gtk.Window.Toplevel+	G.Signal.connect_ab_bool w "delete-event" deleteHandle Null 	G.Signal.connect_void_void w "destroy" Gtk.mainQuit Null  	da <- Gtk.DrawingArea.new@@ -128,7 +133,11 @@  	forkIO . forever $ atomically (readTChan cv) >>= \case 		Stopped -> void $ G.idleAdd-			(\_ -> Gtk.Window.close w >> Gtk.mainQuit >> pure False)+			(\_ -> do+				Gtk.Window.close w+				Gdk.Window.destroy =<< Gtk.Widget.getWindow w+				Gtk.mainQuit+				pure False) 			Null 		View v -> do 			atomically $ writeTVar crd v

@@ -0,0 +1,14 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Graphics.UI.Gdk.Window where++import Foreign.Ptr++data WTag++newtype W = W (Ptr WTag) deriving Show++destroy :: W -> IO ()+destroy = c_gdk_window_destroy++foreign import ccall "gdk_window_destroy" c_gdk_window_destroy :: W -> IO ()

@@ -6,6 +6,7 @@ import Foreign.Ptr import Stopgap.System.GLib.Object qualified as G.Object import Stopgap.Graphics.UI.Gdk.Event qualified as Gdk.Event+import Stopgap.Graphics.UI.Gdk.Window qualified as Gdk.Window  class G.Object.IsO w => IsW w where toW :: w -> W @@ -24,8 +25,14 @@ foreign import ccall "gtk_widget_add_events" c_gtk_widget_add_events :: 	W -> Gdk.Event.Mask -> IO () -queueDraw :: IsW w => w ->IO ()+queueDraw :: IsW w => w -> IO () queueDraw = c_gtk_widget_queue_draw . toW  foreign import ccall "gtk_widget_queue_draw" c_gtk_widget_queue_draw :: 	W -> IO ()++getWindow :: IsW w => w -> IO Gdk.Window.W+getWindow = c_gtk_widget_get_window . toW++foreign import ccall "gtk_widget_get_window" c_gtk_widget_get_window ::+	W -> IO Gdk.Window.W

@@ -13,6 +13,7 @@ import Stopgap.System.GLib.Object qualified as G.Object import Stopgap.Graphics.UI.Gtk.Widget qualified as Widget import Stopgap.Graphics.UI.Gtk.Container qualified as Container+import Stopgap.Graphics.UI.Gdk.Window qualified as Gdk.Window  #include <gtk/gtk.h>