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
|
implementation module Gtk.Internal
import StdEnv
import StdMaybe
import System._Pointer
import code from "clean_gtk_support."
g_object_unref :: !Pointer !.a -> .a
g_object_unref p env = code {
ccall g_object_unref "p:V:A"
}
g_signal_connect_void :: !Pointer !String !Int !.a -> .a
g_signal_connect_void widget signal id env = connect widget (packString signal) id env
where
connect :: !Pointer !String !Int !.a -> .a
connect _ _ _ _ = code {
ccall clean_g_signal_connect_void "psI:V:A"
}
g_signal_pop :: !.a -> (!Maybe GSignalArgs, !.a)
g_signal_pop env
# (sig,env) = pop env
| sig == 0
= (Nothing, env)
# (id,sig) = readIntP sig (IF_INT_64_OR_32 8 4)
| sig == 0 // force evaluation
= abort "Internal error in g_signal_pop\n"
= (Just {sig_id=id}, env)
where
pop :: !.a -> (!Pointer, !.a)
pop env = code {
ccall clean_g_signal_pop ":p:A"
}
gtk_box_new :: !Bool !Int !.a -> (!Pointer, !.a)
gtk_box_new vertical spacing env = code {
ccall gtk_box_new "II:p:A"
}
gtk_box_pack_start :: !Pointer !Pointer !Bool !Bool !Int !.a -> .a
gtk_box_pack_start box child expand fill spacing env = code {
ccall gtk_box_pack_start "ppIII:V:A"
}
gtk_box_pack_end :: !Pointer !Pointer !Bool !Bool !Int !.a -> .a
gtk_box_pack_end box child expand fill spacing env = code {
ccall gtk_box_pack_end "ppIII:V:A"
}
gtk_container_add :: !Pointer !Pointer !.a -> .a
gtk_container_add container widget env = code {
ccall gtk_container_add "pp:V:A"
}
gtk_frame_new :: !(Maybe String) !.a -> (!Pointer, !.a)
gtk_frame_new Nothing env = new 0 env
where
new :: !Int !.a -> (!Pointer, !.a)
new _ _ = code {
ccall gtk_frame_new "p:p:A"
}
gtk_frame_new (Just label) env = new label env
where
new :: !String !.a -> (!Pointer, !.a)
new _ _ = code {
ccall gtk_frame_new "s:p:A"
}
// TODO: convert double to float properly
gtk_frame_set_label_align :: !Pointer !Real !Real !.a -> .a
gtk_frame_set_label_align frame xalign yalign env = code {
| cvtsd2ss %xmm0,%xmm0
instruction 242
instruction 15
instruction 90
instruction 192
| cvtsd2ss %xmm1,%xmm1
instruction 242
instruction 15
instruction 90
instruction 201
ccall gtk_frame_set_label_align "pRR:V:A"
}
gtk_init :: !.a -> .a
gtk_init env = init 0 0 env
where
init :: !Pointer !Pointer !.a -> .a
init argc argv env = code {
ccall gtk_init "pp:V:A"
}
gtk_main_iteration :: !.a -> (!Bool, !.a)
gtk_main_iteration env = code {
ccall gtk_main_iteration ":I:A"
}
gtk_main_quit :: !.a -> .a
gtk_main_quit env = code {
ccall gtk_main_quit ":V:A"
}
gtk_paned_new :: !Bool !.a -> (!Pointer, !.a)
gtk_paned_new vertical env = code {
ccall gtk_paned_new "I:p:A"
}
gtk_paned_pack1 :: !Pointer !Pointer !Bool !Bool !.a -> .a
gtk_paned_pack1 paned child resize shrink env = code {
ccall gtk_paned_pack1 "ppII:V:A"
}
gtk_paned_pack2 :: !Pointer !Pointer !Bool !Bool !.a -> .a
gtk_paned_pack2 paned child resize shrink env = code {
ccall gtk_paned_pack2 "ppII:V:A"
}
gtk_paned_set_wide_handle :: !Pointer !Bool !.a -> .a
gtk_paned_set_wide_handle paned setting env = code {
ccall gtk_paned_set_wide_handle "pI:V:A"
}
gtk_text_buffer_insert_at_cursor :: !Pointer !String !Int !.a -> .a
gtk_text_buffer_insert_at_cursor buffer string len env = code {
ccall gtk_text_buffer_insert_at_cursor "psI:V:A"
}
gtk_text_view_new :: !.a -> (!Pointer, !.a)
gtk_text_view_new env = code {
ccall gtk_text_view_new ":p:A"
}
gtk_text_view_get_buffer :: !Pointer -> Pointer
gtk_text_view_get_buffer text_view = code {
ccall gtk_text_view_get_buffer "p:p"
}
gtk_text_view_set_editable :: !Pointer !Bool !.a -> .a
gtk_text_view_set_editable text_view setting env = code {
ccall gtk_text_view_set_editable "pI:V:A"
}
gtk_widget_set_margin_bottom :: !Pointer !Int !.a -> .a
gtk_widget_set_margin_bottom widget padding env = code {
ccall gtk_widget_set_margin_bottom "pI:V:A"
}
gtk_widget_set_margin_left :: !Pointer !Int !.a -> .a
gtk_widget_set_margin_left widget padding env = code {
ccall gtk_widget_set_margin_left "pI:V:A"
}
gtk_widget_set_margin_right :: !Pointer !Int !.a -> .a
gtk_widget_set_margin_right widget padding env = code {
ccall gtk_widget_set_margin_right "pI:V:A"
}
gtk_widget_set_margin_top :: !Pointer !Int !.a -> .a
gtk_widget_set_margin_top widget padding env = code {
ccall gtk_widget_set_margin_top "pI:V:A"
}
gtk_widget_set_size_request :: !Pointer !Int !Int !.a -> .a
gtk_widget_set_size_request widget hsize vsize env = code {
ccall gtk_widget_set_size_request "pII:V:A"
}
gtk_widget_show :: !Pointer !.a -> .a
gtk_widget_show widget env = code {
ccall gtk_widget_show "p:V:A"
}
gtk_window_new :: !Bool !.a -> (!Pointer, !.a)
gtk_window_new is_popup env = code {
ccall gtk_window_new "I:p:A"
}
gtk_window_set_title :: !Pointer !String !.a -> .a
gtk_window_set_title window title env = set window (packString title) env
where
set :: !Pointer !String !.a -> .a
set _ _ _ = code {
ccall gtk_window_set_title "ps:V:A"
}
|
