fpc/packages/gtk1/examples/gtkgldemo.pp

{$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 supported\n");
    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.