summaryrefslogtreecommitdiff
path: root/body/fltk-widgets-groups-windows.adb
diff options
context:
space:
mode:
Diffstat (limited to 'body/fltk-widgets-groups-windows.adb')
-rw-r--r--body/fltk-widgets-groups-windows.adb373
1 files changed, 319 insertions, 54 deletions
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)