diff options
| author | Jed Barber <jjbarber@y7mail.com> | 2018-05-15 14:52:00 +1000 |
|---|---|---|
| committer | Jed Barber <jjbarber@y7mail.com> | 2018-05-15 14:52:00 +1000 |
| commit | 1cd018b440f80601f60908c2e5675413f5c77e25 (patch) | |
| tree | 765af2fb514b04ec270cdddc5100ba674a8bd0a8 | |
| parent | fefc9bf753a8595eaa75ce51eb71eb553f4bbaaf (diff) | |
Finished and polished FLTK.Widgets.Menus, fixed some off-by-one errors in Groups
| -rw-r--r-- | doc/fl_group.html | 5 | ||||
| -rw-r--r-- | doc/fl_menu_.html | 590 | ||||
| -rw-r--r-- | doc/fl_menu_item.html | 38 | ||||
| -rw-r--r-- | progress.txt | 3 | ||||
| -rw-r--r-- | src/c_fl_menu.cpp | 150 | ||||
| -rw-r--r-- | src/c_fl_menu.h | 37 | ||||
| -rw-r--r-- | src/c_fl_menuitem.cpp | 8 | ||||
| -rw-r--r-- | src/c_fl_menuitem.h | 2 | ||||
| -rw-r--r-- | src/fltk-menu_items.adb | 28 | ||||
| -rw-r--r-- | src/fltk-menu_items.ads | 10 | ||||
| -rw-r--r-- | src/fltk-widgets-groups.adb | 18 | ||||
| -rw-r--r-- | src/fltk-widgets-groups.ads | 4 | ||||
| -rw-r--r-- | src/fltk-widgets-menus.adb | 603 | ||||
| -rw-r--r-- | src/fltk-widgets-menus.ads | 257 |
14 files changed, 1699 insertions, 54 deletions
diff --git a/doc/fl_group.html b/doc/fl_group.html index 4ebea54..123e05b 100644 --- a/doc/fl_group.html +++ b/doc/fl_group.html @@ -46,6 +46,11 @@ <tr> <td> </td> + <td>Extended_Index</td> + </tr> + + <tr> + <td> </td> <td>Cursor</td> </tr> diff --git a/doc/fl_menu_.html b/doc/fl_menu_.html new file mode 100644 index 0000000..2c3ae6c --- /dev/null +++ b/doc/fl_menu_.html @@ -0,0 +1,590 @@ + +<!DOCTYPE html> + +<html lang="en"> + <head> + <meta charset="utf-8"> + <title>Fl_Menu_ Binding Map</title> + <link href="map.css" rel="stylesheet"> + </head> + + <body> + + +<h2>Fl_Menu_ Binding Map</h2> + + +<table class="package"> + <tr><th colspan="2">Package name</th></tr> + + <tr> + <td>Fl_Menu_</td> + <td>FLTK.Widgets.Menus</td> + </tr> + +</table> + + + +<table class="type"> + <tr><th colspan="2">Types</th></tr> + + <tr> + <td>Fl_Menu_</td> + <td>Menu</td> + </tr> + + <tr> + <td> </td> + <td>Menu_Reference</td> + </tr> + + <tr> + <td> </td> + <td>Index</td> + </tr> + + <tr> + <td> </td> + <td>Extended_Index</td> + </tr> + + <tr> + <td> </td> + <td>Cursor</td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Functions and Procedures</th></tr> + + <tr> +<td><pre> +Fl_Menu_(int, int, int, int, const char *=0); +</pre></td> +<td><pre> +function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu; +</pre></td> + </tr> + + <tr> +<td><pre> +int add(const char *, int shortcut, Fl_Callback *, void *=0, int=0); +</pre></td> +<td><pre> +procedure Add + (This : in out Menu; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Key_Combo := No_Key; + Flags : in Menu_Flag := Flag_Normal); +</pre></td> + </tr> + + <tr> +<td><pre> +int add(const char *a, const char *b, Fl_Callback *c, void *d=0, int e=0); +</pre></td> +<td> </td> + </tr> + + <tr> +<td><pre> +int add(const char *); +</pre></td> +<td> </td> + </tr> + + <tr> +<td><pre> +void clear(); +</pre></td> +<td><pre> +procedure Clear + (This : in out Menu); +</pre></td> + </tr> + + <tr> +<td><pre> +int clear_submenu(int index); +</pre></td> +<td> </td> + </tr> + + <tr> +<td><pre> +void copy(const Fl_Menu_Item *m, void *user_data=0); +</pre></td> +<td> </td> + </tr> + + <tr> +<td><pre> +Fl_Boxtype down_box() const; +</pre></td> +<td><pre> +function Get_Down_Box + (This : in Menu) + return Box_Kind; +</pre></td> + </tr> + + <tr> +<td><pre> +void down_box(Fl_Boxtyep b); +</pre></td> +<td><pre> +procedure Set_Down_Box + (This : in out Menu; + To : in Box_Kind); +</pre></td> + </tr> + + <tr> +<td><pre> +Fl_Color down_color() const; +</pre></td> +<td> </td> + </tr> + + <tr> +<td><pre> +void down_color(unsigned c); +</pre></td> +<td> </td> + </tr> + + <tr> +<td> </td> +<td><pre> +procedure Draw + (This : in out Menu) is null; +</pre></td> + </tr> + + <tr> +<td>See draw method in Fl_Menu_Item</td> +<td><pre> +procedure Draw_Item + (This : in out Menu; + Item : in Index; + X, Y, W, H : in Integer; + Selected : in Boolean := False); +</pre></td> + </tr> + + <tr> +<td><pre> +int find_index(const char *name) const; +</pre></td> +<td><pre> +function Find_Index + (This : in Menu; + Name : in String) + return Extended_Index; +</pre></td> + </tr> + + <tr> +<td><pre> +int find_index(const Fl_Menu_Item *item) const; +</pre></td> +<td><pre> +function Find_Index + (This : in Menu; + Item : in FLTK.Menu_Items.Menu_Item) + return Extended_Index; +</pre></td> + </tr> + + <tr> +<td><pre> +int find_index(Fl_Callback *cb) const; +</pre></td> +<td><pre> +function Find_Index + (This : in Menu; + Action : in Widget_Callback) + return Extended_Index; +</pre></td> + </tr> + + <tr> +<td><pre> +const Fl_Menu_Item * find_item(const char *name); +</pre></td> +<td><pre> +function Find_Item + (This : in Menu; + Name : in String) + return FLTK.Menu_Items.Menu_Item_Reference; +</pre></td> + </tr> + + <tr> +<td><pre> +const Fl_Menu_Item * find_item(Fl_Callback *); +</pre></td> +<td><pre> +function Find_Item + (This : in Menu; + Action : in Widget_Callback) + return FLTK.Menu_Items.Menu_Item_Reference; +</pre></td> + </tr> + + <tr> +<td><pre> +void global(); +</pre></td> +<td><pre> +procedure Make_Global + (This : in out Menu); +</pre></td> + </tr> + + <tr> +<td> </td> +<td><pre> +function Handle + (This : in out Menu; + Event : in Event_Kind) + return Event_Outcome; +</pre></td> + </tr> + + <tr> +<td> </td> +<td><pre> +function Has_Item + (This : in Menu; + Place : in Index) + return Boolean; +</pre></td> + </tr> + + <tr> +<td> </td> +<td><pre> +function Has_Item + (Place : in Cursor) + return Boolean; +</pre></td> + </tr> + + <tr> +<td><pre> +int insert(int index, const char *, int shortcut, Fl_Callback *, void *=0, int=0); +</pre></td> +<td><pre> +procedure Insert + (This : in out Menu; + Place : in Index; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Key_Combo := No_Key; + Flags : in Menu_Flag := Flag_Normal); +</pre></td> + </tr> + + <tr> +<td><pre> +int insert(int index, const char *a, const char *b, Fl_Callback *c, void *d=0, int e=0); +</pre></td> +<td> </td> + </tr> + + <tr> +<td> </td> +<td><pre> +function Item + (This : in Menu; + Place : in Index) + return FLTK.Menu_Items.Menu_Item_Reference; +</pre></td> + </tr> + + <tr> +<td> </td> +<td><pre> +function Item + (This : in Menu; + Place : in Cursor) + return FLTK.Menu_Items.Menu_Item_Reference; +</pre></td> + </tr> + + <tr> +<td><pre> +int item_pathname(char *name, int namelen, const Fl_Menu_Item *finditem=0) const; +</pre></td> +<td> </td> + </tr> + + <tr> +<td> </td> +<td><pre> +function Iterate + (This : in Menu) + return Menu_Iterators.Reversible_Iterator'Class; +</pre></td> + </tr> + + <tr> +<td>See measure method in Fl_Menu_Item</td> +<td><pre> +procedure Measure_Item + (This : in Menu; + Item : in Index; + W, H : out Integer); +</pre></td> + </tr> + + <tr> +<td><pre> +const Fl_Menu_Item * menu() const; +</pre></td> +<td>Use iterators instead</td> + </tr> + + <tr> +<td><pre> +void menu(const Fl_Menu_Item *m); +</pre></td> +<td> </td> + </tr> + + <tr> +<td><pre> +void mode(int i, int fl); +</pre></td> +<td>See Set_Flags procedure in FLTK.Menu_Items</td> + </tr> + + <tr> +<td><pre> +int mode(int i) const; +</pre></td> +<td>See Get_Flags function in FLTK.Menu_Items</td> + </tr> + + <tr> +<td><pre> +const Fl_Menu_Item * mvalue() const; +</pre></td> +<td><pre> +function Chosen + (This : in Menu) + return FLTK.Menu_Items.Menu_Item_Reference; +</pre></td> + </tr> + + <tr> +<td><pre> +const Fl_Menu_Item * picked(const Fl_Menu_Item *); +</pre></td> +<td> </td> + </tr> + + <tr> +<td>See popup method in Fl_Menu_Item</td> +<td><pre> +function Popup + (This : in Menu; + X, Y : in Integer; + Title : in String := ""; + Initial : in Extended_Index := No_Index) + return FLTK.Menu_Items.Menu_Item_Reference; +</pre></td> + </tr> + + <tr> +<td>See pulldown method in Fl_Menu_Item</td> +<td><pre> +function Pulldown + (This : in Menu; + X, Y, W, H : in Integer; + Initial : in Extended_Index := No_Index) + return FLTK.Menu_Items.Menu_Item_Reference; +</pre></td> + </tr> + + <tr> +<td><pre> +void remove(int); +</pre></td> +<td><pre> +procedure Remove + (This : in out Menu; + Place : in Index); +</pre></td> + </tr> + + <tr> +<td><pre> +void replace(int, const char *); +</pre></td> +<td>See Set_Label procedure in FLTK.Menu_Items</td> + </tr> + + <tr> +<td><pre> +void setonly(Fl_Menu_Item *item); +</pre></td> +<td>See Set_Only procedure in FLTK.Menu_Items</td> + </tr> + + <tr> +<td><pre> +void shortcut(int i, int s); +</pre></td> +<td>See Set_Shortcut procedure in FLTK.Menu_Items</td> + </tr> + + <tr> +<td><pre> +int size() const; +</pre></td> +<td><pre> +function Number_Of_Items + (This : in Menu) + return Natural; +</pre></td> + </tr> + + <tr> +<td><pre> +void size(int W, int H); +</pre></td> +<td> </td> + </tr> + + <tr> +<td><pre> +const Fl_Menu_Item * test_shortcut(); +</pre></td> +<td> </td> + </tr> + + <tr> +<td><pre> +const char * text() const; +</pre></td> +<td><pre> +function Chosen_Label + (This : in Menu) + return String; +</pre></td> + </tr> + + <tr> +<td><pre> +const char * text(int i) const; +</pre></td> +<td>See Get_Label function in FLTK.Menu_Items</td> + </tr> + + <tr> +<td><pre> +Fl_Color textcolor() const; +</pre></td> +<td><pre> +function Get_Text_Color + (This : in Menu) + return Color; +</pre></td> + </tr> + + <tr> +<td><pre> +void textcolor(Fl_Color c); +</pre></td> +<td><pre> +procedure Set_Text_Color + (This : in out Menu; + To : in Color); +</pre></td> + </tr> + + <tr> +<td><pre> +Fl_Font textfont() const; +</pre></td> +<td><pre> +function Get_Text_Font + (This : in Menu) + return Font_Kind; +</pre></td> + </tr> + + <tr> +<td><pre> +void textfont(Fl_Font c); +</pre></td> +<td><pre> +procedure Set_Text_Font + (This : in out Menu; + To : in Font_Kind); +</pre></td> + </tr> + + <tr> +<td><pre> +Fl_Fontsize textsize() const; +</pre></td> +<td><pre> +function Get_Text_Size + (This : in Menu) + return Font_Size; +</pre></td> + </tr> + + <tr> +<td><pre> +void textsize(Fl_Fontsize c); +</pre></td> +<td><pre> +procedure Set_Text_Size + (This : in out Menu; + To : in Font_Size); +</pre></td> + </tr> + + <tr> +<td><pre> +int value() const; +</pre></td> +<td><pre> +function Chosen_Index + (This : in Menu) + return Extended_Index; +</pre></td> + </tr> + + <tr> +<td><pre> +int value(const Fl_Menu_Item *); +</pre></td> +<td> </td> + </tr> + + <tr> +<td><pre> +int value(int i); +</pre></td> +<td> </td> + </tr> + +</table> + + + </body> +</html> + diff --git a/doc/fl_menu_item.html b/doc/fl_menu_item.html index d259fb5..cca7528 100644 --- a/doc/fl_menu_item.html +++ b/doc/fl_menu_item.html @@ -94,14 +94,14 @@ function Is_Active_And_Visible <td><pre> int add(const char *, int shortcut, Fl_Callback *, void *=0, int=0); </pre></td> -<td>See Fl_Menu</td> +<td>See Add procedure in FLTK.Widgets.Menus</td> </tr> <tr> <td><pre> int add(const char *a, const char *b, Fl_Callback *c, void *d=0, int e=0); </pre></td> -<td>See Fl_Menu</td> +<td> </td> </tr> <tr> @@ -206,7 +206,7 @@ procedure Do_Callback <td><pre> void draw(int x, int y, int w, int h, const Fl_Menu_ *, int t=0) const; </pre></td> -<td>See Fl_Menu</td> +<td>See Draw_Item procedure in FLTK.Widgets.Menus</td> </tr> <tr> @@ -221,7 +221,25 @@ const Fl_Menu_Item * find_shortcut(int *ip=0, const bool require_alt=false) cons const Fl_Menu_Item * first() const; Fl_Menu_Item * first(); </pre></td> -<td>See Fl_Menu</td> +<td>Use FLTK.Widgets.Menus iterators instead</td> + </tr> + + <tr> +<td>See Fl_Menu_ int mode(int i) const;</td> +<td><pre> +function Get_Flags + (Item : in Menu_Item) + return Menu_Flag; +</pre></td> + </tr> + + <tr> +<td>See Fl_Menu_ void mode(int i, int fl);</td> +<td><pre> +procedure Set_Flags + (Item : in out Menu_Item; + To : in Menu_Flag); +</pre></td> </tr> <tr> @@ -246,7 +264,7 @@ void image(Fl_Image &a); <td><pre> int insert(int, const char *, int, Fl_Callback *, void *=0, int=0); </pre></td> -<td>See Fl_Menu</td> +<td>See Insert procedure in FLTK.Widgets.Menus</td> </tr> <tr> @@ -370,7 +388,7 @@ procedure Set_Label_Type <td><pre> int measure(int *h, const Fl_Menu_ *) const; </pre></td> -<td>See Fl_Menu</td> +<td>See Measure_Item procedure in FLTK.Widgets.Menus</td> </tr> <tr> @@ -378,7 +396,7 @@ int measure(int *h, const Fl_Menu_ *) const; const Fl_Menu_Item * next(int=1) const; Fl_Menu_Item * next(int i=1); </pre></td> -<td>See Fl_Menu</td> +<td>Use FLTK.Widgets.Menus iterators instead</td> </tr> <tr> @@ -387,7 +405,7 @@ const Fl_Menu_Item * popup (int X, int Y, const char *title=0, const Fl_Menu_Item *picked=0, const Fl_Menu_*=0) const; </pre></td> -<td>See Fl_Menu</td> +<td>See Popup function in FLTK.Widgets.Menus</td> </tr> <tr> @@ -397,7 +415,7 @@ const Fl_Menu_Item * pulldown const Fl_Menu_Item *picked=0, const Fl_Menu_*=0, const Fl_Menu_Item *title=0, int menubar=0) const; </pre></td> -<td>See Fl_Menu</td> +<td>See Pulldown function in FLTK.Widgets.Menus</td> </tr> <tr> @@ -464,7 +482,7 @@ procedure Show <td><pre> int size() const; </pre></td> -<td>See Fl_Menu</td> +<td>See Number_Of_Items function in FLTK.Widgets.Menus</td> </tr> <tr> diff --git a/progress.txt b/progress.txt index f183d81..f69127e 100644 --- a/progress.txt +++ b/progress.txt @@ -73,6 +73,7 @@ FLTK.Widgets.Inputs.Multiline FLTK.Widgets.Inputs.Outputs FLTK.Widgets.Inputs.Outputs.Multiline FLTK.Widgets.Inputs.Secret +FLTK.Widgets.Menus FLTK.Widgets.Menus.Menu_Bars FLTK.Widgets.Menus.Menu_Buttons FLTK.Widgets.Progress_Bars @@ -107,7 +108,6 @@ Partially Done: FLTK.Devices.Graphics (incomplete API, otherwise polished) FLTK.Devices.Surfaces (incomplete API, otherwise polished) FLTK.Environment (incomplete API, otherwise polished) -FLTK.Widgets.Menus @@ -155,6 +155,7 @@ FL_Cairo_Window Bugs to fix: +Fl_Group ABI_VERSION checks Fl_Help_View ABI_VERSION checks Fl_Tooltip ABI_VERSION checks Fl_Text_Editor tab_nav ABI_VERSION checks diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp index e68be4c..411efde 100644 --- a/src/c_fl_menu.cpp +++ b/src/c_fl_menu.cpp @@ -1,6 +1,7 @@ #include <FL/Fl_Menu_.H> +#include <FL/Fl_Menu_Item.H> #include "c_fl_menu.h" #include "c_fl_type.h" @@ -51,14 +52,161 @@ void free_fl_menu(MENU m) { int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f) { - return reinterpret_cast<Fl_Menu_*>(m)->add(t, s, reinterpret_cast<Fl_Callback_p>(c), u, f); + return reinterpret_cast<Fl_Menu_*>(m)->add(t,s,reinterpret_cast<Fl_Callback_p>(c),u,f); +} + +int fl_menu_insert(MENU m, int p, const char * t, unsigned long s, void * c, void * u, unsigned long f) { + return reinterpret_cast<Fl_Menu_*>(m)->insert(p,t,s,reinterpret_cast<Fl_Callback_p>(c),u,f); +} + +void fl_menu_remove(MENU m, int p) { + reinterpret_cast<Fl_Menu_*>(m)->remove(p); +} + +void fl_menu_clear(MENU m) { + reinterpret_cast<Fl_Menu_*>(m)->clear(); +} + + + + +const void * fl_menu_get_item(MENU m, int i) { + return &(reinterpret_cast<Fl_Menu_*>(m)->menu()[i]); } const void * fl_menu_find_item(MENU m, const char * t) { return reinterpret_cast<Fl_Menu_*>(m)->find_item(t); } +const void * fl_menu_find_item2(MENU m, void * cb) { + // have to loop through the array manually since callbacks are stored in userdata + for (int i=0; i<fl_menu_size(m); i++) { + if (reinterpret_cast<Fl_Menu_*>(m)->menu()[i].user_data() == cb) { + return fl_menu_get_item(m,i); + } + } + return 0; +} + +int fl_menu_find_index(MENU m, const char * t) { + return reinterpret_cast<Fl_Menu_*>(m)->find_index(t); +} + +int fl_menu_find_index2(MENU m, void * i) { + return reinterpret_cast<Fl_Menu_*>(m)->find_index(reinterpret_cast<Fl_Menu_Item*>(i)); +} + +int fl_menu_find_index3(MENU m, void * cb) { + // have to loop through the array manually since callbacks are stored in userdata + for (int i=0; i<fl_menu_size(m); i++) { + if (reinterpret_cast<Fl_Menu_*>(m)->menu()[i].user_data() == cb) { + return i; + } + } + return -1; +} + +int fl_menu_size(MENU m) { + return reinterpret_cast<Fl_Menu_*>(m)->size(); +} + + + + const void * fl_menu_mvalue(MENU m) { return reinterpret_cast<Fl_Menu_*>(m)->mvalue(); } +const char * fl_menu_text(MENU m) { + return reinterpret_cast<Fl_Menu_*>(m)->text(); +} + +int fl_menu_value(MENU m) { + return reinterpret_cast<Fl_Menu_*>(m)->value(); +} + + + + +unsigned int fl_menu_get_textcolor(MENU m) { + return reinterpret_cast<Fl_Menu_*>(m)->textcolor(); +} + +void fl_menu_set_textcolor(MENU m, unsigned int c) { + reinterpret_cast<Fl_Menu_*>(m)->textcolor(c); +} + +int fl_menu_get_textfont(MENU m) { + return reinterpret_cast<Fl_Menu_*>(m)->textfont(); +} + +void fl_menu_set_textfont(MENU m, int f) { + reinterpret_cast<Fl_Menu_*>(m)->textfont(f); +} + +int fl_menu_get_textsize(MENU m) { + return reinterpret_cast<Fl_Menu_*>(m)->textsize(); +} + +void fl_menu_set_textsize(MENU m, int s) { + reinterpret_cast<Fl_Menu_*>(m)->textsize(s); +} + + + + +int fl_menu_get_down_box(MENU m) { + return reinterpret_cast<Fl_Menu_*>(m)->down_box(); +} + +void fl_menu_set_down_box(MENU m, int t) { + reinterpret_cast<Fl_Menu_*>(m)->down_box(static_cast<Fl_Boxtype>(t)); +} + +void fl_menu_global(MENU m) { + reinterpret_cast<Fl_Menu_*>(m)->global(); +} + +int fl_menu_measure(MENU m, int i, int *h) { + // method actually belongs to Fl_Menu_Item + const Fl_Menu_Item * item = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,i)); + return item->measure(h,reinterpret_cast<Fl_Menu_*>(m)); +} + + + + +const void * fl_menu_popup(MENU m, int x, int y, const char * t, int n) { + // method actually belongs to Fl_Menu_Item + const Fl_Menu_Item * dummy = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,0)); + const Fl_Menu_Item * item; + if (n >= 0) { + item = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,n)); + } else { + item = 0; + } + return dummy->popup(x,y,t,item,reinterpret_cast<Fl_Menu_*>(m)); +} + +const void * fl_menu_pulldown(MENU m, int x, int y, int w, int h, int n) { + // method actually belongs to Fl_Menu_Item + const Fl_Menu_Item * dummy = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,0)); + const Fl_Menu_Item * item; + if (n >= 0) { + item = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,n)); + } else { + item = 0; + } + return dummy->pulldown(x,y,w,h,item,reinterpret_cast<Fl_Menu_*>(m)); +} + + + + +void fl_menu_draw_item(MENU m, int i, int x, int y, int w, int h, int s) { + // method actually belongs to Fl_Menu_Item + const Fl_Menu_Item * item = reinterpret_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,i)); + item->draw(x,y,w,h,reinterpret_cast<Fl_Menu_*>(m),s); +} + + diff --git a/src/c_fl_menu.h b/src/c_fl_menu.h index e173e8e..79f64a8 100644 --- a/src/c_fl_menu.h +++ b/src/c_fl_menu.h @@ -7,7 +7,6 @@ typedef void* MENU; -// typedef void* MENUITEM; @@ -25,8 +24,44 @@ extern "C" void free_fl_menu(MENU m); extern "C" int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f); +extern "C" int fl_menu_insert(MENU m, int p, const char * t, unsigned long s, void * c, void * u, unsigned long f); +extern "C" void fl_menu_remove(MENU m, int p); +extern "C" void fl_menu_clear(MENU m); + + +extern "C" const void * fl_menu_get_item(MENU m, int i); extern "C" const void * fl_menu_find_item(MENU m, const char * t); +extern "C" const void * fl_menu_find_item2(MENU m, void * cb); +extern "C" int fl_menu_find_index(MENU m, const char * t); +extern "C" int fl_menu_find_index2(MENU m, void * i); +extern "C" int fl_menu_find_index3(MENU m, void * cb); +extern "C" int fl_menu_size(MENU m); + + extern "C" const void * fl_menu_mvalue(MENU m); +extern "C" const char * fl_menu_text(MENU m); +extern "C" int fl_menu_value(MENU m); + + +extern "C" unsigned int fl_menu_get_textcolor(MENU m); +extern "C" void fl_menu_set_textcolor(MENU m, unsigned int c); +extern "C" int fl_menu_get_textfont(MENU m); +extern "C" void fl_menu_set_textfont(MENU m, int f); +extern "C" int fl_menu_get_textsize(MENU m); +extern "C" void fl_menu_set_textsize(MENU m, int s); + + +extern "C" int fl_menu_get_down_box(MENU m); +extern "C" void fl_menu_set_down_box(MENU m, int t); +extern "C" void fl_menu_global(MENU m); +extern "C" int fl_menu_measure(MENU m, int i, int *h); + + +extern "C" const void * fl_menu_popup(MENU m, int x, int y, const char * t, int n); +extern "C" const void * fl_menu_pulldown(MENU m, int x, int y, int w, int h, int n); + + +extern "C" void fl_menu_draw_item(MENU m, int i, int x, int y, int w, int h, int s); #endif diff --git a/src/c_fl_menuitem.cpp b/src/c_fl_menuitem.cpp index 342f98b..3a9565e 100644 --- a/src/c_fl_menuitem.cpp +++ b/src/c_fl_menuitem.cpp @@ -116,6 +116,14 @@ void fl_menu_item_set_shortcut(MENU_ITEM mi, int s) { reinterpret_cast<Fl_Menu_Item*>(mi)->shortcut(s); } +unsigned long fl_menu_item_get_flags(MENU_ITEM mi) { + return reinterpret_cast<Fl_Menu_Item*>(mi)->flags; +} + +void fl_menu_item_set_flags(MENU_ITEM mi, unsigned long f) { + reinterpret_cast<Fl_Menu_Item*>(mi)->flags = f; +} + diff --git a/src/c_fl_menuitem.h b/src/c_fl_menuitem.h index bf54cfa..ce90cbc 100644 --- a/src/c_fl_menuitem.h +++ b/src/c_fl_menuitem.h @@ -44,6 +44,8 @@ extern "C" void fl_menu_item_set_labeltype(MENU_ITEM mi, int t); extern "C" int fl_menu_item_get_shortcut(MENU_ITEM mi); extern "C" void fl_menu_item_set_shortcut(MENU_ITEM mi, int s); +extern "C" unsigned long fl_menu_item_get_flags(MENU_ITEM mi); +extern "C" void fl_menu_item_set_flags(MENU_ITEM mi, unsigned long f); extern "C" void fl_menu_item_activate(MENU_ITEM mi); diff --git a/src/fltk-menu_items.adb b/src/fltk-menu_items.adb index a94293f..4c0e78c 100644 --- a/src/fltk-menu_items.adb +++ b/src/fltk-menu_items.adb @@ -161,6 +161,18 @@ package body FLTK.Menu_Items is pragma Import (C, fl_menu_item_set_shortcut, "fl_menu_item_set_shortcut"); pragma Inline (fl_menu_item_set_shortcut); + function fl_menu_item_get_flags + (MI : in System.Address) + return Interfaces.C.unsigned_long; + pragma Import (C, fl_menu_item_get_flags, "fl_menu_item_get_flags"); + pragma Inline (fl_menu_item_get_flags); + + procedure fl_menu_item_set_flags + (MI : in System.Address; + F : in Interfaces.C.unsigned_long); + pragma Import (C, fl_menu_item_set_flags, "fl_menu_item_set_flags"); + pragma Inline (fl_menu_item_set_flags); + @@ -414,6 +426,22 @@ package body FLTK.Menu_Items is end Set_Shortcut; + function Get_Flags + (Item : in Menu_Item) + return Menu_Flag is + begin + return Menu_Flag (fl_menu_item_get_flags (Item.Void_Ptr)); + end Get_Flags; + + + procedure Set_Flags + (Item : in out Menu_Item; + To : in Menu_Flag) is + begin + fl_menu_item_set_flags (Item.Void_Ptr, Interfaces.C.unsigned_long (To)); + end Set_Flags; + + procedure Activate diff --git a/src/fltk-menu_items.ads b/src/fltk-menu_items.ads index 9f02d27..5964a48 100644 --- a/src/fltk-menu_items.ads +++ b/src/fltk-menu_items.ads @@ -120,6 +120,14 @@ package FLTK.Menu_Items is (Item : in out Menu_Item; To : in Key_Combo); + function Get_Flags + (Item : in Menu_Item) + return Menu_Flag; + + procedure Set_Flags + (Item : in out Menu_Item; + To : in Menu_Flag); + @@ -185,6 +193,8 @@ private pragma Inline (Get_Shortcut); pragma Inline (Set_Shortcut); + pragma Inline (Get_Flags); + pragma Inline (Set_Flags); pragma Inline (Activate); diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index 973dabb..1994b29 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -7,6 +7,7 @@ with use type + Interfaces.C.int, System.Address; @@ -215,7 +216,7 @@ package body FLTK.Widgets.Groups is fl_group_insert (This.Void_Ptr, Item.Void_Ptr, - Interfaces.C.int (Place)); + Interfaces.C.int (Place) - 1); end Insert; @@ -243,7 +244,7 @@ package body FLTK.Widgets.Groups is (This : in out Group; Place : in Index) is begin - fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place - 1)); + fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place) - 1); end Remove; @@ -281,7 +282,7 @@ package body FLTK.Widgets.Groups is return Widget_Reference is Widget_Ptr : System.Address := - fl_group_child (This.Void_Ptr, Interfaces.C.int (Place - 1)); + fl_group_child (This.Void_Ptr, Interfaces.C.int (Place) - 1); Actual_Widget : access Widget'Class := Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); begin @@ -301,10 +302,15 @@ package body FLTK.Widgets.Groups is function Find (This : in Group; Item : in out Widget'Class) - return Index is + return Extended_Index + is + Ret : Interfaces.C.int; begin - -- should set this up to throw an exception if not found - return Index (fl_group_find (This.Void_Ptr, Item.Void_Ptr)); + Ret := fl_group_find (This.Void_Ptr, Item.Void_Ptr); + if Ret = fl_group_children (This.Void_Ptr) then + return No_Index; + end if; + return Extended_Index (Ret + 1); end Find; diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads index 609ba5d..ec0ab2a 100644 --- a/src/fltk-widgets-groups.ads +++ b/src/fltk-widgets-groups.ads @@ -21,6 +21,8 @@ package FLTK.Widgets.Groups is with Implicit_Dereference => Data; subtype Index is Positive; + subtype Extended_Index is Natural; + No_Index : constant Extended_Index := Extended_Index'First; -- type Clip_Mode is (No_Clip, Clip); @@ -91,7 +93,7 @@ package FLTK.Widgets.Groups is function Find (This : in Group; Item : in out Widget'Class) - return Index; + return Extended_Index; function Number_Of_Children (This : in Group) diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index 3d8ea0c..d6148f2 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -2,9 +2,9 @@ with - Interfaces.C, - System, - FLTK.Menu_Items; + Interfaces.C.Strings, + Ada.Unchecked_Deallocation, + System; use type @@ -19,10 +19,12 @@ package body FLTK.Widgets.Menus is procedure menu_set_draw_hook (W, D : in System.Address); pragma Import (C, menu_set_draw_hook, "menu_set_draw_hook"); + pragma Inline (menu_set_draw_hook); procedure menu_set_handle_hook (W, H : in System.Address); pragma Import (C, menu_set_handle_hook, "menu_set_handle_hook"); + pragma Inline (menu_set_handle_hook); @@ -32,10 +34,12 @@ package body FLTK.Widgets.Menus is Text : in Interfaces.C.char_array) return System.Address; pragma Import (C, new_fl_menu, "new_fl_menu"); + pragma Inline (new_fl_menu); procedure free_fl_menu (F : in System.Address); pragma Import (C, free_fl_menu, "free_fl_menu"); + pragma Inline (free_fl_menu); @@ -48,17 +52,196 @@ package body FLTK.Widgets.Menus is F : in Interfaces.C.unsigned_long) return Interfaces.C.int; pragma Import (C, fl_menu_add, "fl_menu_add"); + pragma Inline (fl_menu_add); + + function fl_menu_insert + (M : in System.Address; + P : in Interfaces.C.int; + T : in Interfaces.C.char_array; + S : in Interfaces.C.unsigned_long; + C, U : in System.Address; + F : in Interfaces.C.unsigned_long) + return Interfaces.C.int; + pragma Import (C, fl_menu_insert, "fl_menu_insert"); + pragma Inline (fl_menu_insert); + + procedure fl_menu_remove + (M : in System.Address; + P : in Interfaces.C.int); + pragma Import (C, fl_menu_remove, "fl_menu_remove"); + pragma Inline (fl_menu_remove); + + procedure fl_menu_clear + (M : in System.Address); + pragma Import (C, fl_menu_clear, "fl_menu_clear"); + pragma Inline (fl_menu_clear); + + + + + function fl_menu_get_item + (M : in System.Address; + I : in Interfaces.C.int) + return System.Address; + pragma Import (C, fl_menu_get_item, "fl_menu_get_item"); + pragma Inline (fl_menu_get_item); function fl_menu_find_item (M : in System.Address; T : in Interfaces.C.char_array) return System.Address; pragma Import (C, fl_menu_find_item, "fl_menu_find_item"); + pragma Inline (fl_menu_find_item); + + function fl_menu_find_item2 + (M, C : in System.Address) + return System.Address; + pragma Import (C, fl_menu_find_item2, "fl_menu_find_item2"); + pragma Inline (fl_menu_find_item2); + + function fl_menu_find_index + (M : in System.Address; + T : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, fl_menu_find_index, "fl_menu_find_index"); + pragma Inline (fl_menu_find_index); + + function fl_menu_find_index2 + (M, I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_menu_find_index2, "fl_menu_find_index2"); + pragma Inline (fl_menu_find_index2); + + function fl_menu_find_index3 + (M, C : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_menu_find_index3, "fl_menu_find_index3"); + pragma Inline (fl_menu_find_index3); + + function fl_menu_size + (M : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_menu_size, "fl_menu_size"); + pragma Inline (fl_menu_size); + + + function fl_menu_mvalue (M : in System.Address) return System.Address; pragma Import (C, fl_menu_mvalue, "fl_menu_mvalue"); + pragma Inline (fl_menu_mvalue); + + function fl_menu_text + (M : in System.Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_menu_text, "fl_menu_text"); + pragma Inline (fl_menu_text); + + function fl_menu_value + (M : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_menu_value, "fl_menu_value"); + pragma Inline (fl_menu_value); + + + + + function fl_menu_get_textcolor + (M : in System.Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_menu_get_textcolor, "fl_menu_get_textcolor"); + pragma Inline (fl_menu_get_textcolor); + + procedure fl_menu_set_textcolor + (M : in System.Address; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_menu_set_textcolor, "fl_menu_set_textcolor"); + pragma Inline (fl_menu_set_textcolor); + + function fl_menu_get_textfont + (M : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_menu_get_textfont, "fl_menu_get_textfont"); + pragma Inline (fl_menu_get_textfont); + + procedure fl_menu_set_textfont + (M : in System.Address; + F : in Interfaces.C.int); + pragma Import (C, fl_menu_set_textfont, "fl_menu_set_textfont"); + pragma Inline (fl_menu_set_textfont); + + function fl_menu_get_textsize + (M : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_menu_get_textsize, "fl_menu_get_textsize"); + pragma Inline (fl_menu_get_textsize); + + procedure fl_menu_set_textsize + (M : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_menu_set_textsize, "fl_menu_set_textsize"); + pragma Inline (fl_menu_set_textsize); + + + + + function fl_menu_get_down_box + (M : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_menu_get_down_box, "fl_menu_get_down_box"); + pragma Inline (fl_menu_get_down_box); + + procedure fl_menu_set_down_box + (M : in System.Address; + T : in Interfaces.C.int); + pragma Import (C, fl_menu_set_down_box, "fl_menu_set_down_box"); + pragma Inline (fl_menu_set_down_box); + + procedure fl_menu_global + (M : in System.Address); + pragma Import (C, fl_menu_global, "fl_menu_global"); + pragma Inline (fl_menu_global); + + function fl_menu_measure + (M : in System.Address; + I : in Interfaces.C.int; + H : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_menu_measure, "fl_menu_measure"); + pragma Inline (fl_menu_measure); + + + + + function fl_menu_popup + (M : in System.Address; + X, Y : in Interfaces.C.int; + T : in Interfaces.C.char_array; + N : in Interfaces.C.int) + return System.Address; + pragma Import (C, fl_menu_popup, "fl_menu_popup"); + pragma Inline (fl_menu_popup); + + function fl_menu_pulldown + (M : in System.Address; + X, Y, W, H : in Interfaces.C.int; + N : in Interfaces.C.int) + return System.Address; + pragma Import (C, fl_menu_pulldown, "fl_menu_pulldown"); + pragma Inline (fl_menu_pulldown); + + + + + procedure fl_menu_draw_item + (M : in System.Address; + I : in Interfaces.C.int; + X, Y, W, H : in Interfaces.C.int; + S : in Interfaces.C.int); + pragma Import (C, fl_menu_draw_item, "fl_menu_draw_item"); + pragma Inline (fl_menu_draw_item); @@ -76,12 +259,21 @@ package body FLTK.Widgets.Menus is + procedure Free_Item is new Ada.Unchecked_Deallocation + (Object => FLTK.Menu_Items.Menu_Item, Name => Item_Access); + + + + procedure Finalize (This : in out Menu) is begin if This.Void_Ptr /= System.Null_Address and then This in Menu'Class then + for Item of This.My_Items loop + Free_Item (Item); + end loop; free_fl_menu (This.Void_Ptr); This.Void_Ptr := System.Null_Address; end if; @@ -110,6 +302,7 @@ package body FLTK.Widgets.Menus is Widget_Convert.To_Address (This'Unchecked_Access)); menu_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); menu_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + This.My_Items := Item_Vectors.Empty_Vector; end return; end Create; @@ -126,49 +319,407 @@ package body FLTK.Widgets.Menus is Flags : in Menu_Flag := Flag_Normal) is Place : Interfaces.C.int; - Callback, User_Data : System.Address; + Callback, User_Data : System.Address := System.Null_Address; + New_Item : Item_Access; begin - if Action = null then - Callback := System.Null_Address; - User_Data := System.Null_Address; - else + if Action /= null then Callback := Item_Hook'Address; User_Data := Callback_Convert.To_Address (Action); end if; Place := fl_menu_add - (This.Void_Ptr, - Interfaces.C.To_C (Text), - To_C (Shortcut), - Callback, - User_Data, - Interfaces.C.unsigned_long (Flags)); + (This.Void_Ptr, + Interfaces.C.To_C (Text), + To_C (Shortcut), + Callback, + User_Data, + Interfaces.C.unsigned_long (Flags)); + + New_Item := new FLTK.Menu_Items.Menu_Item; + Wrapper (New_Item.all).Void_Ptr := fl_menu_get_item (This.Void_Ptr, Place); + Wrapper (New_Item.all).Needs_Dealloc := False; + This.My_Items.Append (New_Item); end Add; + procedure Insert + (This : in out Menu; + Place : in Index; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Key_Combo := No_Key; + Flags : in Menu_Flag := Flag_Normal) + is + Ret_Place : Interfaces.C.int; + Callback, User_Data : System.Address := System.Null_Address; + New_Item : Item_Access; + begin + if Action /= null then + Callback := Item_Hook'Address; + User_Data := Callback_Convert.To_Address (Action); + end if; + + Ret_Place := fl_menu_insert + (This.Void_Ptr, + Interfaces.C.int (Place) - 1, + Interfaces.C.To_C (Text), + To_C (Shortcut), + Callback, + User_Data, + Interfaces.C.unsigned_long (Flags)); + + New_Item := new FLTK.Menu_Items.Menu_Item; + Wrapper (New_Item.all).Void_Ptr := fl_menu_get_item (This.Void_Ptr, Ret_Place); + Wrapper (New_Item.all).Needs_Dealloc := False; + This.My_Items.Insert (Positive (Ret_Place + 1), New_Item); + end Insert; + + + procedure Remove + (This : in out Menu; + Place : in Index) is + begin + Free_Item (This.My_Items.Reference (Place)); + This.My_Items.Delete (Place); + fl_menu_remove (This.Void_Ptr, Interfaces.C.int (Place) - 1); + end Remove; + + + procedure Clear + (This : in out Menu) is + begin + for Item of This.My_Items loop + Free_Item (Item); + end loop; + This.My_Items := Item_Vectors.Empty_Vector; + fl_menu_clear (This.Void_Ptr); + end Clear; + + + + + function Has_Item + (This : in Menu; + Place : in Index) + return Boolean is + begin + return Place in 1 .. This.Number_Of_Items; + end Has_Item; + + + function Has_Item + (Place : in Cursor) + return Boolean is + begin + return Place.My_Container.Has_Item (Place.My_Index); + end Has_Item; + + + function Item + (This : in Menu; + Place : in Index) + return FLTK.Menu_Items.Menu_Item_Reference is + begin + return (Data => This.My_Items.Element (Place)); + end Item; + + + function Item + (This : in Menu; + Place : in Cursor) + return FLTK.Menu_Items.Menu_Item_Reference is + begin + return This.Item (Place.My_Index); + end Item; + + function Find_Item - (This : in Menu'Class; + (This : in Menu; Name : in String) - return FLTK.Menu_Items.Menu_Item is + return FLTK.Menu_Items.Menu_Item_Reference is begin - return Item : FLTK.Menu_Items.Menu_Item do - Wrapper (Item).Void_Ptr := fl_menu_find_item - (This.Void_Ptr, - Interfaces.C.To_C (Name)); - end return; + return (Data => This.My_Items.Element (This.Find_Index (Name))); end Find_Item; + function Find_Item + (This : in Menu; + Action : in Widget_Callback) + return FLTK.Menu_Items.Menu_Item_Reference is + begin + return (Data => This.My_Items.Element (This.Find_Index (Action))); + end Find_Item; + + + function Find_Index + (This : in Menu; + Name : in String) + return Extended_Index + is + Ret : Interfaces.C.int; + begin + Ret := fl_menu_find_index (This.Void_Ptr, Interfaces.C.To_C (Name)); + return Extended_Index (Ret + 1); + end Find_Index; + + + function Find_Index + (This : in Menu; + Item : in FLTK.Menu_Items.Menu_Item) + return Extended_Index + is + Ret : Interfaces.C.int; + begin + Ret := fl_menu_find_index2 (This.Void_Ptr, Wrapper (Item).Void_Ptr); + return Extended_Index (Ret + 1); + end Find_Index; + + + function Find_Index + (This : in Menu; + Action : in Widget_Callback) + return Extended_Index + is + Ret : Interfaces.C.int; + begin + Ret := fl_menu_find_index3 + (This.Void_Ptr, + Callback_Convert.To_Address (Action)); + return Extended_Index (Ret + 1); + end Find_Index; + + + function Number_Of_Items + (This : in Menu) + return Natural is + begin + return Natural (fl_menu_size (This.Void_Ptr)); + end Number_Of_Items; + + + + + function Iterate + (This : in Menu) + return Menu_Iterators.Reversible_Iterator'Class is + begin + return It : Iterator := (My_Container => This'Unrestricted_Access); + end Iterate; + + + function First + (Object : in Iterator) + return Cursor is + begin + return Cu : Cursor := + (My_Container => Object.My_Container, + My_Index => 1); + end First; + + + function Next + (Object : in Iterator; + Place : in Cursor) + return Cursor is + begin + return Cu : Cursor := + (My_Container => Place.My_Container, + My_Index => Place.My_Index + 1); + end Next; + + + function Last + (Object : in Iterator) + return Cursor is + begin + return Cu : Cursor := + (My_Container => Object.My_Container, + My_Index => Object.My_Container.Number_Of_Items); + end Last; + + + function Previous + (Object : in Iterator; + Place : in Cursor) + return Cursor is + begin + return Cu : Cursor := + (My_Container => Place.My_Container, + My_Index => Place.My_Index - 1); + end Previous; + + + + function Chosen - (This : in Menu'Class) - return FLTK.Menu_Items.Menu_Item is + (This : in Menu) + return FLTK.Menu_Items.Menu_Item_Reference is begin - return Item : FLTK.Menu_Items.Menu_Item do - Wrapper (Item).Void_Ptr := fl_menu_mvalue (This.Void_Ptr); - end return; + return (Data => This.My_Items.Element (This.Chosen_Index)); end Chosen; + function Chosen_Label + (This : in Menu) + return String is + begin + -- no dealloc required? + return Interfaces.C.Strings.Value (fl_menu_text (This.Void_Ptr)); + end Chosen_Label; + + + function Chosen_Index + (This : in Menu) + return Extended_Index is + begin + return Extended_Index (fl_menu_value (This.Void_Ptr) + 1); + end Chosen_Index; + + + + + function Get_Text_Color + (This : in Menu) + return Color is + begin + return Color (fl_menu_get_textcolor (This.Void_Ptr)); + end Get_Text_Color; + + + procedure Set_Text_Color + (This : in out Menu; + To : in Color) is + begin + fl_menu_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To)); + end Set_Text_Color; + + + function Get_Text_Font + (This : in Menu) + return Font_Kind is + begin + return Font_Kind'Val (fl_menu_get_textfont (This.Void_Ptr)); + end Get_Text_Font; + + + procedure Set_Text_Font + (This : in out Menu; + To : in Font_Kind) is + begin + fl_menu_set_textfont (This.Void_Ptr, Font_Kind'Pos (To)); + end Set_Text_Font; + + + function Get_Text_Size + (This : in Menu) + return Font_Size is + begin + return Font_Size (fl_menu_get_textsize (This.Void_Ptr)); + end Get_Text_Size; + + + procedure Set_Text_Size + (This : in out Menu; + To : in Font_Size) is + begin + fl_menu_set_textsize (This.Void_Ptr, Interfaces.C.int (To)); + end Set_Text_Size; + + + + + function Get_Down_Box + (This : in Menu) + return Box_Kind is + begin + return Box_Kind'Val (fl_menu_get_down_box (This.Void_Ptr)); + end Get_Down_Box; + + + procedure Set_Down_Box + (This : in out Menu; + To : in Box_Kind) is + begin + fl_menu_set_down_box (This.Void_Ptr, Box_Kind'Pos (To)); + end Set_Down_Box; + + + procedure Make_Global + (This : in out Menu) is + begin + fl_menu_global (This.Void_Ptr); + end Make_Global; + + + procedure Measure_Item + (This : in Menu; + Item : in Index; + W, H : out Integer) is + begin + W := Integer (fl_menu_measure + (This.Void_Ptr, + Interfaces.C.int (Item) - 1, + Interfaces.C.int (H))); + end Measure_Item; + + + + + function Popup + (This : in Menu; + X, Y : in Integer; + Title : in String := ""; + Initial : in Extended_Index := No_Index) + return FLTK.Menu_Items.Menu_Item_Reference + is + Ptr : System.Address := fl_menu_popup + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.To_C (Title), + Interfaces.C.int (Initial) - 1); + Place : Index := Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1); + begin + return (Data => This.My_Items.Element (Place)); + end Popup; + + + function Pulldown + (This : in Menu; + X, Y, W, H : in Integer; + Initial : in Extended_Index := No_Index) + return FLTK.Menu_Items.Menu_Item_Reference + is + Ptr : System.Address := fl_menu_pulldown + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.int (Initial) - 1); + Place : Index := Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1); + begin + return (Data => This.My_Items.Element (Place)); + end Pulldown; + + + + + procedure Draw_Item + (This : in out Menu; + Item : in Index; + X, Y, W, H : in Integer; + Selected : in Boolean := False) is + begin + fl_menu_draw_item + (This.Void_Ptr, + Interfaces.C.int (Item) - 1, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Boolean'Pos (Selected)); + end Draw_Item; function Handle diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads index 5d3e599..95e4528 100644 --- a/src/fltk-widgets-menus.ads +++ b/src/fltk-widgets-menus.ads @@ -2,10 +2,12 @@ with - FLTK.Menu_Items; + FLTK.Menu_Items, + Ada.Iterator_Interfaces; private with + Ada.Containers.Vectors, Interfaces, System; @@ -13,12 +15,19 @@ private with package FLTK.Widgets.Menus is - type Menu is new Widget with private; + type Menu is new Widget with private + with Default_Iterator => Iterate, + Iterator_Element => FLTK.Menu_Items.Menu_Item_Reference, + Variable_Indexing => Item; - type Menu_Cursor (Data : access Menu'Class) is limited null record + type Menu_Reference (Data : not null access Menu'Class) is limited null record with Implicit_Dereference => Data; subtype Index is Positive; + subtype Extended_Index is Natural; + No_Index : constant Extended_Index := Extended_Index'First; + + type Cursor is private; @@ -42,14 +51,158 @@ package FLTK.Widgets.Menus is Shortcut : in Key_Combo := No_Key; Flags : in Menu_Flag := Flag_Normal); + procedure Insert + (This : in out Menu; + Place : in Index; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Key_Combo := No_Key; + Flags : in Menu_Flag := Flag_Normal); + + procedure Remove + (This : in out Menu; + Place : in Index); + + procedure Clear + (This : in out Menu); + + + + + function Has_Item + (This : in Menu; + Place : in Index) + return Boolean; + + function Has_Item + (Place : in Cursor) + return Boolean; + + function Item + (This : in Menu; + Place : in Index) + return FLTK.Menu_Items.Menu_Item_Reference; + + function Item + (This : in Menu; + Place : in Cursor) + return FLTK.Menu_Items.Menu_Item_Reference; + function Find_Item - (This : in Menu'Class; + (This : in Menu; + Name : in String) + return FLTK.Menu_Items.Menu_Item_Reference; + + function Find_Item + (This : in Menu; + Action : in Widget_Callback) + return FLTK.Menu_Items.Menu_Item_Reference; + + function Find_Index + (This : in Menu; Name : in String) - return FLTK.Menu_Items.Menu_Item; + return Extended_Index; + + function Find_Index + (This : in Menu; + Item : in FLTK.Menu_Items.Menu_Item) + return Extended_Index; + + function Find_Index + (This : in Menu; + Action : in Widget_Callback) + return Extended_Index; + + function Number_Of_Items + (This : in Menu) + return Natural; + + + + + package Menu_Iterators is + new Ada.Iterator_Interfaces (Cursor, Has_Item); + + function Iterate + (This : in Menu) + return Menu_Iterators.Reversible_Iterator'Class; + + + function Chosen - (This : in Menu'Class) - return FLTK.Menu_Items.Menu_Item; + (This : in Menu) + return FLTK.Menu_Items.Menu_Item_Reference; + + function Chosen_Label + (This : in Menu) + return String; + + function Chosen_Index + (This : in Menu) + return Extended_Index; + + + + + function Get_Text_Color + (This : in Menu) + return Color; + + procedure Set_Text_Color + (This : in out Menu; + To : in Color); + + function Get_Text_Font + (This : in Menu) + return Font_Kind; + + procedure Set_Text_Font + (This : in out Menu; + To : in Font_Kind); + + function Get_Text_Size + (This : in Menu) + return Font_Size; + + procedure Set_Text_Size + (This : in out Menu; + To : in Font_Size); + + + + + function Get_Down_Box + (This : in Menu) + return Box_Kind; + + procedure Set_Down_Box + (This : in out Menu; + To : in Box_Kind); + + procedure Make_Global + (This : in out Menu); + + procedure Measure_Item + (This : in Menu; + Item : in Index; + W, H : out Integer); + + + + + function Popup + (This : in Menu; + X, Y : in Integer; + Title : in String := ""; + Initial : in Extended_Index := No_Index) + return FLTK.Menu_Items.Menu_Item_Reference; + + function Pulldown + (This : in Menu; + X, Y, W, H : in Integer; + Initial : in Extended_Index := No_Index) + return FLTK.Menu_Items.Menu_Item_Reference; @@ -57,6 +210,12 @@ package FLTK.Widgets.Menus is procedure Draw (This : in out Menu) is null; + procedure Draw_Item + (This : in out Menu; + Item : in Index; + X, Y, W, H : in Integer; + Selected : in Boolean := False); + function Handle (This : in out Menu; Event : in Event_Kind) @@ -66,7 +225,19 @@ package FLTK.Widgets.Menus is private - type Menu is new Widget with null record; + -- I'm not very happy with using a Vector of dynamically allocated + -- Menu_Item wrappers like this, but I kinda painted myself into a + -- corner with use of Limited_Controlled and the way the Add method + -- works for Menus. + + type Item_Access is access FLTK.Menu_Items.Menu_Item; + + package Item_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, Element_Type => Item_Access); + + type Menu is new Widget with record + My_Items : Item_Vectors.Vector; + end record; overriding procedure Finalize (This : in out Menu); @@ -78,5 +249,75 @@ private pragma Convention (C, Item_Hook); + + + type Cursor is record + My_Container : access Menu; + My_Index : Index'Base := Index'First; + end record; + + type Iterator is new Menu_Iterators.Reversible_Iterator with record + My_Container : access Menu; + end record; + + overriding function First + (Object : in Iterator) + return Cursor; + + overriding function Next + (Object : in Iterator; + Place : in Cursor) + return Cursor; + + overriding function Last + (Object : in Iterator) + return Cursor; + + overriding function Previous + (Object : in Iterator; + Place : in Cursor) + return Cursor; + + + + + pragma Inline (Has_Item); + pragma Inline (Item); + pragma Inline (Find_Item); + pragma Inline (Find_Index); + pragma Inline (Number_Of_Items); + + + pragma Inline (Iterate); + + + pragma Inline (Chosen); + pragma Inline (Chosen_Label); + pragma Inline (Chosen_Index); + + + pragma Inline (Get_Text_Color); + pragma Inline (Set_Text_Color); + pragma Inline (Get_Text_Font); + pragma Inline (Set_Text_Font); + pragma Inline (Get_Text_Size); + pragma Inline (Set_Text_Size); + + + pragma Inline (Get_Down_Box); + pragma Inline (Set_Down_Box); + pragma Inline (Make_Global); + pragma Inline (Measure_Item); + + + pragma Inline (Popup); + pragma Inline (Pulldown); + + + pragma Inline (Draw); + pragma Inline (Draw_Item); + pragma Inline (Handle); + + end FLTK.Widgets.Menus; |