1with C_String; 2with Interfaces.C; 3 4package body Agar.Core.Init is 5 package UB_Strings renames Ada.Strings.Unbounded; 6 package C renames Interfaces.C; 7 8 use type C.int; 9 use type C.unsigned; 10 11 procedure Get_Version 12 (Major : out Natural; 13 Minor : out Natural; 14 Patch : out Natural; 15 Release : out UB_Strings.Unbounded_String) 16 is 17 Version : aliased Thin.Core.Version_t; 18 begin 19 Thin.Core.Get_Version (Version'Unchecked_Access); 20 21 Major := Natural (Version.Major); 22 Minor := Natural (Version.Minor); 23 Patch := Natural (Version.Patch); 24 Release := UB_Strings.To_Unbounded_String (C_String.To_String (Version.Release)); 25 end Get_Version; 26 27 function Init_Flags_To_C_Flags 28 (Flags : in Init_Flags_t) return C.unsigned 29 is 30 C_Flags : C.unsigned := 0; 31 begin 32 for Index in Init_Flags_t'Range loop 33 if Flags (Index) then 34 case Index is 35 when Verbose => C_Flags := C_Flags or Thin.Core.AG_VERBOSE; 36 when Create_Data_Directory => C_Flags := C_Flags or Thin.Core.AG_CREATE_DATADIR; 37 when No_Config_Autoload => C_Flags := C_Flags or Thin.Core.AG_NO_CFG_AUTOLOAD; 38 end case; 39 end if; 40 end loop; 41 return C_Flags; 42 end Init_Flags_To_C_Flags; 43 44 function Init_Core 45 (Program_Name : in String; 46 Flags : in Init_Flags_t) return Boolean 47 is 48 Ch_Name : aliased C.char_array := C.To_C (Program_Name); 49 C_Flags : constant C.unsigned := Init_Flags_To_C_Flags (Flags); 50 begin 51 return 0 = Thin.Core.Init_Core 52 (Progname => C_String.To_C_String (Ch_Name'Unchecked_Access), 53 Flags => C_Flags); 54 end Init_Core; 55 56-- function Video_Flags_To_C_Flags 57-- (Flags : in Video_Flags_t) return C.unsigned 58-- is 59-- C_Flags : C.unsigned := 0; 60-- begin 61-- for Index in Video_Flags_t'Range loop 62-- if Video_Flags (Index) then 63-- case Index in 64-- when Video_Hardware_Surface => 65-- when Video_Asynchronous_Blit => 66-- when Video_Any_Format => 67-- when Video_Hardware_Palette => 68-- when Video_Double_Buffer => 69-- when Video_Fullscreen => 70-- when Video_Resizable => 71-- when Video_No_Frame => 72-- when Video_Background_Popup_Menu => 73-- when Video_OpenGL => 74-- when Video_OpenGL_Or_SDL => 75-- when Video_Overlay => 76-- end case; 77-- end if; 78-- end loop; 79-- return C_Flags; 80-- end Video_Flags_To_C_Flags; 81 82 -- 83 -- Proxy procedure to call 'Exit_Callback' from C. 84 -- 85 86 procedure At_Exit_Caller; 87 pragma Convention (C, At_Exit_Caller); 88 89 Exit_Callback : Exit_Procedure_t := null; 90 91 procedure At_Exit_Caller is 92 begin 93 if Exit_Callback /= null then 94 Exit_Callback.all; 95 end if; 96 end At_Exit_Caller; 97 98 procedure At_Exit 99 (Callback : Exit_Procedure_Not_Null_t) is 100 begin 101 Exit_Callback := Callback; 102 Thin.Core.At_Exit_Func (At_Exit_Caller'Access); 103 end At_Exit; 104 105end Agar.Core.Init; 106