1package body agar.gui.widget.menu is
2
3  use type c.int;
4
5  package cbinds is
6    procedure expand
7      (menu : menu_access_t;
8       item : item_access_t;
9       x    : c.int;
10       y    : c.int);
11    pragma import (c, expand, "AG_MenuExpand");
12
13    procedure set_padding
14      (menu   : menu_access_t;
15       left   : c.int;
16       right  : c.int;
17       top    : c.int;
18       bottom : c.int);
19    pragma import (c, set_padding, "AG_MenuSetPadding");
20
21    procedure set_label_padding
22      (menu   : menu_access_t;
23       left   : c.int;
24       right  : c.int;
25       top    : c.int;
26       bottom : c.int);
27    pragma import (c, set_label_padding, "AG_MenuSetLabelPadding");
28
29    function node
30      (parent : item_access_t;
31       text   : cs.chars_ptr;
32       icon   : agar.gui.surface.surface_access_t) return item_access_t;
33    pragma import (c, node, "AG_MenuNode");
34
35    function action
36      (parent : item_access_t;
37       text   : cs.chars_ptr;
38       icon   : agar.gui.surface.surface_access_t;
39       func   : agar.core.event.callback_t;
40       fmt    : agar.core.types.void_ptr_t) return item_access_t;
41    pragma import (c, action, "AG_MenuAction");
42
43    function action_keyboard
44      (parent : item_access_t;
45       text   : cs.chars_ptr;
46       icon   : agar.gui.surface.surface_access_t;
47       key    : c.int;
48       modkey : c.int;
49       func   : agar.core.event.callback_t;
50       fmt    : agar.core.types.void_ptr_t) return item_access_t;
51    pragma import (c, action_keyboard, "AG_MenuActionKb");
52
53    function dynamic_item
54      (parent : item_access_t;
55       text   : cs.chars_ptr;
56       icon   : agar.gui.surface.surface_access_t;
57       func   : agar.core.event.callback_t;
58       fmt    : agar.core.types.void_ptr_t) return item_access_t;
59    pragma import (c, dynamic_item, "AG_MenuDynamicItem");
60
61    function dynamic_item_keyboard
62      (parent : item_access_t;
63       text   : cs.chars_ptr;
64       icon   : agar.gui.surface.surface_access_t;
65       key    : c.int;
66       modkey : c.int;
67       func   : agar.core.event.callback_t;
68       fmt    : agar.core.types.void_ptr_t) return item_access_t;
69    pragma import (c, dynamic_item_keyboard, "AG_MenuDynamicItemKb");
70
71    function toolbar_item
72      (parent  : item_access_t;
73       toolbar : agar.gui.widget.toolbar.toolbar_access_t;
74       text    : cs.chars_ptr;
75       icon    : agar.gui.surface.surface_access_t;
76       key     : c.int;
77       modkey  : c.int;
78       func    : agar.core.event.callback_t;
79       fmt     : agar.core.types.void_ptr_t) return item_access_t;
80    pragma import (c, toolbar_item, "AG_MenuTool");
81
82    procedure set_label
83      (item  : item_access_t;
84       label : cs.chars_ptr);
85    pragma import (c, set_label, "AG_MenuSetLabelS");
86
87    procedure set_poll_function
88      (item  : item_access_t;
89       func  : agar.core.event.callback_t;
90       fmt   : agar.core.types.void_ptr_t);
91    pragma import (c, set_poll_function, "AG_MenuSetPollFn");
92
93    function bind_bool
94      (item   : item_access_t;
95       text   : cs.chars_ptr;
96       icon   : agar.gui.surface.surface_access_t;
97       value  : access c.int;
98       invert : c.int) return item_access_t;
99    pragma import (c, bind_bool, "agar_gui_widget_menu_bool");
100
101    function bind_bool_with_mutex
102      (item   : item_access_t;
103       text   : cs.chars_ptr;
104       icon   : agar.gui.surface.surface_access_t;
105       value  : access c.int;
106       invert : c.int;
107       mutex  : agar.core.threads.mutex_t) return item_access_t;
108    pragma import (c, bind_bool_with_mutex, "AG_MenuIntBoolMp");
109
110    function bind_flags
111      (item   : item_access_t;
112       text   : cs.chars_ptr;
113       icon   : agar.gui.surface.surface_access_t;
114       value  : access mask_t;
115       flags  : mask_t;
116       invert : c.int) return item_access_t;
117    pragma import (c, bind_flags, "agar_gui_widget_menu_int_flags");
118
119    function bind_flags_with_mutex
120      (item   : item_access_t;
121       text   : cs.chars_ptr;
122       icon   : agar.gui.surface.surface_access_t;
123       value  : access mask_t;
124       flags  : mask_t;
125       invert : c.int;
126       mutex  : agar.core.threads.mutex_t) return item_access_t;
127    pragma import (c, bind_flags_with_mutex, "AG_MenuIntFlagsMp");
128
129    function bind_flags8
130      (item   : item_access_t;
131       text   : cs.chars_ptr;
132       icon   : agar.gui.surface.surface_access_t;
133       value  : access mask8_t;
134       flags  : mask8_t;
135       invert : c.int) return item_access_t;
136    pragma import (c, bind_flags8, "agar_gui_widget_menu_int_flags8");
137
138    function bind_flags8_with_mutex
139      (item   : item_access_t;
140       text   : cs.chars_ptr;
141       icon   : agar.gui.surface.surface_access_t;
142       value  : access mask8_t;
143       flags  : mask8_t;
144       invert : c.int;
145       mutex  : agar.core.threads.mutex_t) return item_access_t;
146    pragma import (c, bind_flags8_with_mutex, "AG_MenuInt8FlagsMp");
147
148    function bind_flags16
149      (item   : item_access_t;
150       text   : cs.chars_ptr;
151       icon   : agar.gui.surface.surface_access_t;
152       value  : access mask16_t;
153       flags  : mask16_t;
154       invert : c.int) return item_access_t;
155    pragma import (c, bind_flags16, "agar_gui_widget_menu_int_flags16");
156
157    function bind_flags16_with_mutex
158      (item   : item_access_t;
159       text   : cs.chars_ptr;
160       icon   : agar.gui.surface.surface_access_t;
161       value  : access mask16_t;
162       flags  : mask16_t;
163       invert : c.int;
164       mutex  : agar.core.threads.mutex_t) return item_access_t;
165    pragma import (c, bind_flags16_with_mutex, "AG_MenuInt16FlagsMp");
166
167    function bind_flags32
168      (item   : item_access_t;
169       text   : cs.chars_ptr;
170       icon   : agar.gui.surface.surface_access_t;
171       value  : access mask32_t;
172       flags  : mask32_t;
173       invert : c.int) return item_access_t;
174    pragma import (c, bind_flags32, "agar_gui_widget_menu_int_flags32");
175
176    function bind_flags32_with_mutex
177      (item   : item_access_t;
178       text   : cs.chars_ptr;
179       icon   : agar.gui.surface.surface_access_t;
180       value  : access mask32_t;
181       flags  : mask32_t;
182       invert : c.int;
183       mutex  : agar.core.threads.mutex_t) return item_access_t;
184    pragma import (c, bind_flags32_with_mutex, "AG_MenuInt32FlagsMp");
185
186    procedure section
187      (item : item_access_t;
188       text : cs.chars_ptr);
189    pragma import (c, section, "AG_MenuSectionS");
190  end cbinds;
191
192  procedure expand
193    (menu : menu_access_t;
194     item : item_access_t;
195     x    : natural;
196     y    : natural) is
197  begin
198    cbinds.expand
199      (menu => menu,
200       item => item,
201       x    => c.int (x),
202       y    => c.int (y));
203  end expand;
204
205  procedure set_padding
206    (menu   : menu_access_t;
207     left   : natural;
208     right  : natural;
209     top    : natural;
210     bottom : natural) is
211  begin
212    cbinds.set_padding
213      (menu   => menu,
214       left   => c.int (left),
215       right  => c.int (right),
216       top    => c.int (top),
217       bottom => c.int (bottom));
218  end set_padding;
219
220  procedure set_label_padding
221    (menu   : menu_access_t;
222     left   : natural;
223     right  : natural;
224     top    : natural;
225     bottom : natural) is
226  begin
227    cbinds.set_label_padding
228      (menu   => menu,
229       left   => c.int (left),
230       right  => c.int (right),
231       top    => c.int (top),
232       bottom => c.int (bottom));
233  end set_label_padding;
234
235  function node
236    (parent : item_access_t;
237     text   : string;
238     icon   : agar.gui.surface.surface_access_t) return item_access_t
239  is
240    ca_text : aliased c.char_array := c.to_c (text);
241  begin
242    return cbinds.node
243      (parent => parent,
244       text   => cs.to_chars_ptr (ca_text'unchecked_access),
245       icon   => icon);
246  end node;
247
248  function action
249    (parent : item_access_t;
250     text   : string;
251     icon   : agar.gui.surface.surface_access_t;
252     func   : agar.core.event.callback_t) return item_access_t
253  is
254    ca_text : aliased c.char_array := c.to_c (text);
255  begin
256    return cbinds.action
257      (parent => parent,
258       text   => cs.to_chars_ptr (ca_text'unchecked_access),
259       icon   => icon,
260       func   => func,
261       fmt    => agar.core.types.null_ptr);
262  end action;
263
264  function action_keyboard
265    (parent : item_access_t;
266     text   : string;
267     icon   : agar.gui.surface.surface_access_t;
268     key    : c.int;
269     modkey : c.int;
270     func   : agar.core.event.callback_t) return item_access_t
271  is
272    ca_text : aliased c.char_array := c.to_c (text);
273  begin
274    return cbinds.action_keyboard
275      (parent => parent,
276       text   => cs.to_chars_ptr (ca_text'unchecked_access),
277       icon   => icon,
278       key    => key,
279       modkey => modkey,
280       func   => func,
281       fmt    => agar.core.types.null_ptr);
282  end action_keyboard;
283
284  function dynamic_item
285    (parent : item_access_t;
286     text   : string;
287     icon   : agar.gui.surface.surface_access_t;
288     func   : agar.core.event.callback_t) return item_access_t
289  is
290    ca_text : aliased c.char_array := c.to_c (text);
291  begin
292    return cbinds.dynamic_item
293      (parent => parent,
294       text   => cs.to_chars_ptr (ca_text'unchecked_access),
295       icon   => icon,
296       func   => func,
297       fmt    => agar.core.types.null_ptr);
298  end dynamic_item;
299
300  function dynamic_item_keyboard
301    (parent : item_access_t;
302     text   : string;
303     icon   : agar.gui.surface.surface_access_t;
304     key    : c.int;
305     modkey : c.int;
306     func   : agar.core.event.callback_t) return item_access_t
307  is
308    ca_text : aliased c.char_array := c.to_c (text);
309  begin
310    return cbinds.dynamic_item_keyboard
311      (parent => parent,
312       text   => cs.to_chars_ptr (ca_text'unchecked_access),
313       icon   => icon,
314       key    => key,
315       modkey => modkey,
316       func   => func,
317       fmt    => agar.core.types.null_ptr);
318  end dynamic_item_keyboard;
319
320  function toolbar_item
321    (parent  : item_access_t;
322     toolbar : agar.gui.widget.toolbar.toolbar_access_t;
323     text    : string;
324     icon    : agar.gui.surface.surface_access_t;
325     key     : c.int;
326     modkey  : c.int;
327     func    : agar.core.event.callback_t) return item_access_t
328  is
329    ca_text : aliased c.char_array := c.to_c (text);
330  begin
331    return cbinds.toolbar_item
332      (parent  => parent,
333       toolbar => toolbar,
334       text    => cs.to_chars_ptr (ca_text'unchecked_access),
335       icon    => icon,
336       key     => key,
337       modkey  => modkey,
338       func    => func,
339       fmt     => agar.core.types.null_ptr);
340  end toolbar_item;
341
342  procedure set_label
343    (item  : item_access_t;
344     label : string)
345  is
346    ca_label : aliased c.char_array := c.to_c (label);
347  begin
348    cbinds.set_label
349      (item  => item,
350       label => cs.to_chars_ptr (ca_label'unchecked_access));
351  end set_label;
352
353  procedure set_poll_function
354    (item  : item_access_t;
355     func  : agar.core.event.callback_t) is
356  begin
357    cbinds.set_poll_function
358      (item => item,
359       func => func,
360       fmt  => agar.core.types.null_ptr);
361  end set_poll_function;
362
363  function bind_bool
364    (item   : item_access_t;
365     text   : string;
366     icon   : agar.gui.surface.surface_access_t;
367     value  : access boolean;
368     invert : boolean) return item_access_t
369  is
370    ca_text  : aliased c.char_array := c.to_c (text);
371    c_invert : c.int := 0;
372    c_value  : aliased c.int;
373    item_acc : item_access_t;
374  begin
375    if invert then c_invert := 1; end if;
376    item_acc := cbinds.bind_bool
377      (item   => item,
378       text   => cs.to_chars_ptr (ca_text'unchecked_access),
379       icon   => icon,
380       value  => c_value'unchecked_access,
381       invert => c_invert);
382    value.all := c_value = 1;
383    return item_acc;
384  end bind_bool;
385
386  function bind_bool_with_mutex
387    (item   : item_access_t;
388     text   : string;
389     icon   : agar.gui.surface.surface_access_t;
390     value  : access boolean;
391     invert : boolean;
392     mutex  : agar.core.threads.mutex_t) return item_access_t
393  is
394    ca_text  : aliased c.char_array := c.to_c (text);
395    c_invert : c.int := 0;
396    c_value  : aliased c.int;
397    item_acc : item_access_t;
398  begin
399    if invert then c_invert := 1; end if;
400    item_acc := cbinds.bind_bool_with_mutex
401      (item   => item,
402       text   => cs.to_chars_ptr (ca_text'unchecked_access),
403       icon   => icon,
404       value  => c_value'unchecked_access,
405       invert => c_invert,
406       mutex  => mutex);
407    value.all := c_value = 1;
408    return item_acc;
409  end bind_bool_with_mutex;
410
411  function bind_flags
412    (item   : item_access_t;
413     text   : string;
414     icon   : agar.gui.surface.surface_access_t;
415     value  : access mask_t;
416     flags  : mask_t;
417     invert : boolean) return item_access_t
418  is
419    ca_text  : aliased c.char_array := c.to_c (text);
420    c_invert : c.int := 0;
421  begin
422    if invert then c_invert := 1; end if;
423    return cbinds.bind_flags
424      (item   => item,
425       text   => cs.to_chars_ptr (ca_text'unchecked_access),
426       icon   => icon,
427       value  => value,
428       flags  => flags,
429       invert => c_invert);
430  end bind_flags;
431
432  function bind_flags_with_mutex
433    (item   : item_access_t;
434     text   : string;
435     icon   : agar.gui.surface.surface_access_t;
436     value  : access mask_t;
437     flags  : mask_t;
438     invert : boolean;
439     mutex  : agar.core.threads.mutex_t) return item_access_t
440  is
441    ca_text  : aliased c.char_array := c.to_c (text);
442    c_invert : c.int := 0;
443  begin
444    if invert then c_invert := 1; end if;
445    return cbinds.bind_flags_with_mutex
446      (item   => item,
447       text   => cs.to_chars_ptr (ca_text'unchecked_access),
448       icon   => icon,
449       value  => value,
450       flags  => flags,
451       invert => c_invert,
452       mutex  => mutex);
453  end bind_flags_with_mutex;
454
455  function bind_flags8
456    (item   : item_access_t;
457     text   : string;
458     icon   : agar.gui.surface.surface_access_t;
459     value  : access mask8_t;
460     flags  : mask8_t;
461     invert : boolean) return item_access_t
462  is
463    ca_text  : aliased c.char_array := c.to_c (text);
464    c_invert : c.int := 0;
465  begin
466    if invert then c_invert := 1; end if;
467    return cbinds.bind_flags8
468      (item   => item,
469       text   => cs.to_chars_ptr (ca_text'unchecked_access),
470       icon   => icon,
471       value  => value,
472       flags  => flags,
473       invert => c_invert);
474  end bind_flags8;
475
476  function bind_flags8_with_mutex
477    (item   : item_access_t;
478     text   : string;
479     icon   : agar.gui.surface.surface_access_t;
480     value  : access mask8_t;
481     flags  : mask8_t;
482     invert : boolean;
483     mutex  : agar.core.threads.mutex_t) return item_access_t
484  is
485    ca_text  : aliased c.char_array := c.to_c (text);
486    c_invert : c.int := 0;
487  begin
488    if invert then c_invert := 1; end if;
489    return cbinds.bind_flags8_with_mutex
490      (item   => item,
491       text   => cs.to_chars_ptr (ca_text'unchecked_access),
492       icon   => icon,
493       value  => value,
494       flags  => flags,
495       invert => c_invert,
496       mutex  => mutex);
497  end bind_flags8_with_mutex;
498
499  function bind_flags16
500    (item   : item_access_t;
501     text   : string;
502     icon   : agar.gui.surface.surface_access_t;
503     value  : access mask16_t;
504     flags  : mask16_t;
505     invert : boolean) return item_access_t
506  is
507    ca_text  : aliased c.char_array := c.to_c (text);
508    c_invert : c.int := 0;
509  begin
510    if invert then c_invert := 1; end if;
511    return cbinds.bind_flags16
512      (item   => item,
513       text   => cs.to_chars_ptr (ca_text'unchecked_access),
514       icon   => icon,
515       value  => value,
516       flags  => flags,
517       invert => c_invert);
518  end bind_flags16;
519
520  function bind_flags16_with_mutex
521    (item   : item_access_t;
522     text   : string;
523     icon   : agar.gui.surface.surface_access_t;
524     value  : access mask16_t;
525     flags  : mask16_t;
526     invert : boolean;
527     mutex  : agar.core.threads.mutex_t) return item_access_t
528  is
529    ca_text  : aliased c.char_array := c.to_c (text);
530    c_invert : c.int := 0;
531  begin
532    if invert then c_invert := 1; end if;
533    return cbinds.bind_flags16_with_mutex
534      (item   => item,
535       text   => cs.to_chars_ptr (ca_text'unchecked_access),
536       icon   => icon,
537       value  => value,
538       flags  => flags,
539       invert => c_invert,
540       mutex  => mutex);
541  end bind_flags16_with_mutex;
542
543  function bind_flags32
544    (item   : item_access_t;
545     text   : string;
546     icon   : agar.gui.surface.surface_access_t;
547     value  : access mask32_t;
548     flags  : mask32_t;
549     invert : boolean) return item_access_t
550  is
551    ca_text  : aliased c.char_array := c.to_c (text);
552    c_invert : c.int := 0;
553  begin
554    if invert then c_invert := 1; end if;
555    return cbinds.bind_flags32
556      (item   => item,
557       text   => cs.to_chars_ptr (ca_text'unchecked_access),
558       icon   => icon,
559       value  => value,
560       flags  => flags,
561       invert => c_invert);
562  end bind_flags32;
563
564  function bind_flags32_with_mutex
565    (item   : item_access_t;
566     text   : string;
567     icon   : agar.gui.surface.surface_access_t;
568     value  : access mask32_t;
569     flags  : mask32_t;
570     invert : boolean;
571     mutex  : agar.core.threads.mutex_t) return item_access_t
572  is
573    ca_text  : aliased c.char_array := c.to_c (text);
574    c_invert : c.int := 0;
575  begin
576    if invert then c_invert := 1; end if;
577    return cbinds.bind_flags32_with_mutex
578      (item   => item,
579       text   => cs.to_chars_ptr (ca_text'unchecked_access),
580       icon   => icon,
581       value  => value,
582       flags  => flags,
583       invert => c_invert,
584       mutex  => mutex);
585  end bind_flags32_with_mutex;
586
587  procedure section
588    (item : item_access_t;
589     text : string)
590  is
591    ca_text : aliased c.char_array := c.to_c (text);
592  begin
593    cbinds.section
594      (item => item,
595       text => cs.to_chars_ptr (ca_text'unchecked_access));
596  end section;
597
598  -- popup menus
599  package body popup is
600    package cbinds is
601      procedure show_at
602        (menu : popup_menu_access_t;
603         x    : c.int;
604         y    : c.int);
605      pragma import (c, show_at, "AG_PopupShowAt");
606    end cbinds;
607
608    procedure show_at
609      (menu : popup_menu_access_t;
610       x    : natural;
611       y    : natural) is
612    begin
613      cbinds.show_at
614        (menu => menu,
615         x    => c.int (x),
616         y    => c.int (y));
617    end show_at;
618  end popup;
619
620  function widget (menu : menu_access_t) return widget_access_t is
621  begin
622    return menu.widget'access;
623  end widget;
624
625  function widget (view : view_access_t) return widget_access_t is
626  begin
627    return view.widget'access;
628  end widget;
629
630end agar.gui.widget.menu;
631