packages feed

moffy-samples-gtk3-run (empty) → 0.1.0.0

raw patch · 22 files changed

+1060/−0 lines, 22 filesdep +basedep +c-enumdep +c-structsetup-changed

Dependencies added: base, c-enum, c-struct, containers, moffy, moffy-samples-events, moffy-samples-gtk3-run, random, simple-cairo, simple-pango, stm, text, time, type-flip, type-set, union-color

Files

+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog for `moffy-samples-gtk3-run`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Yoshikuni Jujo (c) 2023++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Yoshikuni Jujo nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# moffy-samples-gtk3-run
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ moffy-samples-gtk3-run.cabal view
@@ -0,0 +1,100 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name:           moffy-samples-gtk3-run+version:        0.1.0.0+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+homepage:       https://github.com/YoshikuniJujo/moffy-samples-gtk3-run#readme+bug-reports:    https://github.com/YoshikuniJujo/moffy-samples-gtk3-run/issues+author:         Yoshikuni Jujo+maintainer:     yoshikuni.jujo@gmail.com+copyright:      Copyright (c) 2023 Yoshikuni Jujo+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/YoshikuniJujo/moffy-samples-gtk3-run++library+  exposed-modules:+      Control.Moffy.Samples.Boxes.Run.Gtk3+      Control.Moffy.Samples.Followbox.Run.Gtk3+      Control.Moffy.Samples.Run.Gtk3+      Stopgap.Data.Ptr+      Stopgap.Graphics.UI.Gdk.Event+      Stopgap.Graphics.UI.Gdk.Event.Button+      Stopgap.Graphics.UI.Gdk.Event.Motion+      Stopgap.Graphics.UI.Gtk+      Stopgap.Graphics.UI.Gtk.Container+      Stopgap.Graphics.UI.Gtk.DrawingArea+      Stopgap.Graphics.UI.Gtk.Widget+      Stopgap.Graphics.UI.Gtk.Window+      Stopgap.System.GLib+      Stopgap.System.GLib.Callback+      Stopgap.System.GLib.Object+      Stopgap.System.GLib.Signal+  other-modules:+      Paths_moffy_samples_gtk3_run+  autogen-modules:+      Paths_moffy_samples_gtk3_run+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  pkgconfig-depends:+      gtk+-3.0+  build-depends:+      base >=4.7 && <5+    , c-enum+    , c-struct+    , containers+    , moffy+    , moffy-samples-events+    , random+    , simple-cairo+    , simple-pango+    , stm+    , text+    , time+    , type-flip+    , type-set+    , union-color+  default-language: Haskell2010++test-suite moffy-samples-gtk3-run-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_moffy_samples_gtk3_run+  autogen-modules:+      Paths_moffy_samples_gtk3_run+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , c-enum+    , c-struct+    , containers+    , moffy+    , moffy-samples-events+    , moffy-samples-gtk3-run+    , random+    , simple-cairo+    , simple-pango+    , stm+    , text+    , time+    , type-flip+    , type-set+    , union-color+  default-language: Haskell2010
+ src/Control/Moffy/Samples/Boxes/Run/Gtk3.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Moffy.Samples.Boxes.Run.Gtk3 where++import Prelude hiding (until)++import Control.Monad+import Control.Concurrent+import Control.Concurrent.STM hiding (retry)+import Data.Maybe+import Data.Type.Set+import Data.Type.Flip+import Data.Time.Clock.System+import Data.Color++import Control.Moffy+import Control.Moffy.Event.Time+import Control.Moffy.Handle+import Control.Moffy.Handle.Time+import Control.Moffy.Samples.Event.Delete+import Control.Moffy.Samples.Event.Mouse qualified as Mouse+import Control.Moffy.Samples.Event.CalcTextExtents+import Control.Moffy.Samples.Handle.TChan+import Control.Moffy.Samples.View qualified as V+import Control.Moffy.Samples.Run.TChan+import Control.Moffy.Samples.Boxes.Viewable++import Control.Moffy.Samples.Run.Gtk3++runBoxes bxs = runBoxes_ $ boxesToView <$%> (emit [] >> bxs)++runBoxes_ :: forall s es r . (+	Adjustable+		(Merge es (Singleton DeleteEvent))+		(CalcTextExtents :- Mouse.Move :- Mouse.Down :- Mouse.Up :- DeltaTime :- TryWait :- DeleteEvent :- 'Nil),+	Firstable es (Singleton DeleteEvent) (ISig s (es :+: Singleton DeleteEvent) V.View r) () ) =>+	Sig s es V.View r -> IO ()+runBoxes_ b = do+	er <- atomically newTChan+	eo <- atomically newTChan+	v <- atomically newTChan+	void $ forkIO do+		now <- systemToTAITime <$> getSystemTime+		void . ($ (InitialMode, now)) $ interpretSt+			(retrySt . ($ (0.05, ())) . popInput . handleTimeEvPlus . pushInput . const . liftHandle' . sleepIfNothing 50000+				$ handleNew @(CalcTextExtents :- Mouse.Move :- Mouse.Down :- Mouse.Up :- Singleton DeleteEvent) er eo) v do+			b `until` deleteEvent :: Sig s (Merge es (Singleton DeleteEvent)) V.View (Either r (V.View, ()))+			emit V.Stopped+	runSingleWin er eo v++boxesToView :: [Box] -> V.View+boxesToView = V.View . (boxToView1 <$>)++boxToView1 :: Box -> V.View1+boxToView1 (Box (Rect lu rd) c) = V.Box lu rd $ bColorToColor c++bColorToColor :: BColor -> Rgb Double+bColorToColor = fromJust . \case+	Red -> rgbDouble 0.8 0.1 0.05+	Green -> rgbDouble 0.2 0.6 0.1+	Blue -> rgbDouble 0.2 0.2 0.8+	Yellow -> rgbDouble 0.8 0.7 0.1+	Cyan -> rgbDouble 0.2 0.6 0.6+	Magenta -> rgbDouble 0.5 0.2 0.4
+ src/Control/Moffy/Samples/Followbox/Run/Gtk3.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Moffy.Samples.Followbox.Run.Gtk3 (+	runFollowbox, runFollowbox' ) where++import Prelude hiding (break)++import Control.Arrow+import Control.Monad+import Control.Moffy+import Control.Moffy.Samples.Event.Delete+import Control.Moffy.Samples.Event.CalcTextExtents+import Control.Moffy.Samples.Handle.TChan+import Control.Moffy.Samples.Run.TChan+import Control.Concurrent+import Control.Concurrent.STM+import Data.Type.Set ((:-), (:+:), pattern Nil)+import Data.Type.Flip+import Data.Color+import System.Random++import Control.Moffy.Samples.Followbox.Event+import Control.Moffy.Samples.Followbox.Handle+import Control.Moffy.Samples.Followbox.TypeSynonym++import Control.Moffy.Samples.Run.Gtk3++import Control.Moffy.Samples.View++import Control.Moffy.Samples.Followbox.ViewType qualified as T+import Control.Moffy.Samples.Viewable.Text+import Control.Moffy.Samples.Viewable.Image+import Control.Moffy.Samples.Viewable.Shape+import Data.OneOfThem++import Data.Map qualified as M+import Control.Moffy.Samples.Event.Area qualified as A++runFollowbox :: String -> Sig s FollowboxEv T.View () -> IO ()+runFollowbox brws sig = runFollowbox_ brws Nothing . void+	$ viewToView <$%> sig `break` deleteEvent `break` checkTerminate++runFollowbox' :: String -> Sig s FollowboxEv ([(Int, Maybe Area)], T.View) () -> IO ()+runFollowbox' brws sig = runFollowbox_' brws Nothing $ (second viewToView) <$%> sig++runFollowbox_ :: String -> Maybe GithubNameToken -> Sig s FollowboxEv View () -> IO ()+runFollowbox_ brws tkn sig = do+	va <- atomically $ newTVar M.empty+	(cer, ceo, cv) <- atomically $+		(,,) <$> newTChan <*> newTChan <*> newTChan+	_ <- forkIO $ runFollowboxGen cer ceo va brws tkn cv (sig >> emit Stopped)+	runSingleWin cer ceo cv++runFollowbox_' :: String -> Maybe GithubNameToken -> Sig s FollowboxEv ([(Int, Maybe Area)], View) () -> IO ()+runFollowbox_' brws tkn sig = do+	va <- atomically $ newTVar M.empty+	(cer, ceo, cv) <- atomically $+		(,,) <$> newTChan <*> newTChan <*> newTChan+	_ <- forkIO $ runFollowboxGen' cer ceo va brws tkn cv (sig >> emit ([], Stopped))+	runSingleWin cer ceo cv++runFollowboxGen ::+	TChan (EvReqs (CalcTextExtents :- GuiEv)) -> TChan (EvOccs (CalcTextExtents :- GuiEv)) ->+	TVar (M.Map Int (A.Point, A.Point)) -> String ->+	Maybe GithubNameToken -> TChan x -> Sig s FollowboxEv x r -> IO r+runFollowboxGen cr c va brs mgnt c' s = do+	(r, _) <- interpretSt (handleFollowbox va (cr, c) brs mgnt) c' s (initialFollowboxState $ mkStdGen 8)+	pure r++type Area = (Point, Point)++runFollowboxGen' ::+	TChan (EvReqs (CalcTextExtents :- GuiEv)) -> TChan (EvOccs (CalcTextExtents :- GuiEv)) ->+	TVar (M.Map Int (A.Point, A.Point)) -> String ->+	Maybe GithubNameToken -> TChan x ->+	Sig s FollowboxEv ([(Int, Maybe Area)], x) r -> IO r+runFollowboxGen' cr c va brs mgnt c' s = do+	(r, _) <- interpretSt' (handleFollowbox va (cr, c) brs mgnt) va c' s (initialFollowboxState $ mkStdGen 8)+	pure r++handleFollowbox :: TVar (M.Map Int (A.Point, A.Point)) ->+	(TChan (EvReqs (CalcTextExtents :- GuiEv)), TChan (EvOccs (CalcTextExtents :- GuiEv))) -> Browser ->+	Maybe GithubNameToken -> HandleF IO (CalcTextExtents :- GuiEv :+: FollowboxEv)+handleFollowbox va f = handleFollowboxWith (uncurry . handle) f va++viewToView :: T.View -> View+viewToView (T.View vs) = View $ (view1ToView1 `apply`) <$> vs++view1ToView1 :: OneOfThemFun (VText :- Line :- Image :- 'Nil) View1+view1ToView1 =+	(\(Line' (T.Color r g b) lw p0 p1) ->+		VLine (RgbWord8 r g b) lw p0 p1) >--+	(\(T.Text' (T.Color r g b) fn fs p txt) ->+		VText (RgbWord8 r g b) fn fs p txt) >-- SingletonFun+	(\(T.Image' p (T.Png w h dt)) -> VImage p w h dt)
+ src/Control/Moffy/Samples/Run/Gtk3.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase, OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Moffy.Samples.Run.Gtk3 (runSingleWin) where++import Control.Monad+import Control.Monad.ST+import Control.Concurrent+import Control.Concurrent.STM+import Data.Type.Set+import Data.OneOrMore qualified as OOM+import Data.OneOrMoreApp+import Data.Bits+import Data.Maybe+import Data.Text qualified as T+import Data.Color+import System.Environment++import Control.Moffy+import Control.Moffy.Samples.Event.Delete+import Control.Moffy.Samples.Event.Mouse qualified as Mouse+import Control.Moffy.Samples.Event.CalcTextExtents+import Control.Moffy.Samples.View++import Data.CairoContext+import Graphics.Cairo.Drawing.CairoT+import Graphics.Cairo.Drawing.Paths+import Graphics.Cairo.Drawing.Transformations+import Graphics.Cairo.Surfaces.ImageSurfaces+import Graphics.Cairo.Surfaces.PngSupport++import Graphics.Pango.Basic.LayoutObjects.PangoLayout+import Graphics.Pango.Basic.Fonts.PangoFontDescription+import Graphics.Pango.Basic.GlyphStorage+import Graphics.Pango.Rendering.Cairo++import Stopgap.Data.Ptr+import Stopgap.System.GLib qualified as G+import Stopgap.System.GLib.Signal qualified as G.Signal+import Stopgap.Graphics.UI.Gtk qualified as Gtk+import Stopgap.Graphics.UI.Gtk.Widget qualified as Gtk.Widget+import Stopgap.Graphics.UI.Gtk.Container qualified as Gtk.Container+import Stopgap.Graphics.UI.Gtk.Window qualified as Gtk.Window+import Stopgap.Graphics.UI.Gtk.DrawingArea qualified as Gtk.DrawingArea+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++type Events = CalcTextExtents :-+	Mouse.Move :- Mouse.Down :- Mouse.Up :- Singleton DeleteEvent++clicked :: TChan (EvOccs Events) ->+	Gtk.DrawingArea.D -> Gdk.Event.Button.B -> ud -> IO Bool+clicked ceo _da eb _ud = do+	case Gdk.Event.Button.bType eb of+		Gdk.Event.ButtonPress -> atomically . writeTChan ceo+			$ expand (Mouse.OccMove (mousePoint eb) >- Singleton (Mouse.OccDown $ mouseButton eb) :: EvOccs (Mouse.Move :- Singleton Mouse.Down))+		_ -> pure ()+	pure True++released :: TChan (EvOccs Events) ->+	Gtk.DrawingArea.D -> Gdk.Event.Button.B -> ud -> IO Bool+released ceo _da eb _ud = do+	case Gdk.Event.Button.bType eb of+		Gdk.Event.ButtonRelease -> atomically . writeTChan ceo+			$ expand (Mouse.OccMove (mousePoint eb) >- Singleton (Mouse.OccUp $ mouseButton eb) :: EvOccs (Mouse.Move :- Singleton Mouse.Up))+		_ -> pure ()+	pure True++moved :: TChan (EvOccs Events) ->+	Gtk.DrawingArea.D -> Gdk.Event.Motion.M -> ud -> IO Bool+moved ceo _da em _ud = do+	atomically . writeTChan ceo . expand . Singleton . Mouse.OccMove $ movePoint em+	pure True++mouseButton :: Gdk.Event.Button.B -> Mouse.Button+mouseButton eb = case Gdk.Event.Button.bButton eb of+	1 -> Mouse.ButtonPrimary+	2 -> Mouse.ButtonMiddle+	3 -> Mouse.ButtonSecondary+	_ -> Mouse.ButtonMiddle++mousePoint :: Gdk.Event.Button.B -> Point+mousePoint eb = (Gdk.Event.Button.bX eb, Gdk.Event.Button.bY eb)++movePoint :: Gdk.Event.Motion.M -> Point+movePoint em = (Gdk.Event.Motion.mX em, Gdk.Event.Motion.mY em)++runSingleWin ::+	TChan (EvReqs Events) -> TChan (EvOccs Events) -> TChan View -> IO ()+runSingleWin cer ceo cv = do+	crd <- atomically $ newTVar []+	cte <- atomically newTChan++	join $ Gtk.init <$> getProgName <*> getArgs++	w <- Gtk.Window.new Gtk.Window.Toplevel+	G.Signal.connect_void_void w "destroy" Gtk.mainQuit Null++	da <- Gtk.DrawingArea.new+	Gtk.Container.add w da+	Gtk.Widget.addEvents da $+		Gdk.Event.ButtonPressMask .|.+		Gdk.Event.ButtonReleaseMask .|.+		Gdk.Event.ButtonMotionMask+	G.Signal.connect_self_button_ud+		da "button-press-event" (clicked ceo) Null+	G.Signal.connect_self_button_ud+		da "button-release-event" (released ceo) Null+	G.Signal.connect_self_motion_ud+		da "motion-notify-event" (moved ceo) Null+	G.Signal.connect_self_cairo_ud da "draw" (drawFunction crd ceo cte) Null++	Gtk.Widget.showAll w++	forkIO . forever $ atomically (readTChan cer) >>= \r -> do+		case OOM.project r of+			Nothing -> pure ()+			Just (CalcTextExtentsReq fn fs t) -> do+				atomically $ writeTChan cte (fn, fs, t)+				void $ G.idleAdd+					(\_ -> Gtk.Widget.queueDraw da >>+						pure False)+					Null++	forkIO . forever $ atomically (readTChan cv) >>= \case+		Stopped -> void $ G.idleAdd+			(\_ -> Gtk.mainQuit >> pure False) Null+		View v -> do+			atomically $ writeTVar crd v+			void $ G.idleAdd+				(\_ -> Gtk.Widget.queueDraw da >> pure False)+				Null+		v -> print v++	Gtk.main++drawFunction :: TVar [View1] ->+	TChan (EvOccs Events) -> TChan (FontName, FontSize, T.Text) ->+	Gtk.DrawingArea.D -> CairoT r RealWorld -> Null -> IO Bool+drawFunction crd ceo cte _ cr Null = do+	atomically (tryReadTChan cte) >>= \case+		Nothing -> pure ()+		Just (fn, fs, txt) -> occCalcTextExtents ceo cr fn fs txt+	cairoSetSourceRgb cr . fromJust $ rgbDouble 0.5 0.5 0.5+	cairoPaint cr+	(drawView1 cr `mapM_`) =<< atomically (readTVar crd)+	pure False++drawView1 :: CairoT r RealWorld -> View1 -> IO ()+drawView1 cr (Box+	(realToFrac -> l, realToFrac -> u)+	(realToFrac -> r, realToFrac -> d)+	(rgbRealToFrac -> clr)) = do+	cairoSetSourceRgb cr clr+	cairoRectangle cr l u (r - l) (d - u)+	cairoFill cr+drawView1 cr (VLine (rgbRealToFrac -> clr) lw+	(realToFrac -> l, realToFrac -> u)+	(realToFrac -> r, realToFrac -> d)) = do+	cairoSetSourceRgb cr clr+	cairoSetLineWidth cr $ realToFrac lw+	cairoMoveTo cr l u+	cairoLineTo cr r d+	cairoStroke cr+drawView1 cr (VText (rgbRealToFrac -> clr)+	fn (realToFrac -> fs) (realToFrac -> x, realToFrac -> y) txt) = do+	(l, d) <- (,) <$> pangoCairoCreateLayout cr <*> pangoFontDescriptionNew+	d `pangoFontDescriptionSet` Family fn+	d `pangoFontDescriptionSet` AbsoluteSize fs+	d' <- pangoFontDescriptionFreeze d+	l `pangoLayoutSet` pangoFontDescriptionToNullable (Just d')+	l `pangoLayoutSet` txt+	l' <- pangoLayoutFreeze l+	cairoMoveTo cr x y+	cairoSetSourceRgb cr clr+	pangoCairoShowLayout cr l'+drawView1 cr (VImage+	(realToFrac -> x, realToFrac -> y) w h dt) = do+	sfc <- cairoSurfaceCreateFromPngByteString dt+	w0 <- cairoImageSurfaceGetWidth sfc+	h0 <- cairoImageSurfaceGetHeight sfc+	cairoTranslate cr x y+	cairoScale cr+		(realToFrac w / fromIntegral w0)+		(realToFrac h / fromIntegral h0)+	cairoSetSourceSurface cr sfc 0 0+	cairoPaint cr++	cairoIdentityMatrix cr+drawView1 cr NotImplemented = putStrLn "NOT IMPLEMENTED"++occCalcTextExtents ::+	TChan (EvOccs (CalcTextExtents :- GuiEv)) -> CairoT r RealWorld -> String -> Double -> T.Text -> IO ()+occCalcTextExtents co cr fn fs txt = do+	(l, d) <- (,) <$> pangoCairoCreateLayout cr <*> pangoFontDescriptionNew+	d `pangoFontDescriptionSet` Family fn+	d `pangoFontDescriptionSet` AbsoluteSize (realToFrac fs)+	d' <- pangoFontDescriptionFreeze d+	l `pangoLayoutSet` pangoFontDescriptionToNullable (Just d')+	l `pangoLayoutSet` txt+	l' <- pangoLayoutFreeze l+	let	PixelExtents ie le = pangoLayoutInfo l'+	atomically . writeTChan co . expand . Singleton+		. OccCalcTextExtents fn fs txt+		$ mkte ie le+	where+	mkte ie le = TextExtents (r2r ie) (r2r le)+	r2r r = rct+		(pangoRectanglePixelX r) (pangoRectanglePixelY r)+		(pangoRectanglePixelWidth r) (pangoRectanglePixelHeight r)+	rct	(fromIntegral -> l) (fromIntegral -> t)+		(fromIntegral -> w) (fromIntegral -> h) = Rectangle l t w h++type GuiEv = Mouse.Move :- Mouse.Down :- Mouse.Up :- Singleton DeleteEvent
+ src/Stopgap/Data/Ptr.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Data.Ptr where++import Foreign.Ptr++class IsPtr a where+	type Tag a+	toPtr :: a -> Ptr (Tag a)+	fromPtr :: Ptr (Tag a) -> a++data Null = Null++instance IsPtr Null where+	type Tag Null = Null+	toPtr Null = nullPtr+	fromPtr _ = Null
+ src/Stopgap/Graphics/UI/Gdk/Event.hsc view
@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Graphics.UI.Gdk.Event where++import Foreign.Storable+import Foreign.C.Enum+import Data.Bits+import Data.Word+import Data.Int++#include <gtk/gtk.h>++enum "Mask" ''#{type GdkEventMask} [''Show, ''Read, ''Eq, ''Bits] [+	("ExposureMask", #{const GDK_EXPOSURE_MASK}),+	("PointerMotionMask", #{const GDK_POINTER_MOTION_MASK}),+	("PointerMotionHintMask", #{const GDK_POINTER_MOTION_HINT_MASK}),+	("ButtonMotionMask", #{const GDK_BUTTON_MOTION_MASK}),+	("Button1MotionMask", #{const GDK_BUTTON1_MOTION_MASK}),+	("Button2MotionMask", #{const GDK_BUTTON2_MOTION_MASK}),+	("Button3MotionMask", #{const GDK_BUTTON3_MOTION_MASK}),+	("ButtonPressMask", #{const GDK_BUTTON_PRESS_MASK}),+	("ButtonReleaseMask", #{const GDK_BUTTON_RELEASE_MASK}),+	("KeyPressMask", #{const GDK_KEY_PRESS_MASK}),+	("KeyReleaseMask", #{const GDK_KEY_RELEASE_MASK}),+	("EnterNotifyMask", #{const GDK_ENTER_NOTIFY_MASK}),+	("LeaveNotifyMask", #{const GDK_LEAVE_NOTIFY_MASK})+	]++enum "Type" ''#{type GdkEventType} [''Show, ''Read, ''Eq, ''Ord, ''Storable] [+	("Delete", #{const GDK_DELETE}),+	("MotionNotify", #{const GDK_MOTION_NOTIFY}),+	("ButtonPress", #{const GDK_BUTTON_PRESS}),+	("ButtonRelease", #{const GDK_BUTTON_RELEASE})+	]
+ src/Stopgap/Graphics/UI/Gdk/Event/Button.hsc view
@@ -0,0 +1,62 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Graphics.UI.Gdk.Event.Button where++import Foreign.Ptr+import Foreign.Storable+import Foreign.C.Struct+import Data.Word+import Data.Int++import Stopgap.Graphics.UI.Gdk.Event++#include <gtk/gtk.h>++data GdkWindowTag+data GdkDeviceTag++type PtrGdkWindow = Ptr GdkWindowTag+type PtrGdkDevice = Ptr GdkDeviceTag+type PtrGdouble = Ptr #{type gdouble}++struct "B" #{size GdkEventButton} #{alignment GdkEventButton}+	[	("type", ''Type,+			[| #{peek GdkEventButton, type} |],+			[| #{poke GdkEventButton, type} |]),+		("window", ''PtrGdkWindow,+			[| #{peek GdkEventButton, window} |],+			[| #{poke GdkEventButton, window} |]),+		("send_event", ''#{type gint8},+			[| #{peek GdkEventButton, send_event} |],+			[| #{poke GdkEventButton, send_event} |]),+		("time", ''#{type guint32},+			[| #{peek GdkEventButton, time} |],+			[| #{poke GdkEventButton, time} |]),+		("x", ''#{type gdouble},+			[| #{peek GdkEventButton, x} |],+			[| #{poke GdkEventButton, x} |]),+		("y", ''#{type gdouble},+			[| #{peek GdkEventButton, y} |],+			[| #{poke GdkEventButton, y} |]),+		("axes", ''PtrGdouble,+			[| #{peek GdkEventButton, axes} |],+			[| #{poke GdkEventButton, axes} |]),+		("state", ''#{type GdkModifierType},+			[| #{peek GdkEventButton, state} |],+			[| #{poke GdkEventButton, state} |]),+		("button", ''#{type guint},+			[| #{peek GdkEventButton, button} |],+			[| #{poke GdkEventButton, button} |]),+		("device", ''PtrGdkDevice,+			[| #{peek GdkEventButton, device} |],+			[| #{poke GdkEventButton, device} |]),+		("x_root", ''#{type gdouble},+			[| #{peek GdkEventButton, x_root} |],+			[| #{poke GdkEventButton, x_root} |]),+		("y_root", ''#{type gdouble},+			[| #{peek GdkEventButton, y_root} |],+			[| #{poke GdkEventButton, y_root} |]) ]+	[''Show, ''Eq, ''Ord, ''Storable]
+ src/Stopgap/Graphics/UI/Gdk/Event/Motion.hsc view
@@ -0,0 +1,62 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Graphics.UI.Gdk.Event.Motion where++import Foreign.Ptr+import Foreign.Storable+import Foreign.C.Struct+import Data.Word+import Data.Int++import Stopgap.Graphics.UI.Gdk.Event++#include <gtk/gtk.h>++data GdkWindowTag+data GdkDeviceTag++type PtrGdkWindow = Ptr GdkWindowTag+type PtrGdkDevice = Ptr GdkDeviceTag+type PtrGdouble = Ptr #{type gdouble}++struct "M" #{size GdkEventMotion} #{alignment GdkEventMotion}+	[	("type", ''Type,+			[| #{peek GdkEventMotion, type} |],+			[| #{poke GdkEventMotion, type} |]),+		("window", ''PtrGdkWindow,+			[| #{peek GdkEventMotion, window} |],+			[| #{poke GdkEventMotion, window} |]),+		("send_event", ''#{type gint8},+			[| #{peek GdkEventMotion, send_event} |],+			[| #{poke GdkEventMotion, send_event} |]),+		("time", ''#{type guint32},+			[| #{peek GdkEventMotion, time} |],+			[| #{poke GdkEventMotion, time} |]),+		("x", ''#{type gdouble},+			[| #{peek GdkEventMotion, x} |],+			[| #{poke GdkEventMotion, x} |]),+		("y", ''#{type gdouble},+			[| #{peek GdkEventMotion, y} |],+			[| #{poke GdkEventMotion, y} |]),+		("axes", ''PtrGdouble,+			[| #{peek GdkEventMotion, axes} |],+			[| #{poke GdkEventMotion, axes} |]),+		("state", ''#{type GdkModifierType},+			[| #{peek GdkEventMotion, state} |],+			[| #{poke GdkEventMotion, state} |]),+		("is_hint", ''#{type gint16},+			[| #{peek GdkEventMotion, is_hint} |],+			[| #{poke GdkEventMotion, is_hint} |]),+		("device", ''PtrGdkDevice,+			[| #{peek GdkEventMotion, device} |],+			[| #{poke GdkEventMotion, device} |]),+		("x_root", ''#{type gdouble},+			[| #{peek GdkEventMotion, x_root} |],+			[| #{poke GdkEventMotion, x_root} |]),+		("y_root", ''#{type gdouble},+			[| #{peek GdkEventMotion, y_root} |],+			[| #{poke GdkEventMotion, y_root} |]) ]+	[''Show, ''Eq, ''Ord, ''Storable]
+ src/Stopgap/Graphics/UI/Gtk.hsc view
@@ -0,0 +1,39 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Graphics.UI.Gtk where++import Foreign.Ptr+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String++init :: String -> [String] -> IO ()+init cmd as = withArgcArgv cmd as c_gtk_init++withArgcArgv :: String -> [String] -> (Ptr CInt -> Ptr (Ptr CString) -> IO a) -> IO a+withArgcArgv cmd as f = withCStringList (cmd : as) \cas ->+	withArrayLen cas \argc argv ->+		alloca \pargc -> alloca \pargv -> do+			poke pargc (fromIntegral argc)+			poke pargv argv+			f pargc pargv++withCStringList :: [String] -> ([CString] -> IO a) -> IO a+withCStringList [] f = f []+withCStringList (a : as) f =+	withCString a \ca -> withCStringList as \cas -> f $ ca : cas++foreign import ccall "gtk_init" c_gtk_init :: Ptr CInt -> Ptr (Ptr CString) -> IO ()++main :: IO ()+main = c_gtk_main++foreign import ccall "gtk_main" c_gtk_main :: IO ()++mainQuit :: IO ()+mainQuit = c_gtk_main_quit++foreign import ccall "gtk_main_quit" c_gtk_main_quit :: IO ()
+ src/Stopgap/Graphics/UI/Gtk/Container.hsc view
@@ -0,0 +1,19 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Graphics.UI.Gtk.Container where++import Foreign.Ptr+import Stopgap.Graphics.UI.Gtk.Widget qualified as Gtk.Widget++data CTag++newtype C = C (Ptr CTag) deriving Show++class Gtk.Widget.IsW c => IsC c where toC :: c -> C++add :: (IsC c, Gtk.Widget.IsW w) => c -> w -> IO ()+add c w = c_gtk_container_add (toC c) (Gtk.Widget.toW w)++foreign import ccall "gtk_container_add" c_gtk_container_add ::+	C -> Gtk.Widget.W -> IO ()
+ src/Stopgap/Graphics/UI/Gtk/DrawingArea.hsc view
@@ -0,0 +1,23 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Graphics.UI.Gtk.DrawingArea where++import Foreign.Ptr+import Stopgap.Data.Ptr+import Stopgap.System.GLib.Object qualified as G.Object+import Stopgap.Graphics.UI.Gtk.Widget qualified as Widget++data DTag++newtype D = D (Ptr DTag) deriving Show++instance IsPtr D where type Tag D = DTag; toPtr (D p) = p; fromPtr = D+instance G.Object.IsO D where toO (D p) = G.Object.O $ castPtr p+instance Widget.IsW D where toW (D p) = Widget.W $ castPtr p++new :: IO D+new = c_gtk_drawing_area_new++foreign import ccall "gtk_drawing_area_new" c_gtk_drawing_area_new :: IO D
+ src/Stopgap/Graphics/UI/Gtk/Widget.hsc view
@@ -0,0 +1,31 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Graphics.UI.Gtk.Widget where++import Foreign.Ptr+import Stopgap.System.GLib.Object qualified as G.Object+import Stopgap.Graphics.UI.Gdk.Event qualified as Gdk.Event++class G.Object.IsO w => IsW w where toW :: w -> W++data WTag++newtype W = W (Ptr WTag) deriving Show++showAll :: IsW w => w -> IO ()+showAll = c_gtk_widget_show_all . toW++foreign import ccall "gtk_widget_show_all" c_gtk_widget_show_all :: W -> IO ()++addEvents :: IsW w => w -> Gdk.Event.Mask -> IO ()+addEvents = c_gtk_widget_add_events . toW++foreign import ccall "gtk_widget_add_events" c_gtk_widget_add_events ::+	W -> Gdk.Event.Mask -> 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 ()
+ src/Stopgap/Graphics/UI/Gtk/Window.hsc view
@@ -0,0 +1,35 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.Graphics.UI.Gtk.Window where++import Foreign.Ptr+import Foreign.C.Enum+import Data.Word+import Stopgap.Data.Ptr+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++#include <gtk/gtk.h>++enum "Type" ''#{type GtkWindowType} [''Show, ''Read, ''Eq] [+	("Toplevel", #{const GTK_WINDOW_TOPLEVEL}),+	("Popup", #{const GTK_WINDOW_POPUP}) ]++data WTag++newtype W = W (Ptr WTag) deriving Show++instance IsPtr W where type Tag W = WTag; toPtr (W p) = p; fromPtr = W+instance G.Object.IsO W where toO (W p) = G.Object.O $ castPtr p+instance Widget.IsW W where toW (W p) = Widget.W $ castPtr p+instance Container.IsC W where toC (W p) = Container.C $ castPtr p++new :: Type -> IO W+new = c_gtk_window_new++foreign import ccall "gtk_window_new" c_gtk_window_new :: Type -> IO W
+ src/Stopgap/System/GLib.hsc view
@@ -0,0 +1,30 @@+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.System.GLib where++import Foreign.Ptr+import Data.Word+import Data.Int+import Stopgap.Data.Ptr++#include <gtk/gtk.h>++idleAdd :: IsPtr ud => (ud -> IO Bool) -> ud -> IO #{type guint}+idleAdd h ud = wrapHandler h >>= \ch -> c_g_idle_add ch $ toPtr ud++foreign import ccall "g_idle_add" c_g_idle_add ::+	FunPtr (Ptr ud -> IO #{type gboolean}) -> Ptr ud -> IO #{type guint}++wrapHandler :: IsPtr ud =>+	(ud -> IO Bool) -> IO (FunPtr (Ptr (Tag ud) -> IO #{type gboolean}))+wrapHandler h = do+	let	g pud = boolToGboolean <$> h (fromPtr pud)+	c_wrap_handler g++boolToGboolean :: Bool -> #{type gboolean}+boolToGboolean = \case False -> #{const FALSE}; True -> #{const TRUE}++foreign import ccall "wrapper" c_wrap_handler ::+	(Ptr ud -> IO #{type gboolean}) ->+	IO (FunPtr (Ptr ud -> IO #{type gboolean}))
+ src/Stopgap/System/GLib/Callback.hsc view
@@ -0,0 +1,98 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE CApiFFI #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.System.GLib.Callback where++import Foreign.Ptr+import Foreign.Concurrent+import Foreign.Storable+import Control.Monad.ST+import Data.Int+import Data.CairoContext+import Stopgap.Data.Ptr+import Stopgap.Graphics.UI.Gdk.Event.Button qualified as Gdk.Event.Button+import Stopgap.Graphics.UI.Gdk.Event.Motion qualified as Gdk.Event.Motion++#include <gtk/gtk.h>++data CTag++newtype C fun = C (FunPtr CTag) deriving Show++foreign import capi "gtk/gtk.h G_CALLBACK" c_G_CALLBACK :: FunPtr fun -> C fun++c_ab :: (IsPtr a, IsPtr b) =>+	(a -> b -> IO ()) -> IO (C (Ptr (Tag a) -> Ptr (Tag b) -> IO ()))+c_ab f = do+	let	f' x y = f (fromPtr x) (fromPtr y)+	c_G_CALLBACK <$> c_wrap_callback_ab f'++foreign import ccall "wrapper" c_wrap_callback_ab ::+	(Ptr a -> Ptr b -> IO ()) -> IO (FunPtr (Ptr a -> Ptr b -> IO ()))++c_ab_bool :: (IsPtr a, IsPtr b) =>+	(a -> b -> IO Bool) -> IO (C (Ptr (Tag a) -> Ptr (Tag b) -> IO #{type gboolean}))+c_ab_bool f = do+	let	f' x y = boolToGboolean <$> f (fromPtr x) (fromPtr y)+	c_G_CALLBACK <$> c_wrap_callback_ab_bool f'++boolToGboolean :: Bool -> #{type gboolean}+boolToGboolean = \case False -> #{const FALSE}; True -> #{const TRUE}++foreign import ccall "wrapper" c_wrap_callback_ab_bool ::+	(Ptr a -> Ptr b -> IO #{type gboolean}) ->+	IO (FunPtr (Ptr a -> Ptr b -> IO #{type gboolean}))++c_void_void :: IO () -> IO (C (IO ()))+c_void_void f = c_G_CALLBACK <$> c_wrap_callback_void_void f++foreign import ccall "wrapper" c_wrap_callback_void_void ::+	IO () -> IO (FunPtr (IO ()))++c_self_cairo_ud :: (IsPtr a, IsPtr b) =>+	(a -> CairoT r RealWorld -> b -> IO Bool) ->+	IO (C (	Ptr (Tag a) -> Ptr (CairoT r RealWorld) -> Ptr (Tag b) ->+		IO #{type gboolean}))+c_self_cairo_ud f = do+	let	f' x cr y = boolToGboolean <$> do+			cr' <- CairoT <$> newForeignPtr cr (pure ())+			f (fromPtr x) cr' (fromPtr y)+	c_G_CALLBACK <$> c_wrap_callback_self_cairo_ud f'++foreign import ccall "wrapper" c_wrap_callback_self_cairo_ud ::+	(Ptr a -> Ptr (CairoT r s) -> Ptr b -> IO #{type gboolean}) ->+	IO (FunPtr (Ptr a -> Ptr (CairoT r s) -> Ptr b -> IO #{type gboolean}))++c_self_button_ud :: (IsPtr a, IsPtr b) =>+	(a -> Gdk.Event.Button.B -> b -> IO Bool) ->+	IO (C (	Ptr (Tag a) -> Ptr Gdk.Event.Button.B -> Ptr (Tag b) ->+		IO #{type gboolean}))+c_self_button_ud f = do+	let	f' x eb y = boolToGboolean <$> do+			eb' <- peek eb+			f (fromPtr x) eb' (fromPtr y)+	c_G_CALLBACK <$> c_wrap_callback_self_button_ud f'++foreign import ccall "wrapper" c_wrap_callback_self_button_ud ::+	(Ptr a -> Ptr Gdk.Event.Button.B -> Ptr b -> IO #{type gboolean}) ->+	IO (FunPtr (+		Ptr a -> Ptr Gdk.Event.Button.B -> Ptr b ->+		IO #{type gboolean} ))++c_self_motion_ud :: (IsPtr a, IsPtr b) =>+	(a -> Gdk.Event.Motion.M -> b -> IO Bool) ->+	IO (C (	Ptr (Tag a) -> Ptr Gdk.Event.Motion.M -> Ptr (Tag b) ->+		IO #{type gboolean}))+c_self_motion_ud f = do+	let	f' x eb y = boolToGboolean <$> do+			eb' <- peek eb+			f (fromPtr x) eb' (fromPtr y)+	c_G_CALLBACK <$> c_wrap_callback_self_motion_ud f'++foreign import ccall "wrapper" c_wrap_callback_self_motion_ud ::+	(Ptr a -> Ptr Gdk.Event.Motion.M -> Ptr b -> IO #{type gboolean}) ->+	IO (FunPtr (+		Ptr a -> Ptr Gdk.Event.Motion.M -> Ptr b ->+		IO #{type gboolean} ))
+ src/Stopgap/System/GLib/Object.hsc view
@@ -0,0 +1,13 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.System.GLib.Object where++import Foreign.Ptr+import Stopgap.Data.Ptr++data OTag++newtype O = O (Ptr OTag) deriving Show++class IsPtr o => IsO o where toO :: o -> O
+ src/Stopgap/System/GLib/Signal.hsc view
@@ -0,0 +1,59 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE CApiFFI #-}+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Stopgap.System.GLib.Signal where++import Foreign.Ptr+import Foreign.C.String+import Control.Monad.ST+import Data.String+import Data.CairoContext+import Stopgap.Data.Ptr+import Stopgap.System.GLib.Object qualified as G.Object+import Stopgap.System.GLib.Callback qualified as G.Callback+import Stopgap.Graphics.UI.Gdk.Event.Button qualified as Gdk.Event.Button+import Stopgap.Graphics.UI.Gdk.Event.Motion qualified as Gdk.Event.Motion++newtype Signal = Signal String deriving Show++instance IsString Signal where fromString = Signal++connect_ab :: (G.Object.IsO a, IsPtr b) =>+	a -> Signal -> (a -> b -> IO ()) -> b -> IO ()+connect_ab o (Signal sig) h ud = withCString sig \csig -> do+	ch <- G.Callback.c_ab h+	c_g_signal_connect (toPtr o) csig ch (toPtr ud)++connect_ab_bool :: (G.Object.IsO a, IsPtr b) =>+	a -> Signal -> (a -> b -> IO Bool) -> b -> IO ()+connect_ab_bool o (Signal sig) h ud = withCString sig \csig -> do+	ch <- G.Callback.c_ab_bool h+	c_g_signal_connect (toPtr o) csig ch (toPtr ud)++connect_void_void :: G.Object.IsO a => a -> Signal -> IO () -> Null -> IO ()+connect_void_void o (Signal sig) h Null = withCString sig \csig -> do+	ch <- G.Callback.c_void_void h+	c_g_signal_connect (toPtr o) csig ch nullPtr++connect_self_cairo_ud :: (G.Object.IsO a, IsPtr b) =>+	a -> Signal -> (a -> CairoT r RealWorld -> b -> IO Bool) -> b -> IO ()+connect_self_cairo_ud o (Signal sig) h ud = withCString sig \csig -> do+	ch <- G.Callback.c_self_cairo_ud h+	c_g_signal_connect (toPtr o) csig ch (toPtr ud)++connect_self_button_ud :: (G.Object.IsO a, IsPtr b) =>+	a -> Signal -> (a -> Gdk.Event.Button.B -> b -> IO Bool) -> b -> IO ()+connect_self_button_ud o (Signal sig) h ud = withCString sig \csig -> do+	ch <- G.Callback.c_self_button_ud h+	c_g_signal_connect (toPtr o) csig ch (toPtr ud)++connect_self_motion_ud :: (G.Object.IsO a, IsPtr b) =>+	a -> Signal -> (a -> Gdk.Event.Motion.M -> b -> IO Bool) -> b -> IO ()+connect_self_motion_ud o (Signal sig) h ud = withCString sig \csig -> do+	ch <- G.Callback.c_self_motion_ud h+	c_g_signal_connect (toPtr o) csig ch (toPtr ud)++foreign import capi "gtk/gtk.h g_signal_connect" c_g_signal_connect ::+	Ptr a -> CString -> G.Callback.C fun -> Ptr b -> IO ()
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"