blob: e48536491e44a0e7159c07b545158d738e4fce5e (
plain) (
blame)
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
|
implementation module Gtk.Widgets
import StdEnv
import StdMaybe
import Control.Monad
import Control.Monad.Identity
import Control.Monad.State
import Data.Functor
import Data.Tuple
import System.FilePath
import System._Pointer
import qualified Gtk.Internal as I
import Gtk.State
import Gtk.Types
:: GtkWidget :== Pointer
instance gtkWidget GtkWidget where gtkWidget w = w
instance ptr GtkWidget
where
toPtr w = w
fromPtr w = w
addCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w
addCSSClass (Class cls) widget =
toStateR ('I'.gtk_widget_get_style_context (gtkWidget widget)) >>= \context ->
toState ('I'.gtk_style_context_add_class context cls)
removeCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w
removeCSSClass (Class cls) widget =
toStateR ('I'.gtk_widget_get_style_context (gtkWidget widget)) >>= \context ->
toState ('I'.gtk_style_context_remove_class context cls)
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) >>|
toState ('I'.gtk_widget_set_margin_top widget top) >>|
toState ('I'.gtk_widget_set_margin_right widget right) >>|
toState ('I'.gtk_widget_set_margin_bottom widget bottom)
show :: !w -> GtkM w | gtkWidget w
show widget = toState ('I'.gtk_widget_show (gtkWidget widget)) >>| pure widget
:: GtkContainer :== Pointer
instance gtkWidget GtkContainer where gtkWidget c = c
instance gtkContainer GtkContainer where gtkContainer c = c
addToContainer :: !w !c -> GtkM () | gtkWidget w & gtkContainer c
addToContainer widget container =
toState ('I'.gtk_container_add (gtkContainer container) (gtkWidget widget))
:: 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 ('I'.gtk_box_new orientation=:Vertical spacing) >>=
show
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)
:: 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 ('I'.gtk_frame_new (case label of Label l -> Just l; _ -> Nothing)) >>= \frame ->
(case label of
Label _ -> toState ('I'.gtk_frame_set_label_align frame 0.02 0.5)
NoLabel -> pure ()) >>|
addToContainer widget frame >>|
show frame
framed :: !GtkLabel !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w
framed label widgetf =
widgetf >>= \widget ->
tuple widget <$> newFrame label widget
:: 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 ('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 -> 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 -> 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 -> GtkM ()
insertAtCursor s buffer = toState ('I'.gtk_text_buffer_insert_at_cursor 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 'I'.gtk_text_view_new >>= \text_view ->
toState ('I'.gtk_text_view_set_editable text_view False) >>|
show text_view
getTextBuffer :: !GtkTextView -> GtkTextBuffer
getTextBuffer text_view = 'I'.gtk_text_view_get_buffer text_view
:: 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 ('I'.gtk_window_new is_popup) >>= \window ->
toState ('I'.gtk_window_set_title window title) >>|
(case size of
Nothing -> pure ()
Just (h,v) -> toState ('I'.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 'I'.gtk_css_provider_new >>= \provider ->
toStateR ('I'.gtk_css_provider_load_from_path provider path 0) >>= \ok
| not ok -> pure ok
| otherwise ->
toStateR ('I'.gtk_widget_get_screen window) >>= \screen ->
toState ('I'.gtk_style_context_add_provider_for_screen screen provider (toInt priority)) >>|
pure True
|
