1. ------------------------------------------------------------------------- 
  2.  --  GL.Errors - GL error support 
  3.  -- 
  4.  --  Copyright (c) Rod Kay 2007 
  5.  --  AUSTRALIA 
  6.  --  Permission granted to use this software, without any warranty, 
  7.  --  for any purpose, provided this copyright note remains attached 
  8.  --  and unmodified if sources are distributed further. 
  9.  ------------------------------------------------------------------------- 
  10.  
  11. with Ada.Text_IO;              use Ada.Text_IO; 
  12. with Ada.Unchecked_Conversion; 
  13. with GLU; 
  14. with Interfaces.C.Strings;     use Interfaces.C.Strings; 
  15.  
  16. package body GL.Errors is 
  17.  
  18.    function Current return String is 
  19.  
  20.       function to_chars_ptr is new Ada.Unchecked_Conversion (GL.ubytePtr, chars_ptr); 
  21.  
  22.    begin 
  23.       return Value (to_chars_ptr (GLU.Error_String (GL.Get_Error))); 
  24.    end Current; 
  25.  
  26.    procedure log (Prefix : String := "") is 
  27.  
  28.       Current_GL_Error : constant String := Current; 
  29.  
  30.    begin 
  31.       if Current_GL_Error /= "no error" then 
  32.          case Prefix = "" is 
  33.             when True  => Put_Line ("openGL error : '" & Current_GL_Error & "'"); 
  34.             when False => Put_Line (Prefix &    " : '" & Current_GL_Error & "'"); 
  35.          end case; 
  36.  
  37.          raise openGL_Error;  -- tbd : use ada.exceptions to attach the openg error string to the exception. 
  38.       end if; 
  39.    end log; 
  40.  
  41.    procedure log (Prefix : String := ""; error_Occurred : out Boolean) is 
  42.  
  43.       Current_GL_Error  : constant String := Current; 
  44.  
  45.    begin 
  46.       error_Occurred := Current_GL_Error /= "no error"; 
  47.       if error_Occurred then 
  48.          case Prefix = "" is 
  49.             when True  => Put_Line ("openGL error : '" & Current_GL_Error & "'"); 
  50.             when False => Put_Line (Prefix &    " : '" & Current_GL_Error & "'"); 
  51.          end case; 
  52.       end if; 
  53.    end log; 
  54.  
  55. end GL.Errors;