path: root/src/fltk.adb

with

    Interfaces.C,
    System;

use type

    Interfaces.C.int,
    Interfaces.C.unsigned_long,
    System.Address;


package body FLTK is


    function fl_abi_check
           (V : in Interfaces.C.int)
        return Interfaces.C.int;
    pragma Import (C, fl_abi_check, "fl_abi_check");
    pragma Inline (fl_abi_check);

    function fl_abi_version
        return Interfaces.C.int;
    pragma Import (C, fl_abi_version, "fl_abi_version");
    pragma Inline (fl_abi_version);

    function fl_api_version
        return Interfaces.C.int;
    pragma Import (C, fl_api_version, "fl_api_version");
    pragma Inline (fl_api_version);

    function fl_version
        return Interfaces.C.double;
    pragma Import (C, fl_version, "fl_version");
    pragma Inline (fl_version);




    function fl_get_damage
        return Interfaces.C.int;
    pragma Import (C, fl_get_damage, "fl_get_damage");
    pragma Inline (fl_get_damage);

    procedure fl_set_damage
           (V : in Interfaces.C.int);
    pragma Import (C, fl_set_damage, "fl_set_damage");
    pragma Inline (fl_set_damage);




    function fl_check
        return Interfaces.C.int;
    pragma Import (C, fl_check, "fl_check");
    pragma Inline (fl_check);

    function fl_ready
        return Interfaces.C.int;
    pragma Import (C, fl_ready, "fl_ready");
    pragma Inline (fl_ready);

    function fl_wait
        return Interfaces.C.int;
    pragma Import (C, fl_wait, "fl_wait");
    pragma Inline (fl_wait);

    function fl_wait2
           (S : in Interfaces.C.double)
        return Interfaces.C.int;
    pragma Import (C, fl_wait2, "fl_wait2");
    pragma Inline (fl_wait2);

    function fl_run
        return Interfaces.C.int;
    pragma Import (C, fl_run, "fl_run");
    pragma Inline (fl_run);




    function Is_Valid
           (Object : in Wrapper)
        return Boolean is
    begin
        return Object.Void_Ptr /= System.Null_Address;
    end Is_Valid;


    procedure Initialize
           (This : in out Wrapper) is
    begin
        This.Void_Ptr := System.Null_Address;
    end Initialize;




    function Press
           (Key : in Pressable_Key)
        return Keypress is
    begin
        return Character'Pos (Key);
    end Press;


    function Press
           (Key : Pressable_Key)
        return Key_Combo is
    begin
        return This : Key_Combo do
            This.Modcode := Mod_None;
            This.Keycode := Character'Pos (Key);
            This.Mousecode := No_Button;
        end return;
    end Press;


    function Press
           (Key : in Keypress)
        return Key_Combo is
    begin
        return This : Key_Combo do
            This.Modcode := Mod_None;
            This.Keycode := Key;
            This.Mousecode := No_Button;
        end return;
    end Press;


    function Press
           (Key : in Mouse_Button)
        return Key_Combo is
    begin
        return This : Key_Combo do
            This.Modcode := Mod_None;
            This.Keycode := 0;
            This.Mousecode := Key;
        end return;
    end Press;




    function "+"
           (Left, Right : in Modifier)
        return Modifier is
    begin
        return Left or Right;
    end "+";


    function "+"
           (Left  : in Modifier;
            Right : in Pressable_Key)
        return Key_Combo is
    begin
        return This : Key_Combo do
            This.Modcode := Left;
            This.Keycode := Character'Pos (Right);
            This.Mousecode := No_Button;
        end return;
    end "+";


    function "+"
           (Left : in Modifier;
            Right : in Keypress)
        return Key_Combo is
    begin
        return This : Key_Combo do
            This.Modcode := Left;
            This.Keycode := Right;
            This.Mousecode := No_Button;
        end return;
    end "+";


    function "+"
           (Left : in Modifier;
            Right : in Mouse_Button)
        return Key_Combo is
    begin
        return This : Key_Combo do
            This.Modcode := Left;
            This.Keycode := 0;
            This.Mousecode := Right;
        end return;
    end "+";


    function "+"
           (Left  : in Modifier;
            Right : in Key_Combo)
        return Key_Combo is
    begin
        return This : Key_Combo do
            This.Modcode := Left or Right.Modcode;
            This.Keycode := Right.Keycode;
            This.Mousecode := Right.Mousecode;
        end return;
    end "+";




    function To_C
           (Key : in Key_Combo)
        return Interfaces.C.unsigned_long is
    begin
        return To_C (Key.Modcode) + To_C (Key.Keycode) + To_C (Key.Mousecode);
    end To_C;


    function To_Ada
           (Key : in Interfaces.C.unsigned_long)
        return Key_Combo is
    begin
        return Result : Key_Combo do
            Result.Modcode := To_Ada (Key);
            Result.Keycode := To_Ada (Key);
            Result.Mousecode := To_Ada (Key);
        end return;
    end To_Ada;


    function To_C
           (Key : in Keypress)
        return Interfaces.C.unsigned_long is
    begin
        return Interfaces.C.unsigned_long (Key);
    end To_C;


    function To_Ada
           (Key : in Interfaces.C.unsigned_long)
        return Keypress is
    begin
        return Keypress (Key mod 65536);
    end To_Ada;


    function To_C
           (Modi : in Modifier)
        return Interfaces.C.unsigned_long is
    begin
        return Interfaces.C.unsigned_long (Modi) * 65536;
    end To_C;


    function To_Ada
           (Modi : in Interfaces.C.unsigned_long)
        return Modifier is
    begin
        return Modifier ((Modi / 65536) mod 256);
    end To_Ada;


    function To_C
           (Button : in Mouse_Button)
        return Interfaces.C.unsigned_long is
    begin
        case Button is
            when Left_Button => return 1 * (256 ** 3);
            when Middle_Button => return 2 * (256 ** 3);
            when Right_Button => return 4 * (256 ** 3);
            when others => return 0;
        end case;
    end To_C;


    function To_Ada
           (Button : in Interfaces.C.unsigned_long)
        return Mouse_Button is
    begin
        case (Button / (256 ** 3)) is
            when 1 => return Left_Button;
            when 2 => return Middle_Button;
            when 4 => return Right_Button;
            when others => return No_Button;
        end case;
    end To_Ada;




    function "+"
           (Left, Right : in Menu_Flag)
        return Menu_Flag is
    begin
        return Left or Right;
    end "+";




    function ABI_Check
           (ABI_Ver : in Version_Number)
        return Boolean is
    begin
        return fl_abi_check (Interfaces.C.int (ABI_Ver)) /= 0;
    end ABI_Check;


    function ABI_Version
        return Version_Number is
    begin
        return Version_Number (fl_abi_version);
    end ABI_Version;


    function API_Version
        return Version_Number is
    begin
        return Version_Number (fl_api_version);
    end API_Version;


    function Version
        return Version_Number is
    begin
        return Version_Number (fl_version);
    end Version;




    function Is_Damaged
        return Boolean is
    begin
        return fl_get_damage /= 0;
    end Is_Damaged;


    procedure Set_Damaged
           (To : in Boolean) is
    begin
        fl_set_damage (Boolean'Pos (To));
    end Set_Damaged;




    function Check
        return Boolean is
    begin
        return fl_check /= 0;
    end Check;


    function Ready
        return Boolean is
    begin
        return fl_ready /= 0;
    end Ready;


    function Wait
        return Integer is
    begin
        return Integer (fl_wait);
    end Wait;


    function Wait
           (Seconds : in Long_Float)
        return Integer is
    begin
        return Integer (fl_wait2 (Interfaces.C.double (Seconds)));
    end Wait;


    function Run
        return Integer is
    begin
        return Integer (fl_run);
    end Run;


end FLTK;