1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
implementation module Gtk.Widgets
import StdEnv
import StdMaybe
import Control.Monad
import Data.Functor
import Data.Tuple
import System.FilePath
import System._Pointer
import Gtk
import Gtk.Internal
:: GtkBox :== Pointer
instance gtkWidget GtkBox where gtkWidget b = b
instance gtkContainer GtkBox where gtkContainer b = b
newBox :: !GtkOrientation !Int -> GtkM GtkBox
newBox orientation spacing =
toStateR (gtk_box_new orientation=:Vertical spacing) >>=
show
packBox :: !GtkBox !GtkDirection !GtkExpand !w -> GtkM w | gtkWidget w
packBox box direction expand widget =
toState (if direction=:StartToEnd gtk_box_pack_start gtk_box_pack_end
box (gtkWidget widget) expand=:Expand True 0) >>|
pure widget
:: GtkContainer :== Pointer
instance gtkWidget GtkContainer where gtkWidget c = c
instance gtkContainer GtkContainer where gtkContainer c = c
instance ptr GtkContainer
where
toPtr c = c
fromPtr c = c
addToContainer :: !c !w -> GtkM w | gtkWidget w & gtkContainer c
addToContainer container widget =
toState (gtk_container_add (gtkContainer container) (gtkWidget widget)) >>|
pure widget
:: GtkDialog :== Pointer
instance gtkWidget GtkDialog where gtkWidget d = d
instance gtkContainer GtkDialog where gtkContainer d = d
instance gtkDialog GtkDialog where gtkDialog d = d
instance ptr GtkDialog
where
toPtr d = d
fromPtr d = d
runDialog :: !d -> GtkM GtkResponse | gtkDialog d
runDialog dialog = fromInt <$> toStateR (gtk_dialog_run (gtkDialog dialog))
getFileWithDialog :: !GtkWindow !GtkFileChooserAction !(Maybe String) -> GtkM (Maybe FilePath)
getFileWithDialog window action title =
toStateR (gtk_file_chooser_dialog_new title window (toInt action) buttons) >>= \dialog ->
toState (gtk_dialog_set_default_response dialog (toInt ResponseAccept)) >>|
run dialog
where
buttons = map (\(s,r) -> (s,toInt r)) case action of
OpenAction -> [("Cancel", ResponseCancel), ("Open", ResponseAccept)]
SaveAction -> [("Cancel", ResponseCancel), ("Save", ResponseAccept)]
SelectFolderAction -> [("Cancel", ResponseCancel), ("Select", ResponseAccept)]
CreateFolderAction -> [("Cancel", ResponseCancel), ("Create", ResponseAccept)]
run dialog =
runDialog dialog >>= \response -> case response of
ResponseAccept ->
toStateR (gtk_file_chooser_get_filename dialog) >>= \file_name -> case file_name of
Just _ -> destroy dialog >>| pure file_name
Nothing -> run dialog
_ ->
destroy dialog >>|
pure Nothing
:: GtkFrame :== Pointer
instance gtkWidget GtkFrame where gtkWidget f = f
instance gtkContainer GtkFrame where gtkContainer f = f
newFrame :: !GtkLabel !w -> GtkM GtkFrame | gtkWidget w
newFrame label widget =
toStateR (gtk_frame_new (case label of Label l -> Just l; _ -> Nothing)) >>= \frame ->
(case label of
Label _ -> toState (gtk_frame_set_label_align frame 0.02 0.5)
NoLabel -> pure ()) >>|
addToContainer frame widget >>|
show frame
framed :: !GtkLabel !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w
framed label widgetf =
widgetf >>= \widget ->
tuple widget <$> newFrame label widget
:: GtkMenu :== Pointer
instance gtkWidget GtkMenu where gtkWidget m = m
newMenu :: GtkM GtkMenu
newMenu = toStateR gtk_menu_new >>= show
:: GtkMenuBar :== Pointer
instance gtkWidget GtkMenuBar where gtkWidget mb = mb
newMenuBar :: GtkM GtkMenuBar
newMenuBar = toStateR gtk_menu_bar_new >>= show
:: GtkMenuItem :== Pointer
instance gtkWidget GtkMenuItem where gtkWidget mi = mi
newMenuItem :: !String -> GtkM GtkMenuItem
newMenuItem label =
toStateR gtk_menu_item_new >>= \item ->
toState (gtk_menu_item_set_label item label) >>|
toState (gtk_menu_item_set_use_underline item True) >>|
show item
setSubMenu :: !GtkMenuItem !GtkMenu -> GtkM GtkMenu
setSubMenu item menu =
toState (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 (gtk_menu_shell_append (gtkMenuShell shell) item) >>|
pure item
:: GtkPaned :== Pointer
instance gtkWidget GtkPaned where gtkWidget p = p
instance gtkContainer GtkPaned where gtkContainer p = p
newPaned :: !GtkOrientation !GtkPanedHandleWidth -> GtkM GtkPaned
newPaned orientation handle_width =
toStateR (gtk_paned_new orientation=:Vertical) >>= \paned ->
toState (gtk_paned_set_wide_handle paned handle_width=:WideHandle) >>|
show paned
packPane1 :: !GtkPaned !GtkResize !GtkShrink !w -> GtkM w | gtkWidget w
packPane1 paned resize shrink widget =
toState (gtk_paned_pack1 paned (gtkWidget widget) resize=:Resize shrink=:Shrink) >>|
pure widget
packPane2 :: !GtkPaned !GtkResize !GtkShrink !w -> GtkM w | gtkWidget w
packPane2 paned resize shrink widget =
toState (gtk_paned_pack2 paned (gtkWidget widget) resize=:Resize shrink=:Shrink) >>|
pure widget
:: GtkScrolledWindow :== Pointer
instance gtkWidget GtkScrolledWindow where gtkWidget sw = sw
instance gtkContainer GtkScrolledWindow where gtkContainer sw = sw
newScrolledWindow :: GtkM GtkScrolledWindow
newScrolledWindow = toStateR (gtk_scrolled_window_new 0 0) >>= show
:: GtkTextBuffer :== Pointer
insertAtCursor :: !String !GtkTextBuffer -> GtkM ()
insertAtCursor s buffer = toState (gtk_text_buffer_insert_at_cursor buffer s (size s))
setText :: !String !GtkTextBuffer -> GtkM ()
setText s buffer = toState (gtk_text_buffer_set_text buffer s (size s))
:: GtkTextView :== Pointer
instance gtkWidget GtkTextView where gtkWidget tv = tv
instance gtkContainer GtkTextView where gtkContainer tv = tv
newTextView :: GtkM GtkTextView
newTextView =
toStateR gtk_text_view_new >>= \text_view ->
toState (gtk_text_view_set_editable text_view False) >>|
show text_view
getTextBuffer :: !GtkTextView -> GtkTextBuffer
getTextBuffer text_view = gtk_text_view_get_buffer text_view
:: GtkWidget :== Pointer
instance gtkWidget GtkWidget where gtkWidget w = w
instance ptr GtkWidget
where
toPtr w = w
fromPtr w = w
show :: !w -> GtkM w | gtkWidget w
show widget = toState (gtk_widget_show (gtkWidget widget)) >>| pure widget
destroy :: !w -> GtkM () | gtkWidget w
destroy widget = toState (gtk_widget_destroy (gtkWidget widget))
addCSSClass :: !GtkCSSClass !w -> GtkM w | gtkWidget w
addCSSClass (Class cls) widget =
toStateR (gtk_widget_get_style_context (gtkWidget widget)) >>= \context ->
toState (gtk_style_context_add_class context cls) >>|
pure widget
removeCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w
removeCSSClass (Class cls) widget =
toStateR (gtk_widget_get_style_context (gtkWidget widget)) >>= \context ->
toState (gtk_style_context_remove_class context cls)
setMargins :: !GtkMargins !w -> GtkM w | gtkWidget w
setMargins {left,top,right,bottom} widget` =
let widget = gtkWidget widget` in
toState (gtk_widget_set_margin_left widget left) >>|
toState (gtk_widget_set_margin_top widget top) >>|
toState (gtk_widget_set_margin_right widget right) >>|
toState (gtk_widget_set_margin_bottom widget bottom) >>|
pure widget`
:: GtkWindow :== Pointer
instance gtkWidget GtkWindow where gtkWidget w = w
instance gtkContainer GtkWindow where gtkContainer w = w
newPopup :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow
newPopup title size = new_window_or_popup True title size
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)) -> GtkM GtkWindow
new_window_or_popup is_popup title size =
toStateR (gtk_window_new is_popup) >>= \window ->
toState (gtk_window_set_title window title) >>|
(case size of
Nothing -> pure ()
Just (h,v) -> toState (gtk_widget_set_size_request window h v)) >>|
show window
// NB: it is also possible to attach CSS to one widget in particular (excluding
// children widgets). You then use gtk_widget_get_style_context and gtk_style_
// context_add_provider instead of gtk_widget_get_screen and gtk_style_context_
// add_provider_for_screen. This functionality has not been added to this
// library yet, but there is no reason to not provide it. To be clear that this
// style is global, we only allow it on GtkWindow, even though it would work on
// any GtkWidget.
addCSSFromFile :: !GtkStylePriority !FilePath !GtkWindow -> GtkM Bool
addCSSFromFile priority path window =
toStateR gtk_css_provider_new >>= \provider ->
toStateR (gtk_css_provider_load_from_path provider path 0) >>= \ok
| not ok -> pure ok
| otherwise ->
toStateR (gtk_widget_get_screen window) >>= \screen ->
toState (gtk_style_context_add_provider_for_screen screen provider (toInt priority)) >>|
pure True
|
