From ae82edc42a3c93c400775b314b65a8662f181b67 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Thu, 19 Apr 2018 21:30:43 +1000 Subject: Completed and polished Window widgets, and fixed some associated oddities --- src/fltk-widgets-groups-windows.ads | 184 ++++++++++++++++++++++++++++++++---- 1 file changed, 166 insertions(+), 18 deletions(-) (limited to 'src/fltk-widgets-groups-windows.ads') diff --git a/src/fltk-widgets-groups-windows.ads b/src/fltk-widgets-groups-windows.ads index 3ea38c1..1199ec7 100644 --- a/src/fltk-widgets-groups-windows.ads +++ b/src/fltk-widgets-groups-windows.ads @@ -14,8 +14,13 @@ package FLTK.Widgets.Groups.Windows is type Window is new Group with private; + type Window_Reference (Data : not null access Window'Class) is limited null record + with Implicit_Dereference => Data; + type Border_State is (None, Visible); + type Modal_State is (Normal, Non_Modal, Modal); + type Cursor is (Default, Arrow, Crosshair, Wait, Insert, Hand, Help, Move, @@ -34,7 +39,8 @@ package FLTK.Widgets.Groups.Windows is return Window; function Create - (W, H : in Integer) + (W, H : in Integer; + Text : in String) return Window; end Forge; @@ -48,44 +54,73 @@ package FLTK.Widgets.Groups.Windows is procedure Hide (This : in out Window); + function Is_Shown + (This : in Window) + return Boolean; + + procedure Wait_For_Expose + (This : in out Window); + + procedure Iconify + (This : in out Window); + procedure Make_Current (This : in out Window); + function Last_Made_Current + return access Window'Class; + + procedure Free_Position + (This : in out Window); + - function Get_Border + function Is_Fullscreen (This : in Window) - return Border_State; + return Boolean; + + procedure Fullscreen_On + (This : in out Window); + + procedure Fullscreen_Off + (This : in out Window); + + procedure Fullscreen_Off + (This : in out Window; + X, Y, W, H : in Integer); + + procedure Fullscreen_Screens + (This : in out Window; + Top, Bottom, Left, Right : in Natural); - procedure Set_Border - (This : in out Window; - To : in Border_State); - procedure Set_Label - (This : in out Window; - Text : in String); - procedure Set_Size_Range - (This : in out Window; - Min_W, Min_H : in Integer; - Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; - Keep_Aspect : in Boolean := False); procedure Set_Icon (This : in out Window; Pic : in out FLTK.Images.RGB.RGB_Image'Class); - procedure Set_Modal - (This : in out Window); + procedure Set_Default_Icon + (Pic : in out FLTK.Images.RGB.RGB_Image'Class); - procedure Set_Non_Modal - (This : in out Window); + function Get_Icon_Label + (This : in Window) + return String; + + procedure Set_Icon_Label + (This : in out Window; + To : in String); procedure Set_Cursor (This : in out Window; To : in Cursor); + procedure Set_Cursor + (This : in out Window; + Pic : in out FLTK.Images.RGB.RGB_Image'Class; + Hot_X, Hot_Y : in Integer); + procedure Set_Default_Cursor (This : in out Window; To : in Cursor); @@ -93,6 +128,63 @@ package FLTK.Widgets.Groups.Windows is + function Get_Border_State + (This : in Window) + return Border_State; + + procedure Set_Border_State + (This : in out Window; + To : in Border_State); + + function Is_Override + (This : in Window) + return Boolean; + + procedure Set_Override + (This : in out Window); + + function Get_Modal_State + (This : in Window) + return Modal_State; + + procedure Set_Modal_State + (This : in out Window; + To : in Modal_State); + + + + + function Get_Label + (This : in Window) + return String; + + procedure Set_Label + (This : in out Window; + Text : in String); + + procedure Hotspot + (This : in out Window; + X, Y : in Integer; + Offscreen : in Boolean := False); + + procedure Hotspot + (This : in out Window; + Item : in Widget'Class; + Offscreen : in Boolean := False); + + procedure Set_Size_Range + (This : in out Window; + Min_W, Min_H : in Integer; + Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; + Keep_Aspect : in Boolean := False); + + procedure Shape + (This : in out Window; + Pic : in out FLTK.Images.Image'Class); + + + + function Get_X_Root (This : in Window) return Integer; @@ -132,6 +224,57 @@ private + pragma Inline (Show); + pragma Inline (Hide); + pragma Inline (Is_Shown); + pragma Inline (Wait_For_Expose); + pragma Inline (Iconify); + pragma Inline (Make_Current); + pragma Inline (Last_Made_Current); + pragma Inline (Free_Position); + + + pragma Inline (Is_Fullscreen); + pragma Inline (Fullscreen_On); + pragma Inline (Fullscreen_Off); + pragma Inline (Fullscreen_Screens); + + + pragma Inline (Set_Icon); + pragma Inline (Set_Default_Icon); + pragma Inline (Get_Icon_Label); + pragma Inline (Set_Icon_Label); + pragma Inline (Set_Cursor); + pragma Inline (Set_Default_Cursor); + + + pragma Inline (Get_Border_State); + pragma Inline (Set_Border_State); + pragma Inline (Is_Override); + pragma Inline (Set_Override); + pragma Inline (Get_Modal_State); + pragma Inline (Set_Modal_State); + + + pragma Inline (Get_Label); + pragma Inline (Set_Label); + pragma Inline (Hotspot); + pragma Inline (Set_Size_Range); + pragma Inline (Shape); + + + pragma Inline (Get_X_Root); + pragma Inline (Get_Y_Root); + pragma Inline (Get_Decorated_W); + pragma Inline (Get_Decorated_H); + + + pragma Inline (Draw); + pragma Inline (Handle); + + + + -- What delightful magic numbers FLTK cursors are! -- (These correspond to the enum found in Enumerations.H) Cursor_Values : array (Cursor) of Interfaces.C.int := @@ -158,5 +301,10 @@ private None => 255); + + + Last_Current : access Window'Class := null; + + end FLTK.Widgets.Groups.Windows; -- cgit