------------------------------------------------------------------------------ -- AGAR CORE LIBRARY -- -- A G A R . E R R O R -- -- B o d y -- -- -- -- Copyright (c) 2018-2019, Julien Nadeau Carriere (vedge@csoft.net) -- -- Copyright (c) 2010, coreland (mark@coreland.ath.cx) -- -- -- -- Permission to use, copy, modify, and/or distribute this software for any -- -- purpose with or without fee is hereby granted, provided that the above -- -- copyright notice and this permission notice appear in all copies. -- -- -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- ------------------------------------------------------------------------------ package body Agar.Error is function Get_Error return String is begin return C.To_Ada (CS.Value (AG_GetError)); end; procedure Set_Error (Message : in String) is Ch_Message : aliased C.char_array := C.To_C (Message); begin AG_SetErrorS (Message => CS.To_Chars_Ptr (Ch_Message'Unchecked_Access)); end; procedure Fatal_Error (Message : in String) is Ch_Message : aliased C.char_array := C.To_C (Message); begin AG_FatalError (Message => CS.To_Chars_Ptr (Ch_Message'Unchecked_Access)); end; -- -- Proxy procedure to call error callback from C code. -- Error_Callback_Fn : Error_Callback_Access := null; procedure Error_Callback_Proxy (Message : CS.chars_ptr) with Convention => C; procedure Error_Callback_Proxy (Message : CS.chars_ptr) is begin if Error_Callback_Fn /= null then Error_Callback_Fn.all (C.To_Ada (CS.Value (Message))); end if; end; procedure Set_Fatal_Callback (Callback : Error_Callback_Access) is begin Error_Callback_Fn := Callback; AG_SetFatalCallback (Error_Callback_Proxy'Access); end; end Agar.Error;