diff options
Diffstat (limited to 'body')
| -rw-r--r-- | body/c_fl_window.cpp | 81 | ||||
| -rw-r--r-- | body/c_fl_window.h | 24 | ||||
| -rw-r--r-- | body/fltk-widgets-groups-windows.adb | 373 |
3 files changed, 413 insertions, 65 deletions
diff --git a/body/c_fl_window.cpp b/body/c_fl_window.cpp index 806e66f..0db4e9d 100644 --- a/body/c_fl_window.cpp +++ b/body/c_fl_window.cpp @@ -19,6 +19,17 @@ extern "C" int widget_handle_hook(void * ud, int e); +// Non-friend protected access + +class Friend_Window : Fl_Window { +public: + using Fl_Window::flush; + using Fl_Window::force_position; +}; + + + + // Attaching all relevant hooks and friends class My_Window : public Fl_Window { @@ -92,10 +103,6 @@ void fl_window_make_current(WINDOW n) { static_cast<Fl_Window*>(n)->make_current(); } -void fl_window_free_position(WINDOW n) { - static_cast<Fl_Window*>(n)->free_position(); -} - @@ -126,10 +133,18 @@ void fl_window_set_icon(WINDOW n, void * img) { static_cast<Fl_Window*>(n)->icon(static_cast<Fl_RGB_Image*>(img)); } +void fl_window_icons(WINDOW n, void * imgs, int count) { + static_cast<Fl_Window*>(n)->icons(static_cast<const Fl_RGB_Image**>(imgs), count); +} + void fl_window_default_icon(void * img) { Fl_Window::default_icon(static_cast<Fl_RGB_Image*>(img)); } +void fl_window_default_icons(void * imgs, int count) { + Fl_Window::default_icons(static_cast<const Fl_RGB_Image**>(imgs), count); +} + const char * fl_window_get_iconlabel(WINDOW n) { return static_cast<Fl_Window*>(n)->iconlabel(); } @@ -161,6 +176,10 @@ void fl_window_set_border(WINDOW n, int b) { static_cast<Fl_Window*>(n)->border(b); } +void fl_window_clear_border(WINDOW n) { + static_cast<Fl_Window*>(n)->clear_border(); +} + unsigned int fl_window_get_override(WINDOW n) { return static_cast<Fl_Window*>(n)->override(); } @@ -196,7 +215,7 @@ const char * fl_window_get_label(WINDOW n) { return static_cast<Fl_Window*>(n)->label(); } -void fl_window_set_label(WINDOW n, char* text) { +void fl_window_copy_label(WINDOW n, char* text) { static_cast<Fl_Window*>(n)->copy_label(text); } @@ -208,12 +227,29 @@ void fl_window_hotspot2(WINDOW n, void * i, int s) { static_cast<Fl_Window*>(n)->hotspot(static_cast<Fl_Widget*>(i),s); } +void fl_window_shape(WINDOW n, void * p) { + static_cast<Fl_Window*>(n)->shape(static_cast<Fl_Image*>(p)); +} + + + + void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a) { static_cast<Fl_Window*>(n)->size_range(lw, lh, hw, hh, dw, dh, a); } -void fl_window_shape(WINDOW n, void * p) { - static_cast<Fl_Window*>(n)->shape(static_cast<Fl_Image*>(p)); +void fl_window_resize(WINDOW n, int x, int y, int w, int h) { + static_cast<Fl_Window*>(n)->resize(x, y, w, h); +} + +int fl_window_get_force_position(WINDOW n) { + int (Fl_Window::*myforce)() const = &Friend_Window::force_position; + return (static_cast<Fl_Window*>(n)->*myforce)(); +} + +void fl_window_set_force_position(WINDOW n, int s) { + void (Fl_Window::*myforce)(int) = &Friend_Window::force_position; + (static_cast<Fl_Window*>(n)->*myforce)(s); } @@ -238,10 +274,41 @@ int fl_window_get_decorated_h(WINDOW n) { +const char * fl_window_get_xclass(WINDOW n) { + return static_cast<Fl_Window*>(n)->xclass(); +} + +void fl_window_set_xclass(WINDOW n, const char * c) { + static_cast<Fl_Window*>(n)->xclass(c); +} + +const char * fl_window_get_default_xclass() { + return Fl_Window::default_xclass(); +} + +void fl_window_set_default_xclass(const char * c) { + Fl_Window::default_xclass(c); +} + +unsigned int fl_window_menu_window(WINDOW n) { + return static_cast<Fl_Window*>(n)->menu_window(); +} + +unsigned int fl_window_tooltip_window(WINDOW n) { + return static_cast<Fl_Window*>(n)->tooltip_window(); +} + + + + void fl_window_draw(WINDOW n) { static_cast<My_Window*>(n)->Fl_Window::draw(); } +void fl_window_flush(WINDOW n) { + (static_cast<Fl_Window*>(n)->*(&Friend_Window::flush))(); +} + int fl_window_handle(WINDOW n, int e) { return static_cast<My_Window*>(n)->Fl_Window::handle(e); } diff --git a/body/c_fl_window.h b/body/c_fl_window.h index ed6ebdd..f680d25 100644 --- a/body/c_fl_window.h +++ b/body/c_fl_window.h @@ -23,7 +23,6 @@ extern "C" int fl_window_shown(WINDOW n); extern "C" void fl_window_wait_for_expose(WINDOW n); extern "C" void fl_window_iconize(WINDOW n); extern "C" void fl_window_make_current(WINDOW n); -extern "C" void fl_window_free_position(WINDOW n); extern "C" unsigned int fl_window_fullscreen_active(WINDOW n); @@ -34,7 +33,9 @@ extern "C" void fl_window_fullscreen_screens(WINDOW n, int t, int b, int l, int extern "C" void fl_window_set_icon(WINDOW n, void * img); +extern "C" void fl_window_icons(WINDOW n, void * imgs, int count); extern "C" void fl_window_default_icon(void * img); +extern "C" void fl_window_default_icons(void * imgs, int count); extern "C" const char * fl_window_get_iconlabel(WINDOW n); extern "C" void fl_window_set_iconlabel(WINDOW n, const char * s); extern "C" void fl_window_set_cursor(WINDOW n, int c); @@ -44,30 +45,45 @@ extern "C" void fl_window_set_default_cursor(WINDOW n, int c); extern "C" unsigned int fl_window_get_border(WINDOW n); extern "C" void fl_window_set_border(WINDOW n, int b); +extern "C" void fl_window_clear_border(WINDOW n); extern "C" unsigned int fl_window_get_override(WINDOW n); extern "C" void fl_window_set_override(WINDOW n); extern "C" unsigned int fl_window_modal(WINDOW n); extern "C" unsigned int fl_window_non_modal(WINDOW n); -extern "C" void fl_window_clear_modal_states(WINDOW n); extern "C" void fl_window_set_modal(WINDOW n); extern "C" void fl_window_set_non_modal(WINDOW n); +extern "C" void fl_window_clear_modal_states(WINDOW n); extern "C" const char * fl_window_get_label(WINDOW n); -extern "C" void fl_window_set_label(WINDOW n, char* text); +extern "C" void fl_window_copy_label(WINDOW n, char* text); extern "C" void fl_window_hotspot(WINDOW n, int x, int y, int s); extern "C" void fl_window_hotspot2(WINDOW n, void * i, int s); -extern "C" void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a); extern "C" void fl_window_shape(WINDOW n, void * p); +extern "C" void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a); +extern "C" void fl_window_resize(WINDOW n, int x, int y, int w, int h); +extern "C" int fl_window_get_force_position(WINDOW n); +extern "C" void fl_window_set_force_position(WINDOW n, int s); + + extern "C" int fl_window_get_x_root(WINDOW n); extern "C" int fl_window_get_y_root(WINDOW n); extern "C" int fl_window_get_decorated_w(WINDOW n); extern "C" int fl_window_get_decorated_h(WINDOW n); +extern "C" const char * fl_window_get_xclass(WINDOW n); +extern "C" void fl_window_set_xclass(WINDOW n, const char * c); +extern "C" const char * fl_window_get_default_xclass(); +extern "C" void fl_window_set_default_xclass(const char * c); +extern "C" unsigned int fl_window_menu_window(WINDOW n); +extern "C" unsigned int fl_window_tooltip_window(WINDOW n); + + extern "C" void fl_window_draw(WINDOW n); +extern "C" void fl_window_flush(WINDOW n); extern "C" int fl_window_handle(WINDOW n, int e); diff --git a/body/fltk-widgets-groups-windows.adb b/body/fltk-widgets-groups-windows.adb index 3a07d96..5fefa84 100644 --- a/body/fltk-widgets-groups-windows.adb +++ b/body/fltk-widgets-groups-windows.adb @@ -85,11 +85,6 @@ package body FLTK.Widgets.Groups.Windows is pragma Import (C, fl_window_make_current, "fl_window_make_current"); pragma Inline (fl_window_make_current); - procedure fl_window_free_position - (W : in Storage.Integer_Address); - pragma Import (C, fl_window_free_position, "fl_window_free_position"); - pragma Inline (fl_window_free_position); - @@ -129,11 +124,23 @@ package body FLTK.Widgets.Groups.Windows is pragma Import (C, fl_window_set_icon, "fl_window_set_icon"); pragma Inline (fl_window_set_icon); + procedure fl_window_icons + (W, P : in Storage.Integer_Address; + C : in Interfaces.C.int); + pragma Import (C, fl_window_icons, "fl_window_icons"); + pragma Inline (fl_window_icons); + procedure fl_window_default_icon (P : in Storage.Integer_Address); pragma Import (C, fl_window_default_icon, "fl_window_default_icon"); pragma Inline (fl_window_default_icon); + procedure fl_window_default_icons + (P : in Storage.Integer_Address; + C : in Interfaces.C.int); + pragma Import (C, fl_window_default_icons, "fl_window_default_icons"); + pragma Inline (fl_window_default_icons); + function fl_window_get_iconlabel (W : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; @@ -179,6 +186,11 @@ package body FLTK.Widgets.Groups.Windows is pragma Import (C, fl_window_set_border, "fl_window_set_border"); pragma Inline (fl_window_set_border); + procedure fl_window_clear_border + (W : in Storage.Integer_Address); + pragma Import (C, fl_window_clear_border, "fl_window_clear_border"); + pragma Inline (fl_window_clear_border); + function fl_window_get_override (W : in Storage.Integer_Address) return Interfaces.C.unsigned; @@ -202,11 +214,6 @@ package body FLTK.Widgets.Groups.Windows is pragma Import (C, fl_window_non_modal, "fl_window_non_modal"); pragma Inline (fl_window_non_modal); - procedure fl_window_clear_modal_states - (W : in Storage.Integer_Address); - pragma Import (C, fl_window_clear_modal_states, "fl_window_clear_modal_states"); - pragma Inline (fl_window_clear_modal_states); - procedure fl_window_set_modal (W : in Storage.Integer_Address); pragma Import (C, fl_window_set_modal, "fl_window_set_modal"); @@ -217,6 +224,11 @@ package body FLTK.Widgets.Groups.Windows is pragma Import (C, fl_window_set_non_modal, "fl_window_set_non_modal"); pragma Inline (fl_window_set_non_modal); + procedure fl_window_clear_modal_states + (W : in Storage.Integer_Address); + pragma Import (C, fl_window_clear_modal_states, "fl_window_clear_modal_states"); + pragma Inline (fl_window_clear_modal_states); + @@ -226,11 +238,11 @@ package body FLTK.Widgets.Groups.Windows is pragma Import (C, fl_window_get_label, "fl_window_get_label"); pragma Inline (fl_window_get_label); - procedure fl_window_set_label + procedure fl_window_copy_label (W : in Storage.Integer_Address; T : in Interfaces.C.char_array); - pragma Import (C, fl_window_set_label, "fl_window_set_label"); - pragma Inline (fl_window_set_label); + pragma Import (C, fl_window_copy_label, "fl_window_copy_label"); + pragma Inline (fl_window_copy_label); procedure fl_window_hotspot (W : in Storage.Integer_Address; @@ -244,16 +256,37 @@ package body FLTK.Widgets.Groups.Windows is pragma Import (C, fl_window_hotspot2, "fl_window_hotspot2"); pragma Inline (fl_window_hotspot2); + procedure fl_window_shape + (W, P : in Storage.Integer_Address); + pragma Import (C, fl_window_shape, "fl_window_shape"); + pragma Inline (fl_window_shape); + + + + procedure fl_window_size_range (W : in Storage.Integer_Address; LW, LH, HW, HH, DW, DH, A : in Interfaces.C.int); pragma Import (C, fl_window_size_range, "fl_window_size_range"); pragma Inline (fl_window_size_range); - procedure fl_window_shape - (W, P : in Storage.Integer_Address); - pragma Import (C, fl_window_shape, "fl_window_shape"); - pragma Inline (fl_window_shape); + procedure fl_window_resize + (N : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_window_resize, "fl_window_resize"); + pragma Inline (fl_window_resize); + + function fl_window_get_force_position + (N : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_window_get_force_position, "fl_window_get_force_position"); + pragma Inline (fl_window_get_force_position); + + procedure fl_window_set_force_position + (N : in Storage.Integer_Address; + S : in Interfaces.C.int); + pragma Import (C, fl_window_set_force_position, "fl_window_set_force_position"); + pragma Inline (fl_window_set_force_position); @@ -285,11 +318,53 @@ package body FLTK.Widgets.Groups.Windows is + function fl_window_get_xclass + (W : in Storage.Integer_Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_window_get_xclass, "fl_window_get_xclass"); + pragma Inline (fl_window_get_xclass); + + procedure fl_window_set_xclass + (W : in Storage.Integer_Address; + C : in Interfaces.C.char_array); + pragma Import (C, fl_window_set_xclass, "fl_window_set_xclass"); + pragma Inline (fl_window_set_xclass); + + function fl_window_get_default_xclass + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_window_get_default_xclass, "fl_window_get_default_xclass"); + pragma Inline (fl_window_get_default_xclass); + + procedure fl_window_set_default_xclass + (C : in Interfaces.C.char_array); + pragma Import (C, fl_window_set_default_xclass, "fl_window_set_default_xclass"); + pragma Inline (fl_window_set_default_xclass); + + function fl_window_menu_window + (W : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_window_menu_window, "fl_window_menu_window"); + pragma Inline (fl_window_menu_window); + + function fl_window_tooltip_window + (W : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_window_tooltip_window, "fl_window_tooltip_window"); + pragma Inline (fl_window_tooltip_window); + + + + procedure fl_window_draw (W : in Storage.Integer_Address); pragma Import (C, fl_window_draw, "fl_window_draw"); pragma Inline (fl_window_draw); + procedure fl_window_flush + (W : in Storage.Integer_Address); + pragma Import (C, fl_window_flush, "fl_window_flush"); + pragma Inline (fl_window_flush); + function fl_window_handle (W : in Storage.Integer_Address; E : in Interfaces.C.int) @@ -469,13 +544,6 @@ package body FLTK.Widgets.Groups.Windows is end Last_Made_Current; - procedure Free_Position - (This : in out Window) is - begin - fl_window_free_position (This.Void_Ptr); - end Free_Position; - - function Is_Fullscreen @@ -530,21 +598,64 @@ package body FLTK.Widgets.Groups.Windows is procedure Set_Icon (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class) is + Pic : in FLTK.Images.RGB.RGB_Image'Class) is begin fl_window_set_icon - (This.Void_Ptr, - Wrapper (Pic).Void_Ptr); + (This.Void_Ptr, + Wrapper (Pic).Void_Ptr); end Set_Icon; + procedure Set_Icons + (This : in out Window; + Pics : in FLTK.Images.RGB.RGB_Image_Array) + is + Pointers : array (Pics'First .. Pics'Last) of aliased Storage.Integer_Address; + begin + for Index in Pointers'Range loop + Pointers (Index) := Wrapper (Pics (Index)).Void_Ptr; + end loop; + fl_window_icons + (This.Void_Ptr, + Storage.To_Integer (Pointers (Pointers'First)'Address), + Pointers'Length); + end Set_Icons; + + + procedure Reset_Icons + (This : in out Window) is + begin + fl_window_icons (This.Void_Ptr, Null_Pointer, 0); + end Reset_Icons; + + procedure Set_Default_Icon - (Pic : in out FLTK.Images.RGB.RGB_Image'Class) is + (Pic : in FLTK.Images.RGB.RGB_Image'Class) is begin fl_window_default_icon (Wrapper (Pic).Void_Ptr); end Set_Default_Icon; + procedure Set_Default_Icons + (Pics : in FLTK.Images.RGB.RGB_Image_Array) + is + Pointers : array (Pics'First .. Pics'Last) of aliased Storage.Integer_Address; + begin + for Index in Pointers'Range loop + Pointers (Index) := Wrapper (Pics (Index)).Void_Ptr; + end loop; + fl_window_default_icons + (Storage.To_Integer (Pointers (Pointers'First)'Address), + Pointers'Length); + end Set_Default_Icons; + + + procedure Reset_Default_Icons is + begin + fl_window_default_icons (Null_Pointer, 0); + end Reset_Default_Icons; + + function Get_Icon_Label (This : in Window) return String @@ -578,7 +689,7 @@ package body FLTK.Widgets.Groups.Windows is procedure Set_Cursor (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class; + Pic : in FLTK.Images.RGB.RGB_Image'Class; Hot_X, Hot_Y : in Integer) is begin fl_window_set_cursor2 @@ -599,20 +710,27 @@ package body FLTK.Widgets.Groups.Windows is - function Get_Border_State + function Has_Border (This : in Window) - return Border_State is + return Boolean is begin - return Border_State'Val (fl_window_get_border (This.Void_Ptr)); - end Get_Border_State; + return fl_window_get_border (This.Void_Ptr) /= 0; + end Has_Border; - procedure Set_Border_State - (This : in out Window; - To : in Border_State) is + procedure Set_Border + (This : in out Window; + Value : in Boolean := True) is + begin + fl_window_set_border (This.Void_Ptr, Boolean'Pos (Value)); + end Set_Border; + + + procedure Clear_Border + (This : in out Window) is begin - fl_window_set_border (This.Void_Ptr, Border_State'Pos (To)); - end Set_Border_State; + fl_window_clear_border (This.Void_Ptr); + end Clear_Border; function Is_Override @@ -630,6 +748,22 @@ package body FLTK.Widgets.Groups.Windows is end Set_Override; + function Is_Modal + (This : in Window) + return Boolean is + begin + return fl_window_modal (This.Void_Ptr) /= 0; + end Is_Modal; + + + function Is_Non_Modal + (This : in Window) + return Boolean is + begin + return fl_window_non_modal (This.Void_Ptr) /= 0; + end Is_Non_Modal; + + function Get_Modal_State (This : in Window) return Modal_State is @@ -644,21 +778,39 @@ package body FLTK.Widgets.Groups.Windows is end Get_Modal_State; + procedure Set_Modal + (This : in out Window) is + begin + fl_window_set_modal (This.Void_Ptr); + end Set_Modal; + + + procedure Set_Non_Modal + (This : in out Window) is + begin + fl_window_set_non_modal (This.Void_Ptr); + end Set_Non_Modal; + + procedure Set_Modal_State - (This : in out Window; - To : in Modal_State) is - begin - case To is - when Normal => - fl_window_clear_modal_states (This.Void_Ptr); - when Non_Modal => - fl_window_set_non_modal (This.Void_Ptr); - when Modal => - fl_window_set_modal (This.Void_Ptr); + (This : in out Window; + Value : in Modal_State) is + begin + case Value is + when Normal => fl_window_clear_modal_states (This.Void_Ptr); + when Non_Modal => fl_window_set_non_modal (This.Void_Ptr); + when Modal => fl_window_set_modal (This.Void_Ptr); end case; end Set_Modal_State; + procedure Clear_Modal_State + (This : in out Window) is + begin + fl_window_clear_modal_states (This.Void_Ptr); + end Clear_Modal_State; + + function Get_Label @@ -680,10 +832,19 @@ package body FLTK.Widgets.Groups.Windows is (This : in out Window; Text : in String) is begin - fl_window_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + fl_window_copy_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end Set_Label; + procedure Set_Labels + (This : in out Window; + Text, Icon_Text : in String) is + begin + This.Set_Label (Text); + This.Set_Icon_Label (Icon_Text); + end Set_Labels; + + procedure Hotspot (This : in out Window; X, Y : in Integer; @@ -709,6 +870,16 @@ package body FLTK.Widgets.Groups.Windows is end Hotspot; + procedure Shape + (This : in out Window; + Pic : in FLTK.Images.Image'Class) is + begin + fl_window_shape (This.Void_Ptr, Wrapper (Pic).Void_Ptr); + end Shape; + + + + procedure Set_Size_Range (This : in out Window; Min_W, Min_H : in Integer; @@ -727,12 +898,39 @@ package body FLTK.Widgets.Groups.Windows is end Set_Size_Range; - procedure Shape - (This : in out Window; - Pic : in out FLTK.Images.Image'Class) is + procedure Resize + (This : in out Window; + X, Y, W, H : in Integer) is begin - fl_window_shape (This.Void_Ptr, Wrapper (Pic).Void_Ptr); - end Shape; + fl_window_resize + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Resize; + + + function Is_Position_Forced + (This : in Window) + return Boolean + is + Result : Interfaces.C.int := fl_window_get_force_position (This.Void_Ptr); + begin + return Boolean'Val (Result); + exception + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Window::force_position returned unexpected int value of " & + Interfaces.C.int'Image (Result); + end Is_Position_Forced; + + + procedure Force_Position + (This : in out Window; + State : in Boolean := True) is + begin + fl_window_set_force_position (This.Void_Ptr, Boolean'Pos (State)); + end Force_Position; @@ -771,6 +969,66 @@ package body FLTK.Widgets.Groups.Windows is + function Get_X_Class + (This : in Window) + return String + is + Result : Interfaces.C.Strings.chars_ptr := fl_window_get_xclass (This.Void_Ptr); + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end Get_X_Class; + + + procedure Set_X_Class + (This : in out Window; + Value : in String) is + begin + fl_window_set_xclass (This.Void_Ptr, Interfaces.C.To_C (Value)); + end Set_X_Class; + + + function Get_Default_X_Class + return String + is + Result : Interfaces.C.Strings.chars_ptr := fl_window_get_default_xclass; + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end Get_Default_X_Class; + + + procedure Set_Default_X_Class + (Value : in String) is + begin + fl_window_set_default_xclass (Interfaces.C.To_C (Value)); + end Set_Default_X_Class; + + + function Is_Menu_Window + (This : in Window) + return Boolean is + begin + return fl_window_menu_window (This.Void_Ptr) /= 0; + end Is_Menu_Window; + + + function Is_Tooltip_Window + (This : in Window) + return Boolean is + begin + return fl_window_tooltip_window (This.Void_Ptr) /= 0; + end Is_Tooltip_Window; + + + + procedure Draw (This : in out Window) is begin @@ -778,6 +1036,13 @@ package body FLTK.Widgets.Groups.Windows is end Draw; + procedure Flush + (This : in out Window) is + begin + fl_window_flush (This.Void_Ptr); + end Flush; + + function Handle (This : in out Window; Event : in Event_Kind) |