1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196

{$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.