From 353ef6e949d7375f9e70e0e004a42c56406f5d0d Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Mon, 21 Oct 2019 11:05:54 +0200 Subject: Add GtkMenu* functionality and reorder combinator arguments to ease binding --- src/Gtk/Internal.dcl | 11 ++++++++++ src/Gtk/Internal.icl | 38 +++++++++++++++++++++++++++++++++ src/Gtk/Widgets.dcl | 28 +++++++++++++++++++++++-- src/Gtk/Widgets.icl | 59 +++++++++++++++++++++++++++++++++++++++++++++------- 4 files changed, 127 insertions(+), 9 deletions(-) diff --git a/src/Gtk/Internal.dcl b/src/Gtk/Internal.dcl index 1b24e94..31a50c9 100644 --- a/src/Gtk/Internal.dcl +++ b/src/Gtk/Internal.dcl @@ -30,6 +30,17 @@ gtk_init :: !.a -> .a gtk_main_iteration :: !.a -> (!Bool, !.a) gtk_main_quit :: !.a -> .a +gtk_menu_bar_new :: !.a -> (!Pointer, !.a) + +gtk_menu_item_new :: !.a -> (!Pointer, !.a) +gtk_menu_item_set_label :: !Pointer !String !.a -> .a +gtk_menu_item_set_use_underline :: !Pointer !Bool !.a -> .a +gtk_menu_item_set_submenu :: !Pointer !Pointer !.a -> .a + +gtk_menu_new :: !.a -> (!Pointer, !.a) + +gtk_menu_shell_append :: !Pointer !Pointer !.a -> .a + gtk_paned_new :: !Bool !.a -> (!Pointer, !.a) gtk_paned_pack1 :: !Pointer !Pointer !Bool !Bool !.a -> .a gtk_paned_pack2 :: !Pointer !Pointer !Bool !Bool !.a -> .a diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl index 9bc0c7b..8f3a8ad 100644 --- a/src/Gtk/Internal.icl +++ b/src/Gtk/Internal.icl @@ -118,6 +118,44 @@ gtk_main_quit env = code { ccall gtk_main_quit ":V:A" } +gtk_menu_bar_new :: !.a -> (!Pointer, !.a) +gtk_menu_bar_new env = code { + ccall gtk_menu_bar_new ":p:A" +} + +gtk_menu_item_new :: !.a -> (!Pointer, !.a) +gtk_menu_item_new env = code { + ccall gtk_menu_item_new ":p:A" +} + +gtk_menu_item_set_label :: !Pointer !String !.a -> .a +gtk_menu_item_set_label item label env = set item (packString label) env +where + set :: !Pointer !String !.a -> .a + set _ _ _ = code { + ccall gtk_menu_item_set_label "ps:V:A" + } + +gtk_menu_item_set_use_underline :: !Pointer !Bool !.a -> .a +gtk_menu_item_set_use_underline item setting env = code { + ccall gtk_menu_item_set_use_underline "pI:V:A" +} + +gtk_menu_item_set_submenu :: !Pointer !Pointer !.a -> .a +gtk_menu_item_set_submenu item menu env = code { + ccall gtk_menu_item_set_submenu "pp:V:A" +} + +gtk_menu_new :: !.a -> (!Pointer, !.a) +gtk_menu_new env = code { + ccall gtk_menu_new ":p:A" +} + +gtk_menu_shell_append :: !Pointer !Pointer !.a -> .a +gtk_menu_shell_append shell item env = code { + ccall gtk_menu_shell_append "pp:V:A" +} + gtk_paned_new :: !Bool !.a -> (!Pointer, !.a) gtk_paned_new vertical env = code { ccall gtk_paned_new "I:p:A" diff --git a/src/Gtk/Widgets.dcl b/src/Gtk/Widgets.dcl index 42f65c1..ab5d5c8 100644 --- a/src/Gtk/Widgets.dcl +++ b/src/Gtk/Widgets.dcl @@ -35,14 +35,14 @@ instance gtkWidget GtkContainer instance gtkContainer GtkContainer instance ptr GtkContainer -addToContainer :: !w !c -> GtkM () | gtkWidget w & gtkContainer c +addToContainer :: !c !w -> GtkM w | gtkWidget w & gtkContainer c :: GtkBox instance gtkWidget GtkBox instance gtkContainer GtkBox newBox :: !GtkOrientation !Int -> GtkM GtkBox -packBox :: !w !GtkBox !GtkDirection !GtkExpand -> GtkM () | gtkWidget w +packBox :: !GtkBox !GtkDirection !GtkExpand !w -> GtkM w | gtkWidget w :: GtkFrame instance gtkWidget GtkFrame @@ -51,6 +51,30 @@ instance gtkContainer GtkFrame newFrame :: !GtkLabel !w -> GtkM GtkFrame | gtkWidget w framed :: !GtkLabel !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w +:: GtkMenu +instance gtkWidget GtkMenu + +newMenu :: GtkM GtkMenu + +:: GtkMenuBar +instance gtkWidget GtkMenuBar + +newMenuBar :: GtkM GtkMenuBar + +:: GtkMenuItem +instance gtkWidget GtkMenuItem + +newMenuItem :: !String -> GtkM GtkMenuItem +setSubMenu :: !GtkMenuItem !GtkMenu -> GtkM GtkMenu + +:: GtkMenuShell +instance gtkWidget GtkMenuShell + +class gtkMenuShell a :: !a -> GtkMenuShell +instance gtkMenuShell GtkMenu, GtkMenuBar, GtkMenuShell + +appendToMenuShell :: !s !GtkMenuItem -> GtkM GtkMenuItem | gtkMenuShell s + :: GtkPaned instance gtkWidget GtkPaned instance gtkContainer GtkPaned diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl index 0549c88..1ea63df 100644 --- a/src/Gtk/Widgets.icl +++ b/src/Gtk/Widgets.icl @@ -55,9 +55,10 @@ where toPtr c = c fromPtr c = c -addToContainer :: !w !c -> GtkM () | gtkWidget w & gtkContainer c -addToContainer widget container = - toState ('I'.gtk_container_add (gtkContainer container) (gtkWidget widget)) +addToContainer :: !c !w -> GtkM w | gtkWidget w & gtkContainer c +addToContainer container widget = + toState ('I'.gtk_container_add (gtkContainer container) (gtkWidget widget)) >>| + pure widget :: GtkBox :== Pointer @@ -69,10 +70,11 @@ newBox orientation spacing = toStateR ('I'.gtk_box_new orientation=:Vertical spacing) >>= show -packBox :: !w !GtkBox !GtkDirection !GtkExpand -> GtkM () | gtkWidget w -packBox widget box direction expand = +packBox :: !GtkBox !GtkDirection !GtkExpand !w -> GtkM w | gtkWidget w +packBox box direction expand widget = toState (if direction=:StartToEnd 'I'.gtk_box_pack_start 'I'.gtk_box_pack_end - box (gtkWidget widget) expand=:Expand True 0) + box (gtkWidget widget) expand=:Expand True 0) >>| + pure widget :: GtkFrame :== Pointer @@ -85,7 +87,7 @@ newFrame label widget = (case label of Label _ -> toState ('I'.gtk_frame_set_label_align frame 0.02 0.5) NoLabel -> pure ()) >>| - addToContainer widget frame >>| + addToContainer frame widget >>| show frame framed :: !GtkLabel !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w @@ -93,6 +95,49 @@ framed label widgetf = widgetf >>= \widget -> tuple widget <$> newFrame label widget +:: GtkMenu :== Pointer + +instance gtkWidget GtkMenu where gtkWidget m = m + +newMenu :: GtkM GtkMenu +newMenu = toStateR 'I'.gtk_menu_new >>= show + +:: GtkMenuBar :== Pointer + +instance gtkWidget GtkMenuBar where gtkWidget mb = mb + +newMenuBar :: GtkM GtkMenuBar +newMenuBar = toStateR 'I'.gtk_menu_bar_new >>= show + +:: GtkMenuItem :== Pointer + +instance gtkWidget GtkMenuItem where gtkWidget mi = mi + +newMenuItem :: !String -> GtkM GtkMenuItem +newMenuItem label = + toStateR 'I'.gtk_menu_item_new >>= \item -> + toState ('I'.gtk_menu_item_set_label item label) >>| + toState ('I'.gtk_menu_item_set_use_underline item True) >>| + show item + +setSubMenu :: !GtkMenuItem !GtkMenu -> GtkM GtkMenu +setSubMenu item menu = + toState ('I'.gtk_menu_item_set_submenu item menu) >>| + pure menu + +:: GtkMenuShell :== Pointer + +instance gtkWidget GtkMenuShell where gtkWidget ms = ms + +instance gtkMenuShell GtkMenu where gtkMenuShell m = m +instance gtkMenuShell GtkMenuBar where gtkMenuShell mb = mb +instance gtkMenuShell GtkMenuShell where gtkMenuShell ms = ms + +appendToMenuShell :: !s !GtkMenuItem -> GtkM GtkMenuItem | gtkMenuShell s +appendToMenuShell shell item = + toState ('I'.gtk_menu_shell_append (gtkMenuShell shell) item) >>| + pure item + :: GtkPaned :== Pointer instance gtkWidget GtkPaned where gtkWidget p = p -- cgit v1.2.3