File : win32-glut.adb

     
     -- Copyright (c) Mark J. Kilgard, 1994, 1995, 1996, 1998.
     
     -- This program is freely distributable without licensing fees  and is
   5 -- provided without guarantee or warrantee expressed or  implied. This
     -- program is -not- in the public domain.
     
     --  modified for GNAT 3.11p/NT & Glut 3.7
     --  Jerry van Dijk, 22-feb-99, jdijk@acm.org
  10 --  use with accompanying DLL only
     --
     --  modified again for GNAT 3.14/NT & Glut 3.76
     --  Gene Ressler, 22-jan-03, ressler@usma.edu
     --  use with accompanying DLL only
  15 
     package body Win32.Glut is
     
        pragma Linker_Options ("-lopengl32");
        pragma Linker_Options ("-lglu32");
  20    pragma Linker_Options ("-lglut32");
     
        procedure glutInitDisplayString(
           the_string : String
        )
  25    is
          C_the_string : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(the_string);
        begin
          glutInitDisplayString(C_the_string);
  30      Interfaces.C.Strings.Free(C_the_string);
        end glutInitDisplayString;
     
        function glutCreateWindow(
           title : String
  35    ) return Integer
        is
          Rtn : Integer;
          C_title : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(title);
  40    begin
          Rtn := glutCreateWindow(C_title);
          Interfaces.C.Strings.Free(C_title);
          return Rtn;
        end glutCreateWindow;
  45 
        procedure glutSetWindowTitle(
           title : String
        )
        is
  50      C_title : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(title);
        begin
          glutSetWindowTitle(C_title);
          Interfaces.C.Strings.Free(C_title);
  55    end glutSetWindowTitle;
     
        procedure glutSetIconTitle(
           title : String
        )
  60    is
          C_title : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(title);
        begin
          glutSetIconTitle(C_title);
  65      Interfaces.C.Strings.Free(C_title);
        end glutSetIconTitle;
     
        procedure glutAddMenuEntry(
           label : String;
  70       value : Integer
        )
        is
          C_label : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(label);
  75    begin
          glutAddMenuEntry(C_label, value);
          Interfaces.C.Strings.Free(C_label);
        end glutAddMenuEntry;
     
  80    procedure glutAddSubMenu(
           label : String;
           submenu : Integer
        )
        is
  85      C_label : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(label);
        begin
          glutAddSubMenu(C_label, submenu);
          Interfaces.C.Strings.Free(C_label);
  90    end glutAddSubMenu;
     
        procedure glutChangeToMenuEntry(
           item : Integer;
           label : String;
  95       value : Integer
        )
        is
          C_label : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(label);
 100    begin
          glutChangeToMenuEntry(item, C_label, value);
          Interfaces.C.Strings.Free(C_label);
        end glutChangeToMenuEntry;
     
 105    procedure glutChangeToSubMenu(
           item : Integer;
           label : String;
           submenu : Integer
        )
 110    is
          C_label : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(label);
        begin
          glutChangeToSubMenu(item, C_label, submenu);
 115      Interfaces.C.Strings.Free(C_label);
        end glutChangeToSubMenu;
     
        function glutExtensionSupported(
           name : String
 120    ) return Integer
        is
          Rtn : Integer;
          C_name : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(name);
 125    begin
          Rtn := glutExtensionSupported(C_name);
          Interfaces.C.Strings.Free(C_name);
          return Rtn;
        end glutExtensionSupported;
 130 
        function glutBitmapLength(
           font : System.Address;
           the_string : String
        ) return Integer
 135    is
          Rtn : Integer;
          C_the_string : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(the_string);
        begin
 140      Rtn := glutBitmapLength(font, C_the_string);
          Interfaces.C.Strings.Free(C_the_string);
          return Rtn;
        end glutBitmapLength;
     
 145    function glutStrokeLength(
           font : System.Address;
           the_string : String
        ) return Integer
        is
 150      Rtn : Integer;
          C_the_string : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(the_string);
        begin
          Rtn := glutStrokeLength(font, C_the_string);
 155      Interfaces.C.Strings.Free(C_the_string);
          return Rtn;
        end glutStrokeLength;
     
        procedure glutGameModeString(
 160       the_string : String
        )
        is
          C_the_string : Interfaces.C.Strings.Chars_Ptr
             := Interfaces.C.Strings.New_String(the_string);
 165    begin
          glutGameModeString(C_the_string);
          Interfaces.C.Strings.Free(C_the_string);
        end glutGameModeString;
     end Win32.Glut;