path: root/spec/fltk-static.ads

--  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;