{$MODE DELPHI}
 
{$ifdef win32}
  {$APPTYPE GUI}
{$endif}
 
program gtkgldemo;
 
uses  glib, gdk, gtk, gtkglarea,gl;
 
 
function init(widget:PGtkWidget ):gint;cdecl;
 
begin
  if (gint(True)=gtk_gl_area_make_current(PGtkGLArea(widget))) then
    begin
 
      glViewport(0,0, widget^.allocation.width, widget^.allocation.height);
      glMatrixMode(GL_PROJECTION);
      glLoadIdentity();
      glOrtho(0,100, 100,0, -1,1);
      glMatrixMode(GL_MODELVIEW);
      glLoadIdentity();
 
    end;
 
  init:= gint(TRUE);
end;
 
 
 
 
(* When widget is exposed its contents are redrawn. *)
 
function draw(widget: PGtkWidget; event: PGdkEventExpose): gint; cdecl;
 
begin
 
  (* Draw only last expose. *)
  if (event^.count > 0) then
    exit(gint(TRUE));
 
  (* OpenGL functions can be called only if make_current returns true *)
  if (gint(True) = gtk_gl_area_make_current(PGtkGLArea(widget))) then
    begin
 
     glClearColor(0,0,0,1);
     glClear(GL_COLOR_BUFFER_BIT);
     glColor3f(1,1,1);
     glBegin(GL_TRIANGLES);
     glVertex2f(10,10);
     glVertex2f(10,90);
     glVertex2f(90,90);
     glEnd();
 
     (* Swap backbuffer to front *)
     gtk_gl_area_swapbuffers(PGtkGLArea(widget));
 
    end;
 
  exit(gint(TRUE));
end;
 
(* When glarea widget size changes, viewport size is set to match the new size *)
 
function  reshape(widget:PGtkWidget; event: PGdkEventConfigure):gint; cdecl;
begin
 
  (* OpenGL functions can be called only if make_current returns true *)
  if (gint(True) = gtk_gl_area_make_current(PGtkGLArea(widget))) then
    begin
 
     glViewport(0, 0, widget^.allocation.width, widget^.allocation.height);
 
    end;
  exit( gint(TRUE));
end;
 
var
   window,glarea: PGtkWidget;
 
  (* Attribute list for gtkglarea widget. Specifies a
     list of Boolean attributes and enum/integer
     attribute/value pairs. The last attribute must be
     GDK_GL_NONE. See glXChooseVisual manpage for further
     explanation.
  *)
 
  const
     attrlist: array [1..11] of LongInt=
                    ( GDK_GL_RGBA,
                    GDK_GL_RED_SIZE, 1,
                    GDK_GL_GREEN_SIZE, 1,
                    GDK_GL_BLUE_SIZE, 1,
                      GDK_GL_DEPTH_SIZE,1,
                    GDK_GL_DOUBLEBUFFER,
                    GDK_GL_None
                    );
 
(*  int attrlist[] = {
    GDK_GL_RGBA,
    GDK_GL_RED_SIZE,1,
    GDK_GL_GREEN_SIZE,1,
    GDK_GL_BLUE_SIZE,1,
    GDK_GL_DOUBLEBUFFER,
    GDK_GL_NONE
  };
*)
 
begin
  (* OpenGL functions can be called only if make_current returns true *)
{  if not InitGl then begin
    WriteLn('OpenGL is not supported on this system');
    Halt(2);
  end;}
 
 
  (* initialize gtk *)
  gtk_init(@argc, @argv);
 
  (* Attribute list for gtkglarea widget. Specifies a
      list of Boolean attributes and enum/integer
      attribute/value pairs. The last attribute must be
      GDK_GL_NONE. See glXChooseVisual manpage for further
      explanation.
   *)
 
 
  (* vendor dependent version info string *)
 { info_str = gdk_gl_get_info();
  g_print(info_str);
  g_free(info_str);}
 
  (* Check if OpenGL is supported. *)
 { if (gdk_gl_query() = FALSE) then
  begin
    g_print("OpenGL not supportedn");
    return 0;
  end;}
 
 
 
 
  (* Create new top level window. *)
    window := gtk_window_new( GTK_WINDOW_TOPLEVEL);
    gtk_window_set_title(GTK_WINDOW(window), 'OpenGL Output');
  gtk_container_set_border_width(GTK_CONTAINER(window), 10);
 
  (* Quit form main if got delete event *)
    gtk_signal_connect(GTK_OBJECT(window), 'delete_event',
                     GTK_SIGNAL_FUNC(@gtk_main_quit), NULL);
 
 
  (* You should always delete gtk_gl_area widgets before exit or else
       GLX contexts are left undeleted, this may cause problems (=core dump)
       in some systems.
       Destroy method of objects is not automatically called on exit.
       You need to manually enable this feature. Do gtk_quit_add_destroy()
       for all your top level windows unless you are certain that they get
       destroy signal by other means.
    *)
    gtk_quit_add_destroy(1, GTK_OBJECT(window));
 
 
    (* Create new OpenGL widget. *)
  glarea := GTK_WIDGET(gtk_gl_area_new(pgint(@attrlist)));
 
  (* Events for widget must be set before X Window is created *)
    gtk_widget_set_events(GTK_WIDGET(glarea),
                        GDK_EXPOSURE_MASK or
                        GDK_BUTTON_PRESS_MASK);
 
    (* Connect signal handlers *)
    (* Redraw image when exposed. *)
    gtk_signal_connect(GTK_OBJECT(glarea), 'expose_event', GTK_SIGNAL_FUNC(@draw), Nil);
 
    (* When window is resized viewport needs to be resized also. *)
    gtk_signal_connect(GTK_OBJECT(glarea), 'configure_event', GTK_SIGNAL_FUNC(@reshape), Nil);
 
    (* Do initialization when widget has been realized. *)
    gtk_signal_connect(GTK_OBJECT(glarea), 'realize', GTK_SIGNAL_FUNC(@init), Nil);
 
    (* set minimum size *)
    gtk_widget_set_usize(GTK_WIDGET(glarea), 400,400);
 
    (* put glarea into window and show it all *)
    gtk_container_add(GTK_CONTAINER(window),GTK_WIDGET(glarea));
 
 
    gtk_widget_show(GTK_WIDGET(glarea));
 
    gtk_widget_show(GTK_WIDGET(window));
 
  gtk_main();
 
end.