diff options
Diffstat (limited to 'spec/fltk-static.ads')
| -rw-r--r-- | spec/fltk-static.ads | 594 |
1 files changed, 594 insertions, 0 deletions
diff --git a/spec/fltk-static.ads b/spec/fltk-static.ads new file mode 100644 index 0000000..4f71244 --- /dev/null +++ b/spec/fltk-static.ads @@ -0,0 +1,594 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + FLTK.Labels, + FLTK.Widgets.Groups.Windows; + +private with + + 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; + + type Timeout_Handler is access procedure; + + + type Buffer_Kind is (Selection, Clipboard); + + type Clipboard_Notify_Handler is access procedure + (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; + + 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; + 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); + + + -- 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; + + procedure Unlock; + + + + + -- Pre-Eventloop Callbacks -- + + procedure Add_Check + (Func : in not null Timeout_Handler); + + function Has_Check + (Func : in not null Timeout_Handler) + return Boolean; + + procedure Remove_Check + (Func : in not null Timeout_Handler); + + + + + -- Timer Callbacks -- + + procedure Add_Timeout + (Seconds : in Long_Float; + Func : in not null Timeout_Handler); + + function Has_Timeout + (Func : in not null Timeout_Handler) + return Boolean; + + procedure Remove_Timeout + (Func : in not null Timeout_Handler); + + procedure Repeat_Timeout + (Seconds : in Long_Float; + Func : in not null Timeout_Handler); + + + + + -- Clipboard Callbacks -- + + procedure Add_Clipboard_Notify + (Func : in not null Clipboard_Notify_Handler); + + procedure Remove_Clipboard_Notify + (Func : in not null Clipboard_Notify_Handler); + + + + + -- File Descriptor Waiting Callbacks -- + + procedure Add_File_Descriptor + (FD : in File_Descriptor; + Func : in not null File_Handler); + + procedure Add_File_Descriptor + (FD : in File_Descriptor; + Mode : in File_Mode; + Func : in not null File_Handler); + + procedure Remove_File_Descriptor + (FD : in File_Descriptor); + + procedure Remove_File_Descriptor + (FD : in File_Descriptor; + Mode : in File_Mode); + + + + + -- Idle Callbacks -- + + procedure Add_Idle + (Func : in not null Idle_Handler); + + function Has_Idle + (Func : in not null Idle_Handler) + return Boolean; + + procedure Remove_Idle + (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 + (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 + (R, G, B : in Color_Component); + + procedure Set_Background + (R, G, B : in Color_Component); + + procedure Set_Alt_Background + (R, G, B : in Color_Component); + + procedure System_Colors; + + + + + -- Custom Fonts -- + + function Font_Image + (Kind : in Font_Kind) + return String; + + function Font_Family_Image + (Kind : in Font_Kind) + return String; + + procedure Set_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) + return Font_Size_Array; + + procedure Setup_Fonts + (How_Many_Set_Up : out Natural); + + + + + -- Box_Kind Attributes -- + + function Get_Box_Height_Offset + (Kind : in Box_Kind) + return Integer; + + function Get_Box_Width_Offset + (Kind : in Box_Kind) + return Integer; + + function Get_Box_X_Offset + (Kind : in Box_Kind) + return Integer; + + function Get_Box_Y_Offset + (Kind : in Box_Kind) + return Integer; + + procedure Set_Box_Kind + (To, From : in Box_Kind); + + function Draw_Box_Active + return Boolean; + + 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); + + + + + -- 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; + Dest : in Buffer_Kind); + + procedure Paste + (Receiver : in FLTK.Widgets.Widget'Class; + Source : in Buffer_Kind); + + procedure Selection + (Owner : in FLTK.Widgets.Widget'Class; + Text : in String); + + function Clipboard_Contains + (Kind : in String) + return Boolean; + + + + + -- Dragon Drop -- + + procedure Drag_Drop_Start; + + function Get_Drag_Drop_Text_Support + return Boolean; + + procedure Set_Drag_Drop_Text_Support + (To : in Boolean); + + + + + -- Input Methods -- + + procedure Enable_System_Input; + + procedure Disable_System_Input; + + + + + -- Windows -- + + procedure Default_Window_Close + (Item : in out FLTK.Widgets.Widget'Class); + + function Get_First_Window + return access FLTK.Widgets.Groups.Windows.Window'Class; + + procedure Set_First_Window + (To : in FLTK.Widgets.Groups.Windows.Window'Class); + + function Get_Next_Window + (From : in FLTK.Widgets.Groups.Windows.Window'Class) + return access FLTK.Widgets.Groups.Windows.Window'Class; + + function Get_Top_Modal + return access FLTK.Widgets.Groups.Windows.Window'Class; + + + + + -- Queue -- + + function Read_Queue + return access FLTK.Widgets.Widget'Class; + + + + + -- Schemes -- + + function Get_Scheme + return String; + + procedure Set_Scheme + (To : in String); + + function Is_Scheme + (Scheme : in String) + return Boolean; + + procedure Reload_Scheme; + + + + + -- Library Options -- + + function Get_Option + (Opt : in Option) + return Boolean; + + procedure Set_Option + (Opt : in Option; + To : in Boolean); + + + + + -- Scrollbars -- + + function Get_Default_Scrollbar_Size + return Natural; + + procedure Set_Default_Scrollbar_Size + (To : in Natural); + + +private + + + 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, 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 (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 (Default_Window_Close); + pragma Inline (Get_First_Window); + pragma Inline (Set_First_Window); + pragma Inline (Get_Next_Window); + pragma Inline (Get_Top_Modal); + + pragma Inline (Read_Queue); + + 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; + + |