diff options
Diffstat (limited to 'spec/fltk-static.ads')
| -rw-r--r-- | spec/fltk-static.ads | 297 |
1 files changed, 219 insertions, 78 deletions
diff --git a/spec/fltk-static.ads b/spec/fltk-static.ads index 98f44ba..4f71244 100644 --- a/spec/fltk-static.ads +++ b/spec/fltk-static.ads @@ -6,23 +6,31 @@ 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 - type Awake_Handler is access procedure; + -- 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 Timeout_Handler is access procedure; + type Awake_Handler is access procedure; type Idle_Handler is access procedure; - + type Timeout_Handler is access procedure; type Buffer_Kind is (Selection, Clipboard); @@ -31,35 +39,82 @@ package FLTK.Static is (Kind : in Buffer_Kind); + type File_Descriptor is new Integer; + type File_Mode is record + Read : Boolean := False; + Write : Boolean := False; + Except : Boolean := False; + end record; - type File_Descriptor is new Integer; + function "+" (Left, Right : in File_Mode) return File_Mode; + function "-" (Left, Right : in File_Mode) return File_Mode; - type File_Mode is (Read, Write, Except); + 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 - (Arrow_Focus, - Visible_Focus, - DND_Text, - Show_Tooltips, - FNFC_Uses_GTK, - Last); + (Arrow_Focus, + Visible_Focus, + DND_Text, + Show_Tooltips, + 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); @@ -67,57 +122,74 @@ package FLTK.Static is function Get_Awake_Handler return Awake_Handler; + procedure Awake + (Func : in Awake_Handler); + + procedure Awake; + + procedure Lock; + + procedure Unlock; + + + -- 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); + -- 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); + + -- 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); + + -- 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); @@ -129,31 +201,49 @@ 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 @@ -170,6 +260,8 @@ package FLTK.Static is + -- Custom Fonts -- + function Font_Image (Kind : in Font_Kind) return String; @@ -179,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) @@ -191,6 +287,8 @@ package FLTK.Static is + -- Box_Kind Attributes -- + function Get_Box_Height_Offset (Kind : in Box_Kind) return Integer; @@ -213,18 +311,33 @@ 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); + + + + + -- Clipboard / Selection -- procedure Copy (Text : in String; @@ -238,8 +351,14 @@ package FLTK.Static is (Owner : in FLTK.Widgets.Widget'Class; Text : in String); + function Clipboard_Contains + (Kind : in String) + return Boolean; + + + -- Dragon Drop -- procedure Drag_Drop_Start; @@ -252,18 +371,16 @@ package FLTK.Static is + -- Input Methods -- + procedure Enable_System_Input; procedure Disable_System_Input; - function Has_Visible_Focus - return Boolean; - - procedure Set_Visible_Focus - (To : in Boolean); + -- Windows -- procedure Default_Window_Close (Item : in out FLTK.Widgets.Widget'Class); @@ -284,13 +401,15 @@ package FLTK.Static is + -- Queue -- + function Read_Queue return access FLTK.Widgets.Widget'Class; - procedure Do_Widget_Deletion; + -- Schemes -- function Get_Scheme return String; @@ -307,6 +426,8 @@ package FLTK.Static is + -- Library Options -- + function Get_Option (Opt : in Option) return Boolean; @@ -318,6 +439,8 @@ package FLTK.Static is + -- Scrollbars -- + function Get_Default_Scrollbar_Size return Natural; @@ -328,101 +451,114 @@ 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; - pragma Import (C, Own_Colormap, "fl_static_own_colormap"); - pragma Import (C, System_Colors, "fl_static_get_system_colors"); + 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); - pragma Import (C, Drag_Drop_Start, "fl_static_dnd"); + help_usage_string_ptr : Interfaces.C.Strings.chars_ptr; + pragma Import (C, help_usage_string_ptr, "fl_help_usage_string_ptr"); - pragma Import (C, Enable_System_Input, "fl_static_enable_im"); - pragma Import (C, Disable_System_Input, "fl_static_disable_im"); + Help_Message : constant String := Interfaces.C.Strings.Value (help_usage_string_ptr); - pragma Import (C, Do_Widget_Deletion, "fl_static_do_widget_deletion"); + Font_Overrides : array (Font_Kind) of Interfaces.C.Strings.chars_ptr; - pragma Import (C, Reload_Scheme, "fl_static_reload_scheme"); + 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, 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); + pragma Inline (Lock); + pragma Inline (Unlock); pragma Inline (Add_Check); pragma Inline (Has_Check); pragma Inline (Remove_Check); - pragma Inline (Add_Timeout); pragma Inline (Has_Timeout); pragma Inline (Remove_Timeout); pragma Inline (Repeat_Timeout); - pragma Inline (Add_Clipboard_Notify); pragma Inline (Remove_Clipboard_Notify); - pragma Inline (Add_File_Descriptor); pragma Inline (Remove_File_Descriptor); - pragma Inline (Add_Idle); pragma Inline (Has_Idle); pragma Inline (Remove_Idle); - 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); pragma Inline (Set_Alt_Background); pragma Inline (System_Colors); - pragma Inline (Font_Image); pragma Inline (Font_Family_Image); pragma Inline (Set_Font_Kind); pragma Inline (Font_Sizes); pragma Inline (Setup_Fonts); - pragma Inline (Get_Box_Height_Offset); pragma Inline (Get_Box_Width_Offset); pragma Inline (Get_Box_X_Offset); 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); pragma Inline (Set_Drag_Drop_Text_Support); - pragma Inline (Enable_System_Input); pragma Inline (Disable_System_Input); - pragma Inline (Has_Visible_Focus); - pragma Inline (Set_Visible_Focus); - pragma Inline (Default_Window_Close); pragma Inline (Get_First_Window); @@ -430,24 +566,29 @@ private pragma Inline (Get_Next_Window); pragma Inline (Get_Top_Modal); - pragma Inline (Read_Queue); - pragma Inline (Do_Widget_Deletion); - pragma Inline (Get_Scheme); pragma Inline (Set_Scheme); pragma Inline (Is_Scheme); pragma Inline (Reload_Scheme); - pragma Inline (Get_Option); pragma Inline (Set_Option); - pragma Inline (Get_Default_Scrollbar_Size); 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; + |