diff options
Diffstat (limited to 'spec')
| -rw-r--r-- | spec/fltk-events.ads | 44 | ||||
| -rw-r--r-- | spec/fltk-static.ads | 220 |
2 files changed, 214 insertions, 50 deletions
diff --git a/spec/fltk-events.ads b/spec/fltk-events.ads index 6a556ff..5dbc573 100644 --- a/spec/fltk-events.ads +++ b/spec/fltk-events.ads @@ -6,11 +6,12 @@ with - FLTK.Widgets.Groups.Windows; + FLTK.Widgets.Groups.Windows, + System; private with - Ada.Containers.Vectors, + Ada.Finalization, System.Address_To_Access_Conversions; @@ -27,15 +28,33 @@ package FLTK.Events is return Event_Outcome; + type System_Event is new System.Address; + + type System_Handler is access function + (Event : in System_Event) + return Event_Outcome; + + -- Handlers -- procedure Add_Handler - (Func : in Event_Handler); + (Func : in not null Event_Handler); procedure Remove_Handler - (Func : in Event_Handler); + (Func : in not null Event_Handler); + + procedure Add_System_Handler + (Func : in not null System_Handler); + + procedure Remove_System_Handler + (Func : in not null System_Handler); + + + + + -- Dispatch -- function Get_Dispatch return Event_Dispatch; @@ -255,11 +274,6 @@ private (FLTK.Widgets.Groups.Windows.Window'Class); - package Handler_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, Element_Type => Event_Handler); - - - Handlers : Handler_Vectors.Vector := Handler_Vectors.Empty_Vector; Current_Dispatch : Event_Dispatch := null; @@ -275,6 +289,9 @@ private pragma Inline (Add_Handler); pragma Inline (Remove_Handler); + pragma Inline (Add_System_Handler); + pragma Inline (Remove_System_Handler); + pragma Inline (Get_Dispatch); pragma Inline (Set_Dispatch); pragma Inline (Handle_Dispatch); @@ -333,6 +350,15 @@ private pragma Inline (Key_Shift); + -- Needed to deregister the handlers + type FLTK_Events_Final_Controller is new Ada.Finalization.Limited_Controlled with null record; + + overriding procedure Finalize + (This : in out FLTK_Events_Final_Controller); + + Cleanup : FLTK_Events_Final_Controller; + + end FLTK.Events; diff --git a/spec/fltk-static.ads b/spec/fltk-static.ads index 6b54878..4f71244 100644 --- a/spec/fltk-static.ads +++ b/spec/fltk-static.ads @@ -6,16 +6,26 @@ with + FLTK.Labels, FLTK.Widgets.Groups.Windows; private with - Interfaces.C; + Ada.Finalization, + Ada.Unchecked_Conversion, + FLTK.Args_Marshal, + Interfaces.C.Strings; package FLTK.Static is + -- Input is the argument index usable with Ada.Command_Line. + -- Output is how many arguments parsed starting from that index. + type Args_Handler is access function + (Index : in Positive) + return Natural; + type Awake_Handler is access procedure; type Idle_Handler is access procedure; @@ -31,15 +41,38 @@ package FLTK.Static is type File_Descriptor is new Integer; - type File_Mode is (Read, Write, Except); + type File_Mode is record + Read : Boolean := False; + Write : Boolean := False; + Except : Boolean := False; + end record; + + function "+" (Left, Right : in File_Mode) return File_Mode; + function "-" (Left, Right : in File_Mode) return File_Mode; + + Read_Mode : constant File_Mode; + Write_Mode : constant File_Mode; + Except_Mode : constant File_Mode; type File_Handler is access procedure (FD : in File_Descriptor); + subtype Byte_Integer is Integer range 0 .. 255; + type Box_Draw_Function is access procedure (X, Y, W, H : in Integer; - My_Color : in Color); + Tone : in Color); + + + type Label_Draw_Function is access procedure + (Item : in FLTK.Labels.Label'Class; + X, Y, W, H : in Integer; + Position : in Alignment); + + type Label_Measure_Function is access procedure + (Item : in FLTK.Labels.Label'Class; + W, H : out Integer); type Option is @@ -47,20 +80,51 @@ package FLTK.Static is Visible_Focus, DND_Text, Show_Tooltips, - FNFC_Uses_GTK, - Last); + FNFC_Uses_GTK); + + + -- According to docs this should be customisable, + -- but in C++ it is a constant pointer to constant. + Help_Message : constant String; + + + Argument_Error : exception; + + + + + -- Command Line Arguments -- + + function Parse_Arg + (Index : in Positive) + return Natural; + + procedure Parse_Args; + + -- Not task safe, but you won't need to call this more than once anyway. + procedure Parse_Args + (Count : out Natural; + Func : in Args_Handler := null); -- Thread Notify -- + -- Unsure if it is worth actually using this or if mixing tasks, pthreads, + -- and whatever other platforms use causes errors in some unexpected way. + -- Might be better to rely on FLTK.Check, Ada tasking, and Ada protected types. + -- You'll need appropriately declared protected objects to pass messages anyway. + procedure Add_Awake_Handler (Func : in Awake_Handler); function Get_Awake_Handler return Awake_Handler; + procedure Awake + (Func : in Awake_Handler); + procedure Awake; procedure Lock; @@ -73,14 +137,14 @@ package FLTK.Static is -- Pre-Eventloop Callbacks -- procedure Add_Check - (Func : in Timeout_Handler); + (Func : in not null Timeout_Handler); function Has_Check - (Func : in Timeout_Handler) + (Func : in not null Timeout_Handler) return Boolean; procedure Remove_Check - (Func : in Timeout_Handler); + (Func : in not null Timeout_Handler); @@ -88,19 +152,19 @@ package FLTK.Static is -- Timer Callbacks -- procedure Add_Timeout - (Seconds : in Long_Float; - Func : in Timeout_Handler); + (Seconds : in Long_Float; + Func : in not null Timeout_Handler); function Has_Timeout - (Func : in Timeout_Handler) + (Func : in not null Timeout_Handler) return Boolean; procedure Remove_Timeout - (Func : in Timeout_Handler); + (Func : in not null Timeout_Handler); procedure Repeat_Timeout - (Seconds : in Long_Float; - Func : in Timeout_Handler); + (Seconds : in Long_Float; + Func : in not null Timeout_Handler); @@ -108,10 +172,10 @@ package FLTK.Static is -- Clipboard Callbacks -- procedure Add_Clipboard_Notify - (Func : in Clipboard_Notify_Handler); + (Func : in not null Clipboard_Notify_Handler); procedure Remove_Clipboard_Notify - (Func : in Clipboard_Notify_Handler); + (Func : in not null Clipboard_Notify_Handler); @@ -119,13 +183,13 @@ package FLTK.Static is -- File Descriptor Waiting Callbacks -- procedure Add_File_Descriptor - (FD : in File_Descriptor; - Func : in File_Handler); + (FD : in File_Descriptor; + Func : in not null File_Handler); procedure Add_File_Descriptor - (FD : in File_Descriptor; - Mode : in File_Mode; - Func : in File_Handler); + (FD : in File_Descriptor; + Mode : in File_Mode; + Func : in not null File_Handler); procedure Remove_File_Descriptor (FD : in File_Descriptor); @@ -140,32 +204,46 @@ package FLTK.Static is -- Idle Callbacks -- procedure Add_Idle - (Func : in Idle_Handler); + (Func : in not null Idle_Handler); function Has_Idle - (Func : in Idle_Handler) + (Func : in not null Idle_Handler) return Boolean; procedure Remove_Idle - (Func : in Idle_Handler); + (Func : in not null Idle_Handler); -- Custom Colors -- + function Get_Color + (From : in Color) + return Color; + procedure Get_Color (From : in Color; R, G, B : out Color_Component); procedure Set_Color - (To : in Color; + (Target, Source : in Color); + + procedure Set_Color + (Target : in Color; R, G, B : in Color_Component); procedure Free_Color (Value : in Color; Overlay : in Boolean := False); + function Get_Box_Color + (Tone : in Color) + return Color; + + procedure Set_Box_Color + (Tone : in Color); + procedure Own_Colormap; procedure Set_Foreground @@ -193,7 +271,11 @@ package FLTK.Static is return String; procedure Set_Font_Kind - (To, From : in Font_Kind); + (Target, Source : in Font_Kind); + + procedure Set_Font_Kind + (Target : in Font_Kind; + Source : in String); function Font_Sizes (Kind : in Font_Kind) @@ -229,15 +311,28 @@ package FLTK.Static is function Draw_Box_Active return Boolean; - -- function Get_Box_Draw_Function - -- (Kind : in Box_Kind) - -- return Box_Draw_Function; + function Get_Box_Draw_Function + (Kind : in Box_Kind) + return Box_Draw_Function; + + procedure Set_Box_Draw_Function + (Kind : in Box_Kind; + Func : in Box_Draw_Function; + Offset_X, Offset_Y : in Byte_Integer := 0; + Offset_W, Offset_H : in Byte_Integer := 0); + + + - -- procedure Set_Box_Draw_Function - -- (Kind : in Box_Kind; - -- Func : in Box_Draw_Function; - -- Offset_X, Offset_Y : in Integer := 0; - -- Offset_W, Offset_H : in Integer := 0); + -- Label_Kind Attributes -- + + procedure Set_Label_Kind + (Target, Source : in Label_Kind); + + procedure Set_Label_Draw_Function + (Kind : in Label_Kind; + Draw_Func : in Label_Draw_Function; + Measure_Func : in Label_Measure_Function); @@ -256,6 +351,10 @@ package FLTK.Static is (Owner : in FLTK.Widgets.Widget'Class; Text : in String); + function Clipboard_Contains + (Kind : in String) + return Boolean; + @@ -352,25 +451,49 @@ package FLTK.Static is private - File_Mode_Codes : array (File_Mode) of Interfaces.C.int := - (Read => 1, Write => 4, Except => 8); + The_Argv : Interfaces.C.Strings.chars_ptr_array := FLTK.Args_Marshal.Create_Argv; + + + for File_Mode use record + Read at 0 range 0 .. 0; + -- bit position 1 is unused + Write at 0 range 2 .. 2; + Except at 0 range 3 .. 3; + end record; + + for File_Mode'Size use Interfaces.C.int'Size; + + Read_Mode : constant File_Mode := (Read => True, others => False); + Write_Mode : constant File_Mode := (Write => True, others => False); + Except_Mode : constant File_Mode := (Except => True, others => False); + + function FMode_To_Cint is new + Ada.Unchecked_Conversion (File_Mode, Interfaces.C.int); + + + help_usage_string_ptr : Interfaces.C.Strings.chars_ptr; + pragma Import (C, help_usage_string_ptr, "fl_help_usage_string_ptr"); + + Help_Message : constant String := Interfaces.C.Strings.Value (help_usage_string_ptr); + + + Font_Overrides : array (Font_Kind) of Interfaces.C.Strings.chars_ptr; - pragma Import (C, Awake, "fl_static_awake"); pragma Import (C, Lock, "fl_static_lock"); pragma Import (C, Unlock, "fl_static_unlock"); pragma Import (C, Own_Colormap, "fl_static_own_colormap"); pragma Import (C, System_Colors, "fl_static_get_system_colors"); - pragma Import (C, Drag_Drop_Start, "fl_static_dnd"); - pragma Import (C, Enable_System_Input, "fl_static_enable_im"); pragma Import (C, Disable_System_Input, "fl_static_disable_im"); pragma Import (C, Reload_Scheme, "fl_static_reload_scheme"); + pragma Inline (Parse_Arg); + pragma Inline (Add_Awake_Handler); pragma Inline (Get_Awake_Handler); pragma Inline (Awake); @@ -399,6 +522,8 @@ private pragma Inline (Get_Color); pragma Inline (Set_Color); pragma Inline (Free_Color); + pragma Inline (Get_Box_Color); + pragma Inline (Set_Box_Color); pragma Inline (Own_Colormap); pragma Inline (Set_Foreground); pragma Inline (Set_Background); @@ -417,12 +542,16 @@ private pragma Inline (Get_Box_Y_Offset); pragma Inline (Set_Box_Kind); pragma Inline (Draw_Box_Active); - -- pragma Inline (Get_Box_Draw_Function); - -- pragma Inline (Set_Box_Draw_Function); + pragma Inline (Get_Box_Draw_Function); + pragma Inline (Set_Box_Draw_Function); + + pragma Inline (Set_Label_Kind); + pragma Inline (Set_Label_Draw_Function); pragma Inline (Copy); pragma Inline (Paste); pragma Inline (Selection); + pragma Inline (Clipboard_Contains); pragma Inline (Drag_Drop_Start); pragma Inline (Get_Drag_Drop_Text_Support); @@ -451,6 +580,15 @@ private pragma Inline (Set_Default_Scrollbar_Size); + -- Needed to dealloc the argv array and deregister the clipboard notify handler + type FLTK_Static_Final_Controller is new Ada.Finalization.Limited_Controlled with null record; + + overriding procedure Finalize + (This : in out FLTK_Static_Final_Controller); + + Cleanup : FLTK_Static_Final_Controller; + + end FLTK.Static; |