From 20fdcc7e09795c229eba3ce3579ea1dd19f97f2f Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Sun, 20 Oct 2019 15:55:58 +0200 Subject: Add synonym type GtkM a :== State GtkState a --- src/Gtk/State.dcl | 10 ++++++---- src/Gtk/State.icl | 8 ++++---- src/Gtk/Widgets.dcl | 28 ++++++++++++++-------------- src/Gtk/Widgets.icl | 30 +++++++++++++++--------------- 4 files changed, 39 insertions(+), 37 deletions(-) diff --git a/src/Gtk/State.dcl b/src/Gtk/State.dcl index d750900..81373e2 100644 --- a/src/Gtk/State.dcl +++ b/src/Gtk/State.dcl @@ -18,11 +18,13 @@ from Gtk.Signal import :: GSignalHandlerInternal , signal_counter :: !Int } +:: GtkM a :== State GtkState a + newGtkState :: GtkState -runGtk :: !(State GtkState a) !*World -> (!a, !*World) +runGtk :: !(GtkM a) !*World -> (!a, !*World) -toState :: !(A.a: a -> a) -> State GtkState () -toStateR :: !(A.a: a -> (r,a)) -> State GtkState r +toState :: !(A.a: a -> a) -> GtkM () +toStateR :: !(A.a: a -> (r,a)) -> GtkM r -quit :: State GtkState () +quit :: GtkM () diff --git a/src/Gtk/State.icl b/src/Gtk/State.icl index 16312b2..9d81b9a 100644 --- a/src/Gtk/State.icl +++ b/src/Gtk/State.icl @@ -21,7 +21,7 @@ newGtkState = , signal_counter = 0 } -runGtk :: !(State GtkState a) !*World -> (!a, !*World) +runGtk :: !(GtkM a) !*World -> (!a, !*World) runGtk f w = (evalState wrapped_f newGtkState, w) where wrapped_f = @@ -47,11 +47,11 @@ where run handler = case handler of GSHI_Void st -> st >>| handle_signals -toState :: !(A.a: a -> a) -> State GtkState () +toState :: !(A.a: a -> a) -> GtkM () toState f = state \st -> let w = f st.world in ((), {st & world=w}) -toStateR :: !(A.a: a -> (r,a)) -> State GtkState r +toStateR :: !(A.a: a -> (r,a)) -> GtkM r toStateR f = state \st -> let (r,w) = f st.world in (r, {st & world=w}) -quit :: State GtkState () +quit :: GtkM () quit = modify \st -> {st & return=True} diff --git a/src/Gtk/Widgets.dcl b/src/Gtk/Widgets.dcl index 791796e..ee290c4 100644 --- a/src/Gtk/Widgets.dcl +++ b/src/Gtk/Widgets.dcl @@ -4,7 +4,7 @@ from StdMaybe import :: Maybe from System._Pointer import :: Pointer -from Gtk.State import :: State, :: StateT, :: Identity, :: GtkState +from Gtk.State import :: State, :: StateT, :: Identity, :: GtkState, :: GtkM from Gtk.Types import :: GtkDirection, :: GtkExpand, :: GtkLabel, :: GtkMargins, :: GtkOrientation, :: GtkPanedHandleWidth, :: GtkResize, :: GtkShrink @@ -18,7 +18,7 @@ class gtkWidget a :: !a -> GtkWidget instance gtkWidget GtkWidget instance ptr GtkWidget -setMargins :: !GtkMargins !w -> State GtkState () | gtkWidget w +setMargins :: !GtkMargins !w -> GtkM () | gtkWidget w :: GtkContainer @@ -27,44 +27,44 @@ class gtkContainer a :: !a -> GtkContainer instance gtkWidget GtkContainer instance gtkContainer GtkContainer -addToContainer :: !w !c -> State GtkState () | gtkWidget w & gtkContainer c +addToContainer :: !w !c -> GtkM () | gtkWidget w & gtkContainer c :: GtkBox instance gtkWidget GtkBox instance gtkContainer GtkBox -newBox :: !GtkOrientation !Int -> State GtkState GtkBox -packBox :: !w !GtkBox !GtkDirection !GtkExpand -> State GtkState () | gtkWidget w +newBox :: !GtkOrientation !Int -> GtkM GtkBox +packBox :: !w !GtkBox !GtkDirection !GtkExpand -> GtkM () | gtkWidget w :: GtkFrame instance gtkWidget GtkFrame instance gtkContainer GtkFrame -newFrame :: !GtkLabel !w -> State GtkState GtkFrame | gtkWidget w -framed :: !GtkLabel !(State GtkState w) -> State GtkState (w, GtkFrame) | gtkWidget w +newFrame :: !GtkLabel !w -> GtkM GtkFrame | gtkWidget w +framed :: !GtkLabel !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w :: GtkPaned instance gtkWidget GtkPaned instance gtkContainer GtkPaned -newPaned :: !GtkOrientation !GtkPanedHandleWidth -> State GtkState GtkPaned -packPane1 :: !w !GtkPaned !GtkResize !GtkShrink -> State GtkState () | gtkWidget w -packPane2 :: !w !GtkPaned !GtkResize !GtkShrink -> State GtkState () | gtkWidget w +newPaned :: !GtkOrientation !GtkPanedHandleWidth -> GtkM GtkPaned +packPane1 :: !w !GtkPaned !GtkResize !GtkShrink -> GtkM () | gtkWidget w +packPane2 :: !w !GtkPaned !GtkResize !GtkShrink -> GtkM () | gtkWidget w :: GtkTextBuffer -insertAtCursor :: !String !GtkTextBuffer -> State GtkState () +insertAtCursor :: !String !GtkTextBuffer -> GtkM () :: GtkTextView instance gtkWidget GtkTextView instance gtkContainer GtkTextView -newTextView :: State GtkState GtkTextView +newTextView :: GtkM GtkTextView getTextBuffer :: !GtkTextView -> GtkTextBuffer :: GtkWindow instance gtkWidget GtkWindow instance gtkContainer GtkWindow -newPopup :: !String !(Maybe (Int,Int)) -> State GtkState GtkWindow -newWindow :: !String !(Maybe (Int,Int)) -> State GtkState GtkWindow +newPopup :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow +newWindow :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl index 1a56764..ba0ed6d 100644 --- a/src/Gtk/Widgets.icl +++ b/src/Gtk/Widgets.icl @@ -19,7 +19,7 @@ import Gtk.Types instance gtkWidget GtkWidget where gtkWidget w = w instance ptr GtkWidget where ptr w = w -setMargins :: !GtkMargins !w -> State GtkState () | gtkWidget w +setMargins :: !GtkMargins !w -> GtkM () | gtkWidget w setMargins {left,top,right,bottom} widget` = let widget = gtkWidget widget` in toState ('I'.gtk_widget_set_margin_left widget left) >>| @@ -27,7 +27,7 @@ setMargins {left,top,right,bottom} widget` = toState ('I'.gtk_widget_set_margin_right widget right) >>| toState ('I'.gtk_widget_set_margin_bottom widget bottom) -show :: !w -> State GtkState w | gtkWidget w +show :: !w -> GtkM w | gtkWidget w show widget = toState ('I'.gtk_widget_show (gtkWidget widget)) >>| pure widget :: GtkContainer :== Pointer @@ -35,7 +35,7 @@ show widget = toState ('I'.gtk_widget_show (gtkWidget widget)) >>| pure widget instance gtkWidget GtkContainer where gtkWidget c = c instance gtkContainer GtkContainer where gtkContainer c = c -addToContainer :: !w !c -> State GtkState () | gtkWidget w & gtkContainer c +addToContainer :: !w !c -> GtkM () | gtkWidget w & gtkContainer c addToContainer widget container = toState ('I'.gtk_container_add (gtkContainer container) (gtkWidget widget)) @@ -44,12 +44,12 @@ addToContainer widget container = instance gtkWidget GtkBox where gtkWidget b = b instance gtkContainer GtkBox where gtkContainer b = b -newBox :: !GtkOrientation !Int -> State GtkState GtkBox +newBox :: !GtkOrientation !Int -> GtkM GtkBox newBox orientation spacing = toStateR ('I'.gtk_box_new orientation=:Vertical spacing) >>= show -packBox :: !w !GtkBox !GtkDirection !GtkExpand -> State GtkState () | gtkWidget w +packBox :: !w !GtkBox !GtkDirection !GtkExpand -> GtkM () | gtkWidget w packBox widget box direction expand = toState (if direction=:StartToEnd 'I'.gtk_box_pack_start 'I'.gtk_box_pack_end box (gtkWidget widget) expand=:Expand True 0) @@ -59,7 +59,7 @@ packBox widget box direction expand = instance gtkWidget GtkFrame where gtkWidget f = f instance gtkContainer GtkFrame where gtkContainer f = f -newFrame :: !GtkLabel !w -> State GtkState GtkFrame | gtkWidget w +newFrame :: !GtkLabel !w -> GtkM GtkFrame | gtkWidget w newFrame label widget = toStateR ('I'.gtk_frame_new (case label of Label l -> Just l; _ -> Nothing)) >>= \frame -> (case label of @@ -68,7 +68,7 @@ newFrame label widget = addToContainer widget frame >>| show frame -framed :: !GtkLabel !(State GtkState w) -> State GtkState (w, GtkFrame) | gtkWidget w +framed :: !GtkLabel !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w framed label widgetf = widgetf >>= \widget -> tuple widget <$> newFrame label widget @@ -78,23 +78,23 @@ framed label widgetf = instance gtkWidget GtkPaned where gtkWidget p = p instance gtkContainer GtkPaned where gtkContainer p = p -newPaned :: !GtkOrientation !GtkPanedHandleWidth -> State GtkState GtkPaned +newPaned :: !GtkOrientation !GtkPanedHandleWidth -> GtkM GtkPaned newPaned orientation handle_width = toStateR ('I'.gtk_paned_new orientation=:Vertical) >>= \paned -> toState ('I'.gtk_paned_set_wide_handle paned handle_width=:WideHandle) >>| show paned -packPane1 :: !w !GtkPaned !GtkResize !GtkShrink -> State GtkState () | gtkWidget w +packPane1 :: !w !GtkPaned !GtkResize !GtkShrink -> GtkM () | gtkWidget w packPane1 widget paned resize shrink = toState ('I'.gtk_paned_pack1 paned (gtkWidget widget) resize=:Resize shrink=:Shrink) -packPane2 :: !w !GtkPaned !GtkResize !GtkShrink -> State GtkState () | gtkWidget w +packPane2 :: !w !GtkPaned !GtkResize !GtkShrink -> GtkM () | gtkWidget w packPane2 widget paned resize shrink = toState ('I'.gtk_paned_pack2 paned (gtkWidget widget) resize=:Resize shrink=:Shrink) :: GtkTextBuffer :== Pointer -insertAtCursor :: !String !GtkTextBuffer -> State GtkState () +insertAtCursor :: !String !GtkTextBuffer -> GtkM () insertAtCursor s buffer = toState ('I'.gtk_text_buffer_insert_at_cursor buffer s (size s)) :: GtkTextView :== Pointer @@ -102,7 +102,7 @@ insertAtCursor s buffer = toState ('I'.gtk_text_buffer_insert_at_cursor buffer s instance gtkWidget GtkTextView where gtkWidget tv = tv instance gtkContainer GtkTextView where gtkContainer tv = tv -newTextView :: State GtkState GtkTextView +newTextView :: GtkM GtkTextView newTextView = toStateR 'I'.gtk_text_view_new >>= \text_view -> toState ('I'.gtk_text_view_set_editable text_view False) >>| @@ -116,13 +116,13 @@ getTextBuffer text_view = 'I'.gtk_text_view_get_buffer text_view instance gtkWidget GtkWindow where gtkWidget w = w instance gtkContainer GtkWindow where gtkContainer w = w -newPopup :: !String !(Maybe (Int,Int)) -> State GtkState GtkWindow +newPopup :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow newPopup title size = new_window_or_popup True title size -newWindow :: !String !(Maybe (Int,Int)) -> State GtkState GtkWindow +newWindow :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow newWindow title size = new_window_or_popup False title size -new_window_or_popup :: !Bool !String !(Maybe (Int,Int)) -> State GtkState GtkWindow +new_window_or_popup :: !Bool !String !(Maybe (Int,Int)) -> GtkM GtkWindow new_window_or_popup is_popup title size = toStateR ('I'.gtk_window_new is_popup) >>= \window -> toState ('I'.gtk_window_set_title window title) >>| -- cgit v1.2.3