MG: imported gtkglarea component

git-svn-id: trunk@336 -

.gitattributes

@@ -1,4 +1,8 @@
 * text=auto !eol
+components/gtk/gtkglarea/exampleform.pp svneol=native#text/pascal
+components/gtk/gtkglarea/gtkglarea.pp svneol=native#text/pascal
+components/gtk/gtkglarea/gtkglarea_demo.pp svneol=native#text/pascal
+components/gtk/gtkglarea/gtkglarea_int.pp svneol=native#text/pascal
 components/synedit/allunits.pp svneol=native#text/pascal
 components/synedit/syncompletion.pas svneol=native#text/pascal
 components/synedit/synedit.inc svneol=native#text/pascal

components/gtk/gtkglarea/Makefile.fpc

@@ -0,0 +1,46 @@
+#   $Id$
+#
+#   Makefile.fpc for Lazarus TGTKGLAreaControl for Free Pascal
+#
+
+[package]
+#name=lazarus-gtkglarea
+name=lazarus
+version=0.7a
+
+[target]
+units=gtkglarea_int gtkglarea exampleform gtkglarea_demo
+   
+
+[default]
+            
+[compiler]
+options=-gl -k-lGL
+unitdir=. ../../../lcl/units ../../../lcl/units/gtk
+
+[require]
+packages=rtl fcl gtk opengl
+
+[clean]
+files=gtkglarea_demo
+
+[install]
+
+[dist]
+zipname=lazarus.gtkglarea.$(ZIPSUFFIX)
+
+[rules]
+.PHONY: cleartarget all makefile makefiles
+
+cleartarget:
+        -$(DEL) gtkglarea_demo
+
+all: cleartarget gtkglarea_demo$(PPUEXT)
+        -$(DEL) *$(PPUEXT)
+
+makefile: Makefile.fpc
+        -$(FPCMAKE) -w
+       
+makefiles: makefile
+
+# end.

components/gtk/gtkglarea/exampleform.pp

@@ -0,0 +1,133 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+}
+unit ExampleForm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, GTKGlArea, Forms, LResources, Buttons, StdCtrls,
+  gtkglarea_int, gtk, glib, gl;
+
+type
+  TExampleForm = class(TForm)
+    GTKGLAreaControl1: TGTKGLAreaControl;
+    ExitButton1: TButton;
+    HintLabel1: TLabel;
+    procedure ExitButton1Click(Sender: TObject);
+    procedure GTKGLAreaControl1Paint(Sender: TObject);
+    procedure GTKGLAreaControl1Resize(Sender: TObject);
+  public
+    constructor Create(AOwner: TComponent); override;
+  private
+    AreaInitialized: boolean;
+  end;
+  
+var AnExampleForm: TExampleForm;
+
+implementation
+
+constructor TExampleForm.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  if LazarusResources.Find(ClassName)=nil then begin
+    SetBounds((Screen.Width-400) div 2,(Screen.Height-300) div 2,400,300);
+    Caption:='LCL Example for the gtkglarea component';
+    
+    ExitButton1:=TButton.Create(Self);
+    with ExitButton1 do begin
+      Name:='ExitButton1';
+      Parent:=Self;
+      SetBounds(300,10,80,25);
+      Caption:='Exit';
+      OnClick:=@ExitButton1Click;
+      Visible:=true;
+    end;
+    
+    HintLabel1:=TLabel.Create(Self);
+    with HintLabel1 do begin
+      Name:='HintLabel1';
+      Parent:=Self;
+      SetBounds(10,10,280,50);
+      Caption:='Demo';
+      Visible:=true;
+    end;
+    
+    AreaInitialized:=false;
+    GTKGLAreaControl1:=TGTKGLAreaControl.Create(Self);
+    with GTKGLAreaControl1 do begin
+      Name:='GTKGLAreaControl1';
+      Parent:=Self;
+      SetBounds(10,90,380,200);
+      OnPaint:=@GTKGLAreaControl1Paint;
+      OnResize:=@GTKGLAreaControl1Resize;
+      Visible:=true;
+    end;
+  end;
+end;
+
+procedure TExampleForm.ExitButton1Click(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TExampleForm.GTKGLAreaControl1Paint(Sender: TObject);
+begin
+  if (gint(True) = gtk_gl_area_make_current(GTKGLAreaControl1.Widget)) then
+  begin
+    if not AreaInitialized then begin
+      glViewport(0,0, PGtkWidget(GTKGLAreaControl1.Widget)^.allocation.width,
+        PGtkWidget(GTKGLAreaControl1.Widget)^.allocation.height);
+      glMatrixMode(GL_PROJECTION);
+      glLoadIdentity();
+      glFrustum( -20.0, 20.0, -20.0, 20.0, 1.0, 145.0 );
+      glMatrixMode(GL_MODELVIEW);
+      glLoadIdentity();
+      glTranslatef(0, 0, -5.5);
+      AreaInitialized:=true;
+    end;
+
+    glClearColor(0,0,0,1);
+    glClear(GL_COLOR_BUFFER_BIT);
+    glColor3f(1,0,1);
+    glBegin(GL_TRIANGLES);
+    glVertex3f(10,10,-2);
+    glColor3f(0,1,1);
+    glVertex3f(10,90,-1);
+    glColor3f(0,1,0);
+    glVertex3f(90,90,-2);
+    glEnd();
+
+    // Swap backbuffer to front
+    gtk_gl_area_swap_buffers(PGtkGLArea(GTKGLAreaControl1.Widget));
+  end;
+end;
+
+procedure TExampleForm.GTKGLAreaControl1Resize(Sender: TObject);
+begin
+  if (gint(True) = gtk_gl_area_make_current(GTKGLAreaControl1.widget)) then
+    glViewport(0, 0, PGtkWidget(GTKGLAreaControl1.Widget)^.allocation.width,
+      PGtkWidget(GTKGLAreaControl1.Widget)^.allocation.height);
+end;
+
+end.

components/gtk/gtkglarea/gtkglarea.pp

@@ -0,0 +1,148 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+}
+unit gtkglarea;
+
+{$MODE objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, VCLGlobals, LCLLinux, glib, gdk, gtk, gtkglarea_int, gl,
+  Controls, gtkint, gtkwinapiwindow, LMessages;
+  
+type
+  TCustomGTKGLAreaControl = class(TWinControl)
+  protected
+    function GetWidget: PGtkGLArea;
+    procedure CreateWnd; override;
+    procedure AttachSignals; override;
+  public
+    property Widget: PGtkGLArea read GetWidget;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+  
+  TGTKGLAreaControl = class(TCustomGTKGLAreaControl)
+  published
+  end;
+
+implementation
+
+{ TCustomGTKGLArea }
+
+const
+   InitAttrList: 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
+                    );  
+
+constructor TCustomGTKGLAreaControl.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetBounds(1, 1, 75, 25);
+end;
+
+destructor TCustomGTKGLAreaControl.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TCustomGTKGLAreaControl.GetWidget: PGtkGLArea;
+begin
+  if HandleAllocated then
+    Result:=PGtkGLArea(Handle)
+  else
+    Result:=nil;
+end;
+
+procedure TCustomGTKGLAreaControl.CreateWnd;
+var
+  Params: TCreateParams;
+begin
+  CreateParams(Params);
+  with Params do begin
+    if (WndParent = 0) and (Style and WS_CHILD <> 0) then exit;
+  end;
+  
+  Handle := longint(gtk_gl_area_new(pgint(@InitAttrList)));
+  if Widget <> nil then begin
+    gtk_object_set_data(pgtkobject(Widget),'Sender',Self);
+    gtk_object_set_data(pgtkobject(Widget), 'Class', Pointer(Self));
+    gtk_object_set_data(pgtkObject(Widget),'Style',0);
+    gtk_object_set_data(pgtkObject(Widget),'ExStyle',0);
+  end else begin
+    writeln('Creation of gtkglarea failed.');
+    Halt(1);
+  end;
+  if Parent <> nil then AddControl;
+  
+  AttachSignals;
+  InitializeWnd;
+end;
+
+procedure TCustomGTKGLAreaControl.AttachSignals;
+begin
+  // Attach callbacks
+  SetCallback(LM_DESTROY);
+  SetCallback(LM_SHOWWINDOW);
+  SetCallback(LM_FOCUS);
+  SetCallback(LM_WINDOWPOSCHANGED);
+  SetCallback(LM_PAINT);
+  SetCallback(LM_EXPOSEEVENT);
+  SetCallback(LM_KEYDOWN);
+  SetCallback(LM_KEYUP);
+  SetCallback(LM_CHAR);
+  SetCallback(LM_MOUSEMOVE);
+  SetCallback(LM_LBUTTONDOWN); 
+  SetCallback(LM_LBUTTONUP); 
+  SetCallback(LM_RBUTTONDOWN);
+  SetCallback(LM_RBUTTONUP);
+  SetCallback(LM_MBUTTONDOWN);
+  SetCallback(LM_MBUTTONUP); 
+  SetCallback(LM_MOUSEWHEEL);
+end;
+
+//-----------------------------------------------------------------------------
+
+procedure InternalInit;
+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;
+end;
+
+
+initialization
+
+InternalInit;
+
+finalization
+
+
+end.

components/gtk/gtkglarea/gtkglarea_demo.pp

@@ -0,0 +1,33 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+}
+program gtkglarea_demo;
+
+{$MODE objfpc}{$H+}
+
+uses
+  Classes, SysUtils, Forms, ExampleForm;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TExampleForm, AnExampleForm);
+  Application.Run;
+end.

components/gtk/gtkglarea/gtkglarea_int.pp

@@ -0,0 +1,196 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+}
+unit gtkglarea_int;
+
+{$mode objfpc}{$H+}
+{$PACKRECORDS C}
+
+interface
+
+uses gdk, gtk, gl;
+
+// gdkgl
+
+const
+// enum _GDK_GL_CONFIGS
+  GDK_GL_NONE                           = 0;
+  GDK_GL_USE_GL                         = 1;
+  GDK_GL_BUFFER_SIZE                    = 2;
+  GDK_GL_LEVEL                          = 3;
+  GDK_GL_RGBA                           = 4;
+  GDK_GL_DOUBLEBUFFER                   = 5;
+  GDK_GL_STEREO                         = 6;
+  GDK_GL_AUX_BUFFERS                    = 7;
+  GDK_GL_RED_SIZE                       = 8;
+  GDK_GL_GREEN_SIZE                     = 9;
+  GDK_GL_BLUE_SIZE                      = 10;
+  GDK_GL_ALPHA_SIZE                     = 11;
+  GDK_GL_DEPTH_SIZE                     = 12;
+  GDK_GL_STENCIL_SIZE                   = 13;
+  GDK_GL_ACCUM_RED_SIZE                 = 14;
+  GDK_GL_ACCUM_GREEN_SIZE               = 15;
+  GDK_GL_ACCUM_BLUE_SIZE                = 16;
+  GDK_GL_ACCUM_ALPHA_SIZE               = 17;
+
+  // GLX_EXT_visual_info extension
+  GDK_GL_X_VISUAL_TYPE_EXT              = $22;
+  GDK_GL_TRANSPARENT_TYPE_EXT           = $23;
+  GDK_GL_TRANSPARENT_INDEX_VALUE_EXT    = $24;
+  GDK_GL_TRANSPARENT_RED_VALUE_EXT      = $25;
+  GDK_GL_TRANSPARENT_GREEN_VALUE_EXT    = $26;
+  GDK_GL_TRANSPARENT_BLUE_VALUE_EXT     = $27;
+  GDK_GL_TRANSPARENT_ALPHA_VALUE_EXT    = $28;
+   
+
+type
+  TGdkGLContext = record end;
+  PGdkGLContext = ^TGdkGLContext;
+
+// GLX_EXT_visual_info extension
+
+function gdk_gl_query: Integer;cdecl;external;
+// function gdk_gl_get_info:^char;cdecl;external;
+function gdk_gl_choose_visual(attrlist:Plongint):PGdkVisual;cdecl;external;
+function gdk_gl_get_config(visual:PGdkVisual; attrib:longint):longint;cdecl;external;
+function gdk_gl_context_new(visual:PGdkVisual):PGdkGLContext;cdecl;external;
+function gdk_gl_context_share_new(visual:PGdkVisual; sharelist:PGdkGLContext; direct:Integer):PGdkGLContext;cdecl;external;
+function gdk_gl_context_attrlist_share_new(attrlist:Plongint; sharelist:PGdkGLContext; direct:Integer):PGdkGLContext;cdecl;external;
+function gdk_gl_context_ref(context:PGdkGLContext):PGdkGLContext;cdecl;external;
+procedure gdk_gl_context_unref(context:PGdkGLContext);cdecl;external;
+function gdk_gl_make_current(drawable:PGdkDrawable; context:PGdkGLContext):Integer;cdecl;external;
+procedure gdk_gl_swap_buffers(drawable:PGdkDrawable);cdecl;external;
+procedure gdk_gl_wait_gdk;cdecl;external;
+procedure gdk_gl_wait_gl;cdecl;external;
+
+{ glpixmap stuff  }
+
+type
+  TGdkGLPixmap = record end;
+  PGdkGLPixmap = ^TGdkGLPixmap;
+
+
+function gdk_gl_pixmap_new(visual:PGdkVisual; pixmap:PGdkPixmap):PGdkGLPixmap;cdecl;external;
+function gdk_gl_pixmap_ref(glpixmap:PGdkGLPixmap):PGdkGLPixmap;cdecl;external;
+procedure gdk_gl_pixmap_unref(glpixmap:PGdkGLPixmap);cdecl;external;
+function gdk_gl_pixmap_make_current(glpixmap:PGdkGLPixmap; context:PGdkGLContext):Integer;cdecl;external;
+
+{ fonts  }
+
+procedure gdk_gl_use_gdk_font(font:PGdkFont; first:longint; count:longint; list_base:longint);cdecl;external;
+
+// gtkglarea
+
+{ C++ extern C conditionnal removed }
+{ __cplusplus  }
+{ was #define dname def_expr }
+function GTK_TYPE_GL_AREA: TGtkType; cdecl; external 'gtkgl' name 'gtk_gl_area_get_type';
+{ return type might be wrong }
+
+{ was #define dname(params) para_def_expr }
+{ argument types are unknown }
+{ return type might be wrong }
+//function GTK_GL_AREA(obj : longint) : longint;
+
+{ was #define dname(params) para_def_expr }
+{ argument types are unknown }
+{ return type might be wrong }
+//function GTK_GL_AREA_CLASS(klass : longint) : longint;
+
+{ was #define dname(params) para_def_expr }
+{ argument types are unknown }
+{ return type might be wrong }
+function GTK_IS_GL_AREA(obj : Pointer) : Boolean;
+
+{ was #define dname def_expr }
+function GTK_IS_GL_AREA_CLASS(klass: Pointer): Boolean;
+{ return type might be wrong }
+
+type
+  PGtkGLArea = ^TGtkGLArea;
+  TGtkGLArea = record
+    darea: TGtkDrawingArea;
+    glcontext: PGdkGLContext;
+  end;
+
+  PGtkGLAreaClass = ^TGtkGLAreaClass;
+  TGtkGLAreaClass = record
+    parent_class: TGtkDrawingAreaClass;
+  end;
+
+function gtk_gl_area_get_type:TGtkType;cdecl;external;
+function gtk_gl_area_new(attrList:Plongint):PGtkWidget;cdecl;external;
+function gtk_gl_area_share_new(attrList:Plongint; share:PGtkGLArea):PGtkWidget;cdecl;external;
+function gtk_gl_area_new_vargs(share:PGtkGLArea; args:array of const):PGtkWidget;cdecl;external;
+function gtk_gl_area_new_vargs(share:PGtkGLArea):PGtkWidget;cdecl;external;
+function gtk_gl_area_make_current(glarea:PGtkGLArea):Integer;cdecl;external;
+function gtk_gl_area_begingl(glarea:PGtkGLArea):Integer;cdecl;external;
+
+{ deprecated, use gtk_gl_area_make_current  }
+procedure gtk_gl_area_endgl(glarea:PGtkGLArea);cdecl;external;
+
+{ deprecated  }
+procedure gtk_gl_area_swapbuffers(glarea:PGtkGLArea);cdecl;external;
+
+{ deprecated  }
+procedure gtk_gl_area_swap_buffers(glarea:PGtkGLArea);cdecl;external;
+
+{ deprecated, use gtk_drawing_area_size()  }
+procedure gtk_gl_area_size(glarea:PGtkGLArea; width:Integer; height:Integer);cdecl;external;
+
+implementation
+
+{ was #define dname(params) para_def_expr }
+{ argument types are unknown }
+{ return type might be wrong }
+{  function GTK_GL_AREA(obj : longint) : longint;
+    begin
+      GTK_GL_AREA:=GTK_CHECK_CAST(obj,GTK_TYPE_GL_AREA,GtkGLArea);
+    end;}
+
+{ was #define dname(params) para_def_expr }
+{ argument types are unknown }
+{ return type might be wrong }
+{  function GTK_GL_AREA_CLASS(klass : longint) : longint;
+    begin
+       GTK_GL_AREA_CLASS:=GTK_CHECK_CLASS_CAST(klass,GTK_TYPE_GL_AREA,GtkGLAreaClass);
+    end;}
+
+{ was #define dname(params) para_def_expr }
+{ argument types are unknown }
+{ return type might be wrong }
+  function GTK_IS_GL_AREA(obj: Pointer): Boolean;
+    begin
+       // GTK_IS_GL_AREA:=GTK_CHECK_TYPE(obj,GTK_TYPE_GL_AREA);
+       Result := Assigned(obj) and GTK_IS_GL_AREA_CLASS(PGtkTypeObject(obj)^.klass);
+    end;
+
+{ was #define dname def_expr }
+  function GTK_IS_GL_AREA_CLASS(klass: Pointer): Boolean;
+      { return type might be wrong }
+      begin
+         // GTK_IS_GL_AREA_CLASS:=GTK_CHECK_CLASS_TYPE(klass,GTK_TYPE_GL_AREA);
+         Result := Assigned(klass) and (PGtkTypeClass(klass)^.thetype = GTK_TYPE_GL_AREA);
+      end;
+
+{$PACKRECORDS DEFAULT}
+
+end.