[fpc-pascal] Moving callbackfunctions to class

[Darius Blaszyk]

On Dec 31, 2010, at 2:06 PM, Felipe Monteiro de Carvalho wrote:

> On Fri, Dec 31, 2010 at 11:01 AM, Darius Blaszyk
> <dhkblaszyk at zeelandnet.nl> wrote:
>> Thanks for the tip Paul. Unfortunately it did not help. See for the results below.
> 
> Using a correct type cast it should work. Which line brings the errors?

Hi Felipe,

Casting works, but the app crashes (Michael get that smile from your face ;) Here's an example app for those that are curious: 

Regards, Darius


program gluttest;

{$mode delphi}{$H+}
{$define ClassGLutWindow}

uses
  Classes, SysUtils, gl, glut;

{$IFDEF ClassGLutWindow}
type

  { TGLWindow }

  TGLWindow = class
  public
    constructor Create;
    class procedure DisplayFunc; cdecl;
  end;

var
  GLWindow: TGLWindow;

constructor TGLWindow.Create;
begin
  glutInitWindowSize(350, 200);
  glutInitWindowPosition(0, 0);
  glutCreateWindow(PChar('GLut window'));

  //GLut callback functions
  glutDisplayFunc(TGlutVoidCallback(DisplayFunc));
end;

class procedure TGLWindow.DisplayFunc; cdecl;
{$ELSE}
procedure DisplayFunc; cdecl;
{$ENDIF}
begin
  //clear background
  glClearColor(0.3, 0.3, 0.3, 1);
  glClear(GL_COLOR_BUFFER_BIT);

  //swap the buffer
  glutSwapBuffers;
end;

begin
  glutInit(@argc, argv);
  glutInitDisplayMode(GLUT_DOUBLE or GLUT_RGBA);

  {$IFNDEF ClassGLutWindow}
  glutInitWindowSize(350, 200);
  glutInitWindowPosition(0, 0);
  glutCreateWindow(PChar('GLut window'));

  //GLut callback functions
  glutDisplayFunc(DisplayFunc);
  {$ENDIF}

  {$IFDEF ClassGLutWindow} GLWindow := TGLWindow.Create; {$ENDIF}
  glutMainLoop;
end.