From f2352c6df585d817b3613145ec81446f917dcc21 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sun, 2 Mar 2025 16:06:45 +1300 Subject: Filled holes in FLTK.Static API --- body/fltk-args_marshal.adb | 56 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) create mode 100644 body/fltk-args_marshal.adb (limited to 'body/fltk-args_marshal.adb') diff --git a/body/fltk-args_marshal.adb b/body/fltk-args_marshal.adb new file mode 100644 index 0000000..f9a5aaa --- /dev/null +++ b/body/fltk-args_marshal.adb @@ -0,0 +1,56 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Command_Line, + Interfaces.C.Strings; + + +package body FLTK.Args_Marshal is + + + package ACom renames Ada.Command_Line; + package IntC renames Interfaces.C; + package ICS renames Interfaces.C.Strings; + + + function Create_Argv + return ICS.chars_ptr_array + is + Result : ICS.chars_ptr_array (0 .. IntC.size_t (ACom.Argument_Count)); + begin + Result (0) := ICS.New_String (ACom.Command_Name); + for Index in Integer range 1 .. ACom.Argument_Count loop + Result (IntC.size_t (Index)) := ICS.New_String (ACom.Argument (Index)); + end loop; + return Result; + end Create_Argv; + + + procedure Free_Argv + (Argv : in out Interfaces.C.Strings.chars_ptr_array) is + begin + for Ptr of Argv loop + ICS.Free (Ptr); + end loop; + end Free_Argv; + + + procedure Dispatch + (Func : in Show_With_Args_Func; + CObj : in Storage.Integer_Address) + is + Argv : ICS.chars_ptr_array := Create_Argv; + begin + Func (CObj, Argv'Length, Storage.To_Integer (Argv (Argv'First)'Address)); + Free_Argv (Argv); + end Dispatch; + + +end FLTK.Args_Marshal; + + -- cgit