[gtkada] More newbie stuff
Michael Andersson
a98mican at ida.his.se
Tue Apr 17 18:40:39 CEST 2001
Hi (again) ! :-)
I've included the code this time to make it more clear to what I'm
after.
Update is the Idle-callback function and I want it to call Display after
it is done with the update.
As I see it I have two choises:
Either I redraw the widget or I can pass an expose_event to the
Gtk_Glarea -widget.
Can somebody please show me how to do this?
Thanks!
/Michael Andersson
with Ada.Text_IO; use Ada.Text_IO;
with GL_H; use GL_H;
with Gdk.Event; use Gdk.Event;
with Gdk.GL; use Gdk.GL;
with Gdk.Types; use Gdk.Types;
with Gdk.Window; use Gdk.Window;
with Glib; use Glib;
with Glu_H; use Glu_H;
with Gtk.Glarea; use Gtk.Glarea;
with Gtk.Handlers; use Gtk.Handlers;
with Gtk.Main; use Gtk.Main;
with Gtk.Widget; use Gtk.Widget;
package body Setup_GL is
--type MyGLArea is access all Gtk_Glarea_Record;
package EventRCB is new Gtk.Handlers.Return_Callback
(Gtk_Glarea_Record, Boolean);
package EventCB is new Gtk.Handlers.Callback (Gtk_Glarea_Record);
package MyIdle is new Gtk.Main.Idle(Gtk_glarea);
function Init(Area : access Gtk_Glarea_Record'Class)
return Boolean is
begin
if Make_Current(Area) then
Glclearcolor(0.0,0.0,0.0,0.0);
Glenable(GL_DEPTH_TEST);
Glshademodel(GL_SMOOTH);
end if;
return True;
end Init;
function Display (Area : access Gtk_Glarea_Record'Class;
Event : Gdk_Event)
return Boolean is
begin
if Get_Count(Event) > 0 then
return True;
end if;
if Make_Current(Area) then
Put_Line("Display");
Glclear(GL_COLOR_BUFFER_BIT);
Glclear(GL_DEPTH_BUFFER_BIT);
Glloadidentity;
Gltranslatef(0.0,0.0,-15.0);
Glbegin(GL_QUADS);
Glvertex3f(-2.0,0.0,0.0);
Glvertex3f(-2.0,2.0,0.0);
Glvertex3f(2.0,2.0,0.0);
Glvertex3f(2.0,0.0,0.0);
Glend;
Swap_Buffers(Area);
end if;
return True;
end Display;
function Reshape (Area : access Gtk_Glarea_Record'Class;
Event : Gdk_Event)
return Boolean is
Window : Gdk.Window.Gdk_Window;
Width : Gint;
Height : Gint;
begin
if Make_Current(Area) then
Window := Get_Window(Event);
Get_Size(Window,Width,Height);
Glviewport(0,0,Integer(Width),Integer(Height));
Glmatrixmode(GL_PROJECTION);
Glloadidentity;
Gluperspective(Long_Float (45.0),Long_Float(Width/Height),
1.0,100.0);
Glmatrixmode(GL_MODELVIEW);
Glloadidentity;
end if;
return True;
end Reshape;
procedure GlArea_Destroy (Area : access Gtk_Glarea_Record'Class)
is
begin
Put_Line("Destroy called");
end GlArea_Destroy;
function Update(Area : Gtk_GLArea) return Boolean is
begin
return True;
end Update;
procedure Setup (Window : access Gtk_Window_Record'Class) is
Area : Gtk_Glarea;
Id : Idle_Handler_Id;
begin
if not Gdk.GL.Query then
Put_Line ("OpenGL not supported");
return;
end if;
Gtk_New(Area, (GDK_GL_RGBA,
GDK_GL_RED_SIZE, Gl_Configs (1),
GDK_GL_GREEN_SIZE, Gl_Configs (1),
GDK_GL_BLUE_SIZE, Gl_Configs (1),
GDK_GL_DOUBLEBUFFER,
GDK_GL_DEPTH_SIZE, Gl_Configs (1)));
if Area = null then
Put_Line ("Can't create Gtk_GLArea widget");
return;
end if;
Set_Events (Area, Exposure_Mask);
EventRCB.Connect (Area, "realize",
EventRCB.To_Marshaller (Init'Access));
EventRCB.Connect (Area, "expose_event",
EventRCB.To_Marshaller (Display'Access));
EventRCB.Connect(Area, "configure_event",
EventRCB.To_Marshaller (Reshape'Access));
EventCB.Connect (Area, "destroy",
EventCB.To_Marshaller (Glarea_Destroy'Access));
Id := MyIdle.Add(Update'Access, Area);
Add (Window, Area);
Show_All (Window);
end Setup;
end Setup_GL;
More information about the gtkada
mailing list