* updated ptcpas to 0.99.13

git-svn-id: trunk@23005 -

.gitattributes

@@ -6021,6 +6021,7 @@ packages/ptc/examples/image.pp svneol=native#text/plain
 packages/ptc/examples/image.tga -text
 packages/ptc/examples/keyboard.pp svneol=native#text/plain
 packages/ptc/examples/keyboard2.pp svneol=native#text/plain
+packages/ptc/examples/keyboard3.pp svneol=native#text/plain
 packages/ptc/examples/land.pp svneol=native#text/plain
 packages/ptc/examples/lights.pp svneol=native#text/plain
 packages/ptc/examples/modes.pp svneol=native#text/plain
@@ -6029,6 +6030,8 @@ packages/ptc/examples/mojo.raw -text svneol=unset#raw/binary
 packages/ptc/examples/mouse.pp svneol=native#text/plain
 packages/ptc/examples/palette.pp svneol=native#text/plain
 packages/ptc/examples/pixel.pp svneol=native#text/plain
+packages/ptc/examples/ptcgl.pp svneol=native#text/plain
+packages/ptc/examples/ptcgl2.pp svneol=native#text/plain
 packages/ptc/examples/random.pp svneol=native#text/plain
 packages/ptc/examples/save.pp svneol=native#text/plain
 packages/ptc/examples/stretch.pp svneol=native#text/plain
@@ -6099,6 +6102,8 @@ packages/ptc/src/core/moded.inc svneol=native#text/plain
 packages/ptc/src/core/modei.inc svneol=native#text/plain
 packages/ptc/src/core/mouseeventd.inc svneol=native#text/plain
 packages/ptc/src/core/mouseeventi.inc svneol=native#text/plain
+packages/ptc/src/core/openglattributesd.inc svneol=native#text/plain
+packages/ptc/src/core/openglattributesi.inc svneol=native#text/plain
 packages/ptc/src/core/paletted.inc svneol=native#text/plain
 packages/ptc/src/core/palettei.inc svneol=native#text/plain
 packages/ptc/src/core/surfaced.inc svneol=native#text/plain
@@ -6163,8 +6168,14 @@ packages/ptc/src/win32/directx/primaryd.inc svneol=native#text/plain
 packages/ptc/src/win32/directx/translate.inc svneol=native#text/plain
 packages/ptc/src/win32/gdi/gdiconsoled.inc svneol=native#text/plain
 packages/ptc/src/win32/gdi/gdiconsolei.inc svneol=native#text/plain
+packages/ptc/src/win32/gdi/gdihookd.inc svneol=native#text/plain
+packages/ptc/src/win32/gdi/gdihooki.inc svneol=native#text/plain
 packages/ptc/src/win32/gdi/win32dibd.inc svneol=native#text/plain
 packages/ptc/src/win32/gdi/win32dibi.inc svneol=native#text/plain
+packages/ptc/src/win32/gdi/win32modesetterd.inc svneol=native#text/plain
+packages/ptc/src/win32/gdi/win32modesetteri.inc svneol=native#text/plain
+packages/ptc/src/win32/gdi/win32openglwindowd.inc svneol=native#text/plain
+packages/ptc/src/win32/gdi/win32openglwindowi.inc svneol=native#text/plain
 packages/ptc/src/wince/base/wincekeyboardd.inc svneol=native#text/plain
 packages/ptc/src/wince/base/wincekeyboardi.inc svneol=native#text/plain
 packages/ptc/src/wince/base/wincemoused.inc svneol=native#text/plain
@@ -6182,6 +6193,8 @@ packages/ptc/src/wince/gdi/wincegdiconsolei.inc svneol=native#text/plain
 packages/ptc/src/wince/includes.inc svneol=native#text/plain
 packages/ptc/src/x11/check.inc svneol=native#text/plain
 packages/ptc/src/x11/extensions.inc svneol=native#text/plain
+packages/ptc/src/x11/glxfbconfigd.inc svneol=native#text/plain
+packages/ptc/src/x11/glxfbconfigi.inc svneol=native#text/plain
 packages/ptc/src/x11/includes.inc svneol=native#text/plain
 packages/ptc/src/x11/x11consoled.inc svneol=native#text/plain
 packages/ptc/src/x11/x11consolei.inc svneol=native#text/plain

packages/graph/src/ptcgraph/ptccrt.pp

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2010 by Nikolay Nikolov ([email protected])
+    Copyright (c) 2010, 2011 by Nikolay Nikolov ([email protected])
 
     This file implements keyboard input support for ptcgraph
 

packages/graph/src/ptcgraph/ptcgraph.pp

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2010 by Nikolay Nikolov ([email protected])
+    Copyright (c) 2010, 2011 by Nikolay Nikolov ([email protected])
     Copyright (c) 2007 by Daniel Mantione
       member of the Free Pascal development team
 

packages/ptc/Makefile.fpc.fpcmake

@@ -24,8 +24,10 @@ sourcedir=src src/ptcwrapper
 
 [require]
 packages=hermes fcl-base
-packages_linux=x11
-packages_freebsd=x11
+packages_linux=x11 opengl
+packages_freebsd=x11 opengl
+packages_win32=opengl
+packages_win64=opengl
 
 [default]
 fpcdir=../..

packages/ptc/docs/CHANGES.txt

@@ -1,3 +1,13 @@
+0.99.13
+ - added support for OpenGL under X11 and Windows. You can now use PTCPas to initialize
+   OpenGL and handle events for you in a multiplatform way (similar to GLUT or SDL). See
+   ptcgl.pp and ptcgl2.pp in the example directory.
+ - X11 keyboard handling improvements:
+   - added support for the numpad keys
+   - typematic repeat (i.e. when you press a key and hold it down) now sends only
+     repeating key press events, instead of repeating pairs of key release + key press.
+     This makes it possible to detect auto-repeat and is also the way that Windows behaves.
+
 0.99.12
  - pressing Alt or F10 under Windows no longer pauses the application.
  - API changes:

packages/ptc/docs/README.txt

@@ -1,4 +1,4 @@
-PTCPas 0.99.12
+PTCPas 0.99.13
 Nikolay Nikolov ([email protected])
 
 PTCPas is a free, portable framebuffer library, written in Free Pascal. It is
@@ -10,8 +10,9 @@ The latest version can be found at http://ptcpas.sourceforge.net
 Basically it provides an abstraction layer for high-speed low-level graphics
 access. It is OOP and supports multiple platforms. (tested on Linux, DOS and
 Windows, more will be added in the future)
-3d acceleration isn't supported, nor planned. If you need that, you should use
-something like OpenGL instead. :-)
+
+Since version 0.99.13 it is also possible to create OpenGL applications with
+PTCPas. See the ptcgl.pp and ptcgl2.pp examples in the 'examples' directory.
 
 PTCPas initially started out as a complete Object Pascal translation of the
 OpenPTC C++ library. Since then, OpenPTC development has stalled and PTCPas

packages/ptc/docs/TODO.txt

@@ -3,7 +3,6 @@
  - mouse support for the x11 dga console
  - key release events support in dos
  - multiple video pages support for the x11 w/dga console
- - cross-platform opengl initialization support (like sdl or glut)
  - make hermes thread safe
  - better timing under dos
  - delphi (kylix? c++?) bindings

packages/ptc/examples/Makefile.fpc

@@ -8,9 +8,12 @@ version=2.7.1
 
 [target]
 programs=area buffer clear clip con_info console fire  \
-         flower hicolor image keyboard keyboard2 land \
-         lights modes mojo palette pixel random save \
+         flower hicolor image keyboard keyboard2 keyboard3 \
+         land lights modes mojo palette pixel random save \
          stretch texwarp timer tunnel3d tunnel
+programs_win32=ptcgl ptcgl2
+programs_win64=ptcgl ptcgl2
+programs_linux=ptcgl ptcgl2
 
 [compiler]
 unitdir=../$(UNITTARGETDIRPREFIX)

packages/ptc/examples/keyboard3.pp

@@ -0,0 +1,70 @@
+{
+ Keyboard example for the PTCPas library
+ This source code is in the public domain
+}
+
+program KeyboardExample3;
+
+{$MODE objfpc}
+
+uses
+  ptc;
+
+procedure DumpKey(AKey: IPTCKeyEvent);
+begin
+  Writeln('Code=', AKey.Code:3, ', Unicode=$', HexStr(AKey.Unicode, 4),
+    ', Press=', AKey.Press:5, ', Shift=', AKey.Shift:5, ', Alt=', AKey.Alt:5,
+    ', Control=', AKey.Control:5);
+end;
+
+var
+  console: IPTCConsole;
+  format: IPTCFormat;
+  key: IPTCKeyEvent;
+  Done: Boolean;
+begin
+  try
+    try
+      { create console }
+      console := TPTCConsoleFactory.CreateNew;
+
+      { enable key release events }
+      console.KeyReleaseEnabled := True;
+
+      { create format }
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
+
+      { open the console }
+      console.open('Keyboard example 3', format);
+
+      { main loop }
+      Done := False;
+      repeat
+        { check for key press/release }
+        while console.KeyPressed do
+        begin
+          console.ReadKey(key);
+          case key.code of
+            PTCKEY_ESCAPE:
+              begin
+                Done := True;
+                Break;
+              end;
+            else
+              DumpKey(key);
+          end;
+        end;
+
+        { update console }
+        console.update;
+      until Done;
+    finally
+      if Assigned(console) then
+        console.close;
+    end;
+  except
+    on error: TPTCError do
+      { report error }
+      error.report;
+  end;
+end.

packages/ptc/examples/ptcgl.pp

@@ -0,0 +1,81 @@
+{
+ PTC OpenGL example for PTCPas
+ Copyright (c) Nikolay Nikolov ([email protected])
+ This source code is in the public domain
+}
+
+program PtcGLExample;
+
+{$MODE objfpc}
+
+uses
+  ptc, gl, SysUtils;
+
+var
+  Console: IPTCConsole;
+  Event: IPTCEvent;
+  Done: Boolean = False;
+begin
+  try
+    try
+      { create console }
+      Console := TPTCConsoleFactory.CreateNew;
+
+      { tell PTC we want OpenGL }
+      Console.OpenGL_Enabled := True;
+
+      { enable OpenGL double buffering }
+      Console.OpenGL_Attributes.DoubleBuffer := True;
+
+      { open the console }
+      Console.Open('PTC OpenGL example');
+
+      glClearColor(0.0, 0.0, 0.0, 0.0);
+
+      glMatrixMode(GL_PROJECTION);
+      glLoadIdentity;
+      glOrtho(0.0, 1.0, 0.0, 1.0, -1.0, 1.0);
+
+      { loop until the key 'q' is pressed }
+      repeat
+        { draw scene }
+        glClear(GL_COLOR_BUFFER_BIT);
+
+        glBegin(GL_POLYGON);
+          glColor3f(1.0, 0.0, 0.0);
+          glVertex3f(0.25, 0.25, 0.0);
+          glColor3f(1.0, 1.0, 0.0);
+          glVertex3f(0.75, 0.25, 0.0);
+          glColor3f(0.5, 0.0, 1.0);
+          glVertex3f(0.75, 0.75, 0.0);
+          glColor3f(0.0, 1.0, 0.0);
+          glVertex3f(0.25, 0.75, 0.0);
+        glEnd;
+
+        glFlush;
+
+        { swap buffers }
+        Console.OpenGL_SwapBuffers;
+
+        { check for events }
+        if Console.NextEvent(Event, False, PTCAnyEvent) then
+        begin
+          { handle keyboard events }
+          if Supports(event, IPTCKeyEvent) and (event as IPTCKeyEvent).Press then
+          begin
+            case (event as IPTCKeyEvent).Code of
+              PTCKEY_Q: Done := True;
+            end;
+          end;
+        end;
+      until Done;
+    finally
+      if Assigned(Console) then
+        Console.Close;
+    end;
+  except
+    on Error: TPTCError do
+      { report error }
+      Error.Report;
+  end;
+end.

packages/ptc/examples/ptcgl2.pp

@@ -0,0 +1,78 @@
+{
+ PTC OpenGL example for PTCPas
+ Copyright (c) Nikolay Nikolov ([email protected])
+ This source code is in the public domain
+}
+
+program PtcGL2Example;
+
+{$MODE objfpc}
+
+uses
+  ptc, gl, SysUtils;
+
+var
+  Console: IPTCConsole;
+  Event: IPTCEvent;
+  Done: Boolean = False;
+begin
+  try
+    try
+      { create console }
+      Console := TPTCConsoleFactory.CreateNew;
+
+      { tell PTC we want OpenGL }
+      Console.OpenGL_Enabled := True;
+
+      { use OpenGL single buffering }
+      Console.OpenGL_Attributes.DoubleBuffer := False;
+
+      { open the console }
+      Console.Open('PTC OpenGL single buffering example');
+
+      glClearColor(0.0, 0.0, 0.0, 0.0);
+
+      glMatrixMode(GL_PROJECTION);
+      glLoadIdentity;
+      glOrtho(0.0, 1.0, 0.0, 1.0, -1.0, 1.0);
+
+      { loop until the key 'q' is pressed }
+      repeat
+        { draw scene }
+        glClear(GL_COLOR_BUFFER_BIT);
+
+        glBegin(GL_POLYGON);
+          glColor3f(1.0, 0.0, 0.0);
+          glVertex3f(0.25, 0.25, 0.0);
+          glColor3f(1.0, 1.0, 0.0);
+          glVertex3f(0.75, 0.25, 0.0);
+          glColor3f(0.5, 0.0, 1.0);
+          glVertex3f(0.75, 0.75, 0.0);
+          glColor3f(0.0, 1.0, 0.0);
+          glVertex3f(0.25, 0.75, 0.0);
+        glEnd;
+
+        glFlush;
+
+        { check for events }
+        if Console.NextEvent(Event, False, PTCAnyEvent) then
+        begin
+          { handle keyboard events }
+          if Supports(event, IPTCKeyEvent) and (event as IPTCKeyEvent).Press then
+          begin
+            case (event as IPTCKeyEvent).Code of
+              PTCKEY_Q: Done := True;
+            end;
+          end;
+        end;
+      until Done;
+    finally
+      if Assigned(Console) then
+        Console.Close;
+    end;
+  except
+    on Error: TPTCError do
+      { report error }
+      Error.Report;
+  end;
+end.

packages/ptc/fpmake.pp

@@ -2,8 +2,6 @@
 {$mode objfpc}{$H+}
 program fpmake;
 
-// Note this package is currently not compiled and a mess.
-
 uses fpmkunit;
 
 Var
@@ -46,6 +44,7 @@ begin
 
   P.Dependencies.Add('hermes');
   P.Dependencies.Add('x11',AllUnixOSes);
+  P.Dependencies.Add('opengl',AllUnixOSes + [win32, win64]);
   P.Dependencies.Add('fcl-base');
 
   T:=P.Targets.AddUnit('p_ddraw.pp', [win32, win64]);
@@ -89,6 +88,8 @@ begin
       AddInclude('baseconsolei.inc');
       AddInclude('surfacei.inc');
       AddInclude('timeri.inc');
+      AddInclude('openglattributesd.inc');
+      AddInclude('openglattributesi.inc');
       AddInclude('includes.inc',allunixoses+[WinCE]);
       AddInclude('extensions.inc',allunixoses);
       AddInclude('x11modesd.inc',allunixoses);
@@ -107,6 +108,8 @@ begin
       AddInclude('x11dga1displayi.inc',allunixoses);
       AddInclude('x11dga2displayi.inc',allunixoses);
       AddInclude('x11consolei.inc',allunixoses);
+      AddInclude('glxfbconfigd.inc',allunixoses);
+      AddInclude('glxfbconfigi.inc',allunixoses);
       AddInclude('consolei.inc');
       AddUnit('p_gx',[Wince]);
       AddUnit('textfx2',[Go32v2]);
@@ -149,10 +152,13 @@ begin
     P.Targets.AddExampleProgram('mojo.pp');
     P.Targets.AddExampleProgram('land.pp');
     P.Targets.AddExampleProgram('keyboard2.pp');
+    P.Targets.AddExampleProgram('keyboard3.pp');
     P.Targets.AddExampleProgram('clear.pp');
     P.Targets.AddExampleProgram('con_info.pp');
     P.Targets.AddExampleProgram('area.pp');
     P.Targets.AddExampleProgram('tunnel3d.pp');
+    P.Targets.AddExampleProgram('ptcgl.pp', AllUnixOSes + [win32, win64]);
+    P.Targets.AddExampleProgram('ptcgl2.pp', AllUnixOSes + [win32, win64]);
     P.Sources.AddExampleFiles('examples/*',false,'.');
 
 {$ifndef ALLPACKAGES}

packages/ptc/src/core/aread.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/areai.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -40,7 +40,7 @@ type
     function GetBottom: Integer;
     function GetWidth: Integer;
     function GetHeight: Integer;
-    function Equals(AArea: IPTCArea): Boolean;
+    function Equals(AArea: IPTCArea): Boolean; reintroduce;
   public
     constructor Create;
     constructor Create(ALeft, ATop, ARight, ABottom: Integer);

packages/ptc/src/core/baseconsoled.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -37,6 +37,10 @@ type
     function GetTitle: string;
     function GetInformation: string;
 
+    function GetOpenGL_Enabled: Boolean;
+    procedure SetOpenGL_Enabled(AValue: Boolean);
+    function GetOpenGL_Attributes: IPTCOpenGLAttributes;
+
     procedure Configure(const AFileName: string);
     function Modes: TPTCModeList;
     procedure Open(const ATitle: string; APages: Integer = 0); overload;
@@ -69,5 +73,12 @@ type
     property Name: string read GetName;
     property Title: string read GetTitle;
     property Information: string read GetInformation;
+
+    { OpenGL support }
+    property OpenGL_Enabled: Boolean read GetOpenGL_Enabled write SetOpenGL_Enabled;
+    property OpenGL_Attributes: IPTCOpenGLAttributes read GetOpenGL_Attributes;
+    procedure OpenGL_SwapBuffers;
+    procedure OpenGL_SetSwapInterval(AInterval: Integer);
+    function OpenGL_GetSwapInterval: Integer;
   end;
 

packages/ptc/src/core/baseconsolei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -48,6 +48,12 @@ type
     function GetName: string; virtual; abstract;
     function GetTitle: string; virtual; abstract;
     function GetInformation: string; virtual; abstract;
+
+    function GetOpenGL_Enabled: Boolean; virtual; abstract;
+    procedure SetOpenGL_Enabled(AValue: Boolean); virtual; abstract;
+    function GetOpenGL_Attributes: IPTCOpenGLAttributes;
+  protected
+    FOpenGLAttributes: IPTCOpenGLAttributes;
   public
     constructor Create; virtual;
 
@@ -120,11 +126,32 @@ type
     property Pitch: Integer read GetPitch;
     property Area: IPTCArea read GetArea;
     property Format: IPTCFormat read GetFormat;
+
+    property OpenGL_Enabled: Boolean read GetOpenGL_Enabled write SetOpenGL_Enabled;
+    procedure OpenGL_SwapBuffers; virtual; abstract;
+    procedure OpenGL_SetSwapInterval(AInterval: Integer); virtual; abstract;
+    function OpenGL_GetSwapInterval: Integer; virtual; abstract;
+  end;
+
+  TPTCOpenGLLessConsole = class(TPTCBaseConsole)
+  private
+    function GetOpenGL_Enabled: Boolean; override;
+    procedure SetOpenGL_Enabled(AValue: Boolean); override;
+  public
+    procedure OpenGL_SwapBuffers; override;
+    procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
+    function OpenGL_GetSwapInterval: Integer; override;
   end;
 
 constructor TPTCBaseConsole.Create;
 begin
   FReleaseEnabled := False;
+  FOpenGLAttributes := TPTCOpenGLAttributes.Create;
+end;
+
+function TPTCBaseConsole.GetOpenGL_Attributes: IPTCOpenGLAttributes;
+begin
+  Result := FOpenGLAttributes;
 end;
 
 function TPTCBaseConsole.KeyPressed: Boolean;
@@ -178,3 +205,30 @@ function TPTCBaseConsole.GetKeyReleaseEnabled: Boolean;
 begin
   Result := FReleaseEnabled;
 end;
+
+function TPTCOpenGLLessConsole.GetOpenGL_Enabled: Boolean;
+begin
+  Result := False;
+end;
+
+procedure TPTCOpenGLLessConsole.SetOpenGL_Enabled(AValue: Boolean);
+begin
+  if AValue then
+    raise TPTCError.Create('Console does not support OpenGL');
+end;
+
+procedure TPTCOpenGLLessConsole.OpenGL_SwapBuffers;
+begin
+  raise TPTCError.Create('Console does not support OpenGL');
+end;
+
+procedure TPTCOpenGLLessConsole.OpenGL_SetSwapInterval(AInterval: Integer);
+begin
+  raise TPTCError.Create('Console does not support OpenGL');
+end;
+
+function TPTCOpenGLLessConsole.OpenGL_GetSwapInterval: Integer;
+begin
+  Result := -1;
+  raise TPTCError.Create('Console does not support OpenGL');
+end;

packages/ptc/src/core/basesurfaced.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/basesurfacei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/cleard.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/cleari.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/clipperd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/clipperi.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/colord.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/colori.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -44,7 +44,7 @@ type
     function GetA: Single;
     function GetDirect: Boolean;
     function GetIndexed: Boolean;
-    function Equals(AColor: IPTCColor): Boolean;
+    function Equals(AColor: IPTCColor): Boolean; reintroduce;
   public
     constructor Create;
     constructor Create(AIndex: Integer);

packages/ptc/src/core/consoled.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/consolei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -37,6 +37,7 @@ type
     FModes: array of IPTCMode;
     FOptionsQueue: array of string;
     FHackyOptionConsoleFlag: Boolean;
+    FUseOpenGL: Boolean;
 
     function ConsoleCreate(AIndex: Integer): IPTCConsole;
     function ConsoleCreate(const AName: string): IPTCConsole;
@@ -45,6 +46,11 @@ type
     procedure AddOptionToOptionsQueue(const AOption: string);
     procedure ExecuteOptionsFromOptionsQueue;
     procedure ClearOptionsQueue;
+
+    procedure PassOpenGLOptionsToInnerConsole;
+
+    function GetOpenGL_Enabled: Boolean; override;
+    procedure SetOpenGL_Enabled(AValue: Boolean); override;
   public
     constructor Create; override;
     destructor Destroy; override;
@@ -106,6 +112,9 @@ type
     function GetInformation: string; override;
     function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
     function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
+    procedure OpenGL_SwapBuffers; override;
+    procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
+    function OpenGL_GetSwapInterval: Integer; override;
   end;
 
 class function TPTCConsoleFactory.CreateNew: IPTCConsole;
@@ -130,36 +139,36 @@ const
     record
       ConsoleClass: class of TPTCBaseConsole;
       Names: array [1..2] of string;
+      OpenGL: Boolean;
     end =
   (
   {$IFDEF GO32V2}
-   (ConsoleClass: TVESAConsole;      Names: ('VESA', '')),
-   (ConsoleClass: TVGAConsole;       Names: ('VGA', 'Fakemode')),
-   (ConsoleClass: TCGAConsole;       Names: ('CGA', '')),
-   (ConsoleClass: TTEXTFX2Console;   Names: ('TEXTFX2', 'Text'))
+   (ConsoleClass: TVESAConsole;      Names: ('VESA', '');        OpenGL: False),
+   (ConsoleClass: TVGAConsole;       Names: ('VGA', 'Fakemode'); OpenGL: False),
+   (ConsoleClass: TCGAConsole;       Names: ('CGA', '');         OpenGL: False),
+   (ConsoleClass: TTEXTFX2Console;   Names: ('TEXTFX2', 'Text'); OpenGL: False)
   {$ENDIF GO32V2}
 
   {$IF defined(Win32) OR defined(Win64)}
-   (ConsoleClass: TDirectXConsole;   Names: ('DirectX', '')),
-   (ConsoleClass: TGDIConsole;       Names: ('GDI', ''))
+   (ConsoleClass: TDirectXConsole;   Names: ('DirectX', '');     OpenGL: False),
+   (ConsoleClass: TGDIConsole;       Names: ('GDI', '');         OpenGL: True)
   {$ENDIF defined(Win32) OR defined(Win64)}
 
   {$IFDEF WinCE}
-   (ConsoleClass: TWinCEGAPIConsole; Names: ('GAPI', '')),
-   (ConsoleClass: TWinCEGDIConsole;  Names: ('GDI', ''))
+   (ConsoleClass: TWinCEGAPIConsole; Names: ('GAPI', '');        OpenGL: False),
+   (ConsoleClass: TWinCEGDIConsole;  Names: ('GDI', '');         OpenGL: False)
   {$ENDIF WinCE}
 
   {$IFDEF UNIX}
-   (ConsoleClass: TX11Console;       Names: ('X11', ''))
+   (ConsoleClass: TX11Console;       Names: ('X11', '');         OpenGL: {$IFDEF ENABLE_X11_EXTENSION_GLX}True{$ELSE}False{$ENDIF})
   {$ENDIF UNIX}
   );
 
 constructor TPTCConsole.Create;
+{$IFDEF UNIX}
 var
-  I: Integer;
-  {$IFDEF UNIX}
   s: AnsiString;
-  {$ENDIF UNIX}
+{$ENDIF UNIX}
 begin
   inherited Create;
   FConsole := nil;
@@ -190,10 +199,8 @@ begin
 end;
 
 destructor TPTCConsole.Destroy;
-var
-  I: Integer;
 begin
-  close;
+  Close;
   FConsole := nil;
   inherited Destroy;
 end;
@@ -263,20 +270,17 @@ begin
     if Assigned(FConsole) then
     begin
       FHackyOptionConsoleFlag := True;
+      PassOpenGLOptionsToInnerConsole;
       ExecuteOptionsFromOptionsQueue;
 {      ClearOptionsQueue;}
       Result := True;
     end
     else
     begin
-      { TODO: check if the option is supported by at least one console... }
-      if {OptionSupported}True then
-      begin
-        AddOptionToOptionsQueue(AOption);
-        Result := True;
-      end
-      else
-        Result := False;
+      { TODO: check if the option is supported by at least one console and return false otherwise... }
+
+      AddOptionToOptionsQueue(AOption);
+      Result := True;
     end;
   end;
 end;
@@ -334,7 +338,7 @@ begin
       exit;
     except
       on error: TPTCError do begin
-        FreeAndNil(FConsole);
+        FConsole := nil;
         if FHackyOptionConsoleFlag then
         begin
           FHackyOptionConsoleFlag := False;
@@ -353,6 +357,7 @@ begin
         FConsole := ConsoleCreate(index);
         if FConsole = nil then
           break;
+        PassOpenGLOptionsToInnerConsole;
         ExecuteOptionsFromOptionsQueue;
         FConsole.Open(ATitle, APages);
 {        ClearOptionsQueue;}
@@ -366,7 +371,7 @@ begin
           finally
             tmp.Free;
           end;
-          FreeAndNil(FConsole);
+          FConsole := nil;
           continue;
         end;
       end;
@@ -376,7 +381,7 @@ begin
   finally
     composite.Free;
     if not success then
-      FreeAndNil(FConsole);
+      FConsole := nil;
   end;
 end;
 
@@ -394,7 +399,7 @@ begin
       exit;
     except
       on error: TPTCError do begin
-        FreeAndNil(FConsole);
+        FConsole := nil;
         if FHackyOptionConsoleFlag then
         begin
           FHackyOptionConsoleFlag := False;
@@ -413,6 +418,7 @@ begin
         FConsole := ConsoleCreate(index);
         if FConsole = nil then
           break;
+        PassOpenGLOptionsToInnerConsole;
         ExecuteOptionsFromOptionsQueue;
         FConsole.open(ATitle, AFormat, APages);
 {        ClearOptionsQueue;}
@@ -426,7 +432,7 @@ begin
           finally
             tmp.Free;
           end;
-          FreeAndNil(FConsole);
+          FConsole := nil;
           Continue;
         end;
       end;
@@ -436,7 +442,7 @@ begin
   finally
     composite.Free;
     if not success then
-      FreeAndNil(FConsole);
+      FConsole := nil;
   end;
 end;
 
@@ -454,7 +460,7 @@ begin
       exit;
     except
       on error: TPTCError do begin
-        FreeAndNil(FConsole);
+        FConsole := nil;
         if FHackyOptionConsoleFlag then
         begin
           FHackyOptionConsoleFlag := False;
@@ -473,6 +479,7 @@ begin
         FConsole := ConsoleCreate(index);
         if FConsole = nil then
           Break;
+        PassOpenGLOptionsToInnerConsole;
         ExecuteOptionsFromOptionsQueue;
         FConsole.Open(ATitle, AWidth, AHeight, AFormat, APages);
 {        ClearOptionsQueue;}
@@ -486,7 +493,7 @@ begin
           finally
             tmp.Free;
           end;
-          FreeAndNil(FConsole);
+          FConsole := nil;
           Continue;
         end;
       end;
@@ -496,7 +503,7 @@ begin
   finally
     composite.Free;
     if not success then
-      FreeAndNil(FConsole);
+      FConsole := nil;
   end;
 end;
 
@@ -514,7 +521,7 @@ begin
       exit;
     except
       on error: TPTCError do begin
-        FreeAndNil(FConsole);
+        FConsole := nil;
         if FHackyOptionConsoleFlag then
         begin
           FHackyOptionConsoleFlag := False;
@@ -533,6 +540,7 @@ begin
         FConsole := ConsoleCreate(index);
         if FConsole = nil then
           Break;
+        PassOpenGLOptionsToInnerConsole;
         ExecuteOptionsFromOptionsQueue;
         FConsole.Open(ATitle, AMode, APages);
 {        ClearOptionsQueue;}
@@ -546,7 +554,7 @@ begin
           finally
             tmp.Free;
           end;
-          FreeAndNil(FConsole);
+          FConsole := nil;
           Continue;
         end;
       end;
@@ -556,7 +564,7 @@ begin
   finally
     composite.Free;
     if not success then
-      FreeAndNil(FConsole);
+      FConsole := nil;
   end;
 end;
 
@@ -780,10 +788,19 @@ begin
 end;
 
 function TPTCConsole.ConsoleCreate(AIndex: Integer): IPTCConsole;
+var
+  ResultObj: TPTCBaseConsole;
 begin
   Result := nil;
   if (AIndex >= Low(ConsoleTypes)) and (AIndex <= High(ConsoleTypes)) then
-    Result := ConsoleTypes[AIndex].ConsoleClass.Create;
+  begin
+    if OpenGL_Enabled and not ConsoleTypes[AIndex].OpenGL then
+      raise TPTCError.Create('Console does not support OpenGL');
+
+    ResultObj := ConsoleTypes[AIndex].ConsoleClass.Create;
+    Result := ResultObj;
+    ResultObj.FOpenGLAttributes := FOpenGLAttributes;
+  end;
 
   if Result <> nil then
     Result.KeyReleaseEnabled := KeyReleaseEnabled;
@@ -802,13 +819,8 @@ begin
     for J := Low(ConsoleTypes[I].Names) to High(ConsoleTypes[I].Names) do
       if AName = ConsoleTypes[I].Names[J] then
       begin
-        Result := ConsoleTypes[I].ConsoleClass.Create;
-
-        if Result <> nil then
-        begin
-          Result.KeyReleaseEnabled := KeyReleaseEnabled;
-          exit;
-        end;
+        Result := ConsoleCreate(I);
+        exit;
       end;
 end;
 
@@ -817,3 +829,42 @@ begin
   if FConsole = nil then
     raise TPTCError.Create('console is not open (core)');
 end;
+
+procedure TPTCConsole.PassOpenGLOptionsToInnerConsole;
+begin
+  FConsole.OpenGL_Enabled := FUseOpenGL;
+end;
+
+function TPTCConsole.GetOpenGL_Enabled: Boolean;
+begin
+  if FConsole <> nil then
+    Result := FConsole.OpenGL_Enabled
+  else
+    Result := FUseOpenGL;
+end;
+
+procedure TPTCConsole.SetOpenGL_Enabled(AValue: Boolean);
+begin
+  if FConsole <> nil then
+    FConsole.OpenGL_Enabled := AValue
+  else
+    FUseOpenGL := AValue;
+end;
+
+procedure TPTCConsole.OpenGL_SwapBuffers;
+begin
+  Check;
+  FConsole.OpenGL_SwapBuffers;
+end;
+
+procedure TPTCConsole.OpenGL_SetSwapInterval(AInterval: Integer);
+begin
+  Check;
+  FConsole.OpenGL_SetSwapInterval(AInterval);
+end;
+
+function TPTCConsole.OpenGL_GetSwapInterval: Integer;
+begin
+  Check;
+  Result := FConsole.OpenGL_GetSwapInterval;
+end;

packages/ptc/src/core/copyd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/copyi.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/coreimplementation.inc

@@ -11,6 +11,7 @@
 {$INCLUDE copyi.inc}
 {$INCLUDE clipperi.inc}
 {$INCLUDE basesurfacei.inc}
+{$INCLUDE openglattributesi.inc}
 {$INCLUDE baseconsolei.inc}
 {$INCLUDE surfacei.inc}
 {$INCLUDE timeri.inc}

packages/ptc/src/core/coreinterface.inc

@@ -11,6 +11,7 @@
 {$INCLUDE clipperd.inc}
 {$INCLUDE basesurfaced.inc}
 {$INCLUDE surfaced.inc}
+{$INCLUDE openglattributesd.inc}
 {$INCLUDE baseconsoled.inc}
 {$INCLUDE consoled.inc}
 {$INCLUDE errord.inc}

packages/ptc/src/core/errord.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009, 2010, 2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -41,7 +41,7 @@ type
     constructor Create(const AError: TPTCError);
     destructor Destroy; override;
     procedure Assign(const AError: TPTCError);
-    function Equals(const AError: TPTCError): Boolean;
+    function Equals(Obj: TObject): Boolean; override;
     procedure Report;
     property Message: string read FMessage;
   end;

packages/ptc/src/core/errori.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009, 2010, 2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -62,9 +62,23 @@ begin
   FMessage := AError.FMessage;
 end;
 
-function TPTCError.Equals(const AError: TPTCError): Boolean;
+function TPTCError.Equals(Obj: TObject): Boolean;
+var
+  OtherError: TPTCError;
 begin
-  Equals := (FMessage = AError.FMessage);
+  if Obj = nil then
+    exit(False);
+
+  if Obj = Self then
+    exit(True);
+
+  if Obj is TPTCError then
+  begin
+    OtherError := TPTCError(Obj);
+    Equals := (FMessage = OtherError.FMessage);
+  end
+  else
+    Result := False;
 end;
 
 procedure TPTCError.Report;

packages/ptc/src/core/eventd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/eventi.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/formatd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/formati.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -35,7 +35,7 @@ type
   private
     FFormat: THermesFormat;
     function GetHermesFormat: PHermesFormat;
-    function Equals(AFormat: IPTCFormat): Boolean;
+    function Equals(AFormat: IPTCFormat): Boolean; reintroduce;
     function GetR: Uint32;
     function GetG: Uint32;
     function GetB: Uint32;

packages/ptc/src/core/keyeventd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -175,5 +175,6 @@ const
   PTCKEY_INSERT       = $9B;
   PTCKEY_HELP         = $9C;
   PTCKEY_META         = $9D;
+  PTCKEY_MINUS        = $BD;
   PTCKEY_BACKQUOTE    = $C0;
   PTCKEY_QUOTE        = $DE;

packages/ptc/src/core/keyeventi.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/log.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/moded.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/modei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -46,7 +46,7 @@ type
     constructor Create(AWidth, AHeight: Integer; AFormat: IPTCFormat);
     constructor Create(AMode: IPTCMode);
 {    procedure Assign(const mode: TPTCMode);}
-    function Equals(AMode: IPTCMode): Boolean;
+    function Equals(AMode: IPTCMode): Boolean; reintroduce;
 {    property Valid: Boolean read GetValid;
     property Width: Integer read GetWidth;
     property Height: Integer read GetHeight;

packages/ptc/src/core/mouseeventd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/mouseeventi.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/openglattributesd.inc

@@ -0,0 +1,62 @@
+{
+    This file is part of the PTCPas framebuffer library
+    Copyright (C) 2012 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library 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
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+type
+  IPTCOpenGLAttributes = interface
+    function GetDoubleBuffer: Boolean;
+    procedure SetDoubleBuffer(ADoubleBuffer: Boolean);
+
+    function GetDoubleBufferDontCare: Boolean;
+    procedure SetDoubleBufferDontCare(ADoubleBufferDontCare: Boolean);
+
+    function GetStereo: Boolean;
+    procedure SetStereo(AStereo: Boolean);
+
+    function GetStereoDontCare: Boolean;
+    procedure SetStereoDontCare(AStereoDontCare: Boolean);
+
+    function GetBufferSize: Integer;
+    procedure SetBufferSize(ABufferSize: Integer);
+
+    function GetDepthSize: Integer;
+    procedure SetDepthSize(ADepthSize: Integer);
+
+    function GetStencilSize: Integer;
+    procedure SetStencilSize(AStencilSize: Integer);
+
+    property DoubleBuffer: Boolean read GetDoubleBuffer write SetDoubleBuffer;
+    property DoubleBufferDontCare: Boolean read GetDoubleBufferDontCare write SetDoubleBufferDontCare;
+    property Stereo: Boolean read GetStereo write SetStereo;
+    property StereoDontCare: Boolean read GetStereoDontCare write SetStereoDontCare;
+    property BufferSize: Integer read GetBufferSize write SetBufferSize;
+    property DepthSize: Integer read GetDepthSize write SetDepthSize;
+    property StencilSize: Integer read GetStencilSize write SetStencilSize;
+  end;

packages/ptc/src/core/openglattributesi.inc

@@ -0,0 +1,149 @@
+{
+    This file is part of the PTCPas framebuffer library
+    Copyright (C) 2012 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library 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
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+type
+  TPTCOpenGLAttributes = class(TInterfacedObject, IPTCOpenGLAttributes)
+  private
+    FDoubleBuffer: Boolean;
+    FDoubleBufferDontCare: Boolean;
+    FStereo: Boolean;
+    FStereoDontCare: Boolean;
+    FBufferSize: Integer;
+    FDepthSize: Integer;
+    FStencilSize: Integer;
+
+  public
+    constructor Create;
+
+    function GetDoubleBuffer: Boolean;
+    procedure SetDoubleBuffer(ADoubleBuffer: Boolean);
+
+    function GetDoubleBufferDontCare: Boolean;
+    procedure SetDoubleBufferDontCare(ADoubleBufferDontCare: Boolean);
+
+    function GetStereo: Boolean;
+    procedure SetStereo(AStereo: Boolean);
+
+    function GetStereoDontCare: Boolean;
+    procedure SetStereoDontCare(AStereoDontCare: Boolean);
+
+    function GetBufferSize: Integer;
+    procedure SetBufferSize(ABufferSize: Integer);
+
+    function GetDepthSize: Integer;
+    procedure SetDepthSize(ADepthSize: Integer);
+
+    function GetStencilSize: Integer;
+    procedure SetStencilSize(AStencilSize: Integer);
+  end;
+
+constructor TPTCOpenGLAttributes.Create;
+begin
+  inherited;
+
+  FDoubleBuffer := True;
+  FDoubleBufferDontCare := False;
+  FStereo := False;
+  FStereoDontCare := False;
+  FBufferSize := 0;
+  FDepthSize := 0;
+  FStencilSize := 0;
+end;
+
+function TPTCOpenGLAttributes.GetDoubleBuffer: Boolean;
+begin
+  Result := FDoubleBuffer;
+end;
+
+procedure TPTCOpenGLAttributes.SetDoubleBuffer(ADoubleBuffer: Boolean);
+begin
+  FDoubleBuffer := ADoubleBuffer;
+end;
+
+function TPTCOpenGLAttributes.GetDoubleBufferDontCare: Boolean;
+begin
+  Result := FDoubleBufferDontCare;
+end;
+
+procedure TPTCOpenGLAttributes.SetDoubleBufferDontCare(ADoubleBufferDontCare: Boolean);
+begin
+  FDoubleBufferDontCare := ADoubleBufferDontCare;
+end;
+
+function TPTCOpenGLAttributes.GetStereo: Boolean;
+begin
+  Result := FStereo;
+end;
+
+procedure TPTCOpenGLAttributes.SetStereo(AStereo: Boolean);
+begin
+  FStereo := AStereo;
+end;
+
+function TPTCOpenGLAttributes.GetStereoDontCare: Boolean;
+begin
+  Result := FStereoDontCare;
+end;
+
+procedure TPTCOpenGLAttributes.SetStereoDontCare(AStereoDontCare: Boolean);
+begin
+  FStereoDontCare := AStereoDontCare;
+end;
+
+function TPTCOpenGLAttributes.GetBufferSize: Integer;
+begin
+  Result := FBufferSize;
+end;
+
+procedure TPTCOpenGLAttributes.SetBufferSize(ABufferSize: Integer);
+begin
+  FBufferSize := ABufferSize;
+end;
+
+function TPTCOpenGLAttributes.GetDepthSize: Integer;
+begin
+  Result := FDepthSize;
+end;
+
+procedure TPTCOpenGLAttributes.SetDepthSize(ADepthSize: Integer);
+begin
+  FDepthSize := ADepthSize;
+end;
+
+function TPTCOpenGLAttributes.GetStencilSize: Integer;
+begin
+  Result := FStencilSize;
+end;
+
+procedure TPTCOpenGLAttributes.SetStencilSize(AStencilSize: Integer);
+begin
+  FStencilSize := AStencilSize;
+end;

packages/ptc/src/core/paletted.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/palettei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/surfaced.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/surfacei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/timerd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/core/timeri.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/dos/base/moused.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/dos/base/mousei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/dos/cga/cgaconsoled.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2012 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -30,7 +30,7 @@
 }
 
 type
-  TCGAConsole = class(TPTCBaseConsole)
+  TCGAConsole = class(TPTCOpenGLLessConsole)
   private
     { data }
     m_modes: array of IPTCMode;

packages/ptc/src/dos/cga/cgaconsolei.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2011 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public

packages/ptc/src/dos/textfx2/textfx2consoled.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2012 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -30,7 +30,7 @@
 }
 
 type
-  TTextFX2Console = class(TPTCBaseConsole)
+  TTextFX2Console = class(TPTCOpenGLLessConsole)
   private
     { data }
     FModes: array of IPTCMode;

packages/ptc/src/dos/textfx2/textfx2consolei.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2011 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public

packages/ptc/src/dos/vesa/vesaconsoled.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2012 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -30,7 +30,7 @@
 }
 
 type
-  TVESAConsole = class(TPTCBaseConsole)
+  TVESAConsole = class(TPTCOpenGLLessConsole)
   private
     { data }
     FModes: array of IPTCMode;

packages/ptc/src/dos/vesa/vesaconsolei.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2011 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public

packages/ptc/src/dos/vga/vgaconsoled.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2012 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -30,7 +30,7 @@
 }
 
 type
-  TVGAConsole = class(TPTCBaseConsole)
+  TVGAConsole = class(TPTCOpenGLLessConsole)
   private
     { data }
     m_modes: array of IPTCMode;

packages/ptc/src/dos/vga/vgaconsolei.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2011 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public

packages/ptc/src/ptc.pp

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -60,7 +60,7 @@ uses
 {$ENDIF FPDOC}
 
 const
-  PTCPAS_VERSION = 'PTCPas 0.99.12';
+  PTCPAS_VERSION = 'PTCPas 0.99.13';
 
 type
   PUint8  = ^Uint8;
@@ -113,7 +113,7 @@ uses
 
 {$IF defined(WIN32) OR defined(WIN64)}
 uses
-  Windows, p_ddraw;
+  Windows, p_ddraw, glext;
 {$ENDIF defined(WIN32) OR defined(WIN64)}
 
 {$IFDEF WinCE}
@@ -123,7 +123,7 @@ uses
 
 {$IFDEF UNIX}
 uses
-  BaseUnix, Unix, ctypes, x, xlib, xutil, xatom, keysym
+  BaseUnix, Unix, ctypes, x, xlib, xutil, xatom, keysym, xkblib
   {$IFDEF ENABLE_X11_EXTENSION_XRANDR}
   , xrandr
   {$ENDIF ENABLE_X11_EXTENSION_XRANDR}
@@ -136,6 +136,9 @@ uses
   {$IFDEF ENABLE_X11_EXTENSION_XSHM}
   , xshm, ipc
   {$ENDIF ENABLE_X11_EXTENSION_XSHM}
+  {$IFDEF ENABLE_X11_EXTENSION_GLX}
+  , glx
+  {$ENDIF ENABLE_X11_EXTENSION_GLX}
   ;
 {$ENDIF UNIX}
 
@@ -198,6 +201,9 @@ end;
 {$INCLUDE win32/directx/primaryd.inc}
 {$INCLUDE win32/directx/directxconsoled.inc}
 {$INCLUDE win32/gdi/win32dibd.inc}
+{$INCLUDE win32/gdi/win32modesetterd.inc}
+{$INCLUDE win32/gdi/win32openglwindowd.inc}
+{$INCLUDE win32/gdi/gdihookd.inc}
 {$INCLUDE win32/gdi/gdiconsoled.inc}
 
 {$INCLUDE win32/base/cursor.inc}
@@ -215,6 +221,9 @@ end;
 {$INCLUDE win32/directx/primary.inc}
 {$INCLUDE win32/directx/directxconsolei.inc}
 {$INCLUDE win32/gdi/win32dibi.inc}
+{$INCLUDE win32/gdi/win32modesetteri.inc}
+{$INCLUDE win32/gdi/win32openglwindowi.inc}
+{$INCLUDE win32/gdi/gdihooki.inc}
 {$INCLUDE win32/gdi/gdiconsolei.inc}
 {$ENDIF defined(Win32) OR defined(Win64)}
 

packages/ptc/src/ptcwrapper/ptceventqueue.pp

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2010, 2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/ptcwrapper/ptcwrapper.pp

@@ -1,6 +1,6 @@
 {
     Free Pascal PTCPas framebuffer library threaded wrapper
-    Copyright (C) 2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2010, 2011, 2012 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -259,8 +259,6 @@ procedure TPTCWrapperThread.Execute;
     end;
   end;
 
-var
-  I: Integer;
 begin
   try
     FConsole := TPTCConsoleFactory.CreateNew;

packages/ptc/src/win32/base/cursor.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/cursord.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/event.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/eventd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/hook.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009, 2010, 2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -38,7 +38,7 @@ type
   PWin32Hook_Lookup = ^TWin32Hook_Lookup;
   TWin32Hook_Lookup = record
     window: HWND;
-    wndproc: PtrUInt;
+    wndproc: LONG_PTR;
     hook: array [0..15] of TWin32Hook;
     count: Integer;
   end;

packages/ptc/src/win32/base/hookd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/kbd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -30,6 +30,11 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+{$WARNING this should be in the windows unit}
+const
+  VK_OEM_COMMA = $BC;
+  VK_OEM_PERIOD = $BE;
+
 constructor TWin32Keyboard.Create(AWindow: HWND; AThread: DWord; AMultithreaded: Boolean; AEventQueue: TEventQueue);
 begin
   FMonitor := nil;
@@ -133,6 +138,14 @@ begin
     KeyCode := wParam;
     if wParam = VK_RETURN then
       KeyCode := PTCKEY_ENTER;
+    if wParam = VK_INSERT then
+      KeyCode := PTCKEY_INSERT;
+    if wParam = VK_DELETE then
+      KeyCode := PTCKEY_DELETE;
+    if wParam = VK_OEM_COMMA then
+      KeyCode := PTCKEY_COMMA;
+    if wParam = VK_OEM_PERIOD then
+      KeyCode := PTCKEY_PERIOD;
 
     { handle key repeat count }
     for i := 1 to lParam and $FFFF do

packages/ptc/src/win32/base/kbdd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/monitor.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/monitord.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/moused.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/mousei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2007, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/base/window.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -43,11 +43,86 @@ begin
   FManaged := False;
 end;
 
-constructor TWin32Window.Create(const AWndClass, ATitle: string; AExtra, AStyle: DWord;
-                                AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded: Boolean;
-				AData: Pointer);
+function WndProcSingleThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; forward;
+function WndProcMultiThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; forward;
+
+constructor TWin32Window.Create(const AWndClass, ATitle: string; AExtra, AStyle, AClassStyle: DWord;
+                                AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded,
+                                ACursor: Boolean);
+var
+  program_instance{, library_instance}: DWord;
+  rectangle: RECT;
+  display_width, display_height: Integer;
+  wc: WNDCLASSEX;
 begin
-  internal_create(AWndClass, ATitle, AExtra, AStyle, AShow, AX, AY, AWidth, AHeight, ACenter, AMultithreaded, AData);
+  LOG('creating managed window');
+  Defaults;
+  FMultithreaded := AMultithreaded;
+  try
+    program_instance := GetModuleHandle(nil);
+{    library_instance := program_instance;}
+    wc.cbSize := SizeOf(WNDCLASSEX);
+    wc.hInstance := program_instance;
+    wc.lpszClassName := PChar(AWndClass);
+    wc.style := AClassStyle;
+    wc.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')};
+    wc.hIconSm := 0;
+    wc.lpszMenuName := nil;
+    wc.cbClsExtra := 0;
+    wc.cbWndExtra := 0;
+    wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
+    if AMultithreaded then
+      wc.lpfnWndProc := @WndProcMultiThreaded
+    else
+      wc.lpfnWndProc := @WndProcSingleThreaded;
+    if ACursor then
+      wc.hCursor := LoadCursor(0, IDC_ARROW)
+    else
+      wc.hCursor := 0;
+    RegisterClassEx(wc);
+    with rectangle do
+    begin
+      left := 0;
+      top := 0;
+      right := AWidth;
+      bottom := AHeight;
+    end;
+    AdjustWindowRectEx(rectangle, AStyle, False, AExtra);
+    if ACenter then
+    begin
+      LOG('centering window');
+      display_width := GetSystemMetrics(SM_CXSCREEN);
+      display_height := GetSystemMetrics(SM_CYSCREEN);
+      AX := (display_width - (rectangle.right - rectangle.left)) div 2;
+      AY := (display_height - (rectangle.bottom - rectangle.top)) div 2;
+    end;
+    FName := AWndClass;
+    FTitle := ATitle;
+    FExtra := AExtra;
+    FStyle := AStyle;
+    FShow := AShow;
+    FX := AX;
+    FY := AY;
+    FWidth := rectangle.right - rectangle.left;
+    FHeight := rectangle.bottom - rectangle.top;
+    if AMultithreaded then
+    begin
+      {...}
+    end
+    else
+    begin
+      FWindow := CreateWindowEx(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, Self);
+      if not IsWindow(FWindow) then
+        raise TPTCError.Create('could not create window');
+      ShowWindow(FWindow, FShow);
+      SetFocus(FWindow);
+      SetActiveWindow(FWindow);
+      SetForegroundWindow(FWindow);
+    end;
+  except
+    on error: TPTCError do
+      raise TPTCError.Create('could not create window', error);
+  end;
 end;
 
 destructor TWin32Window.Destroy;
@@ -163,8 +238,23 @@ begin
 end;
 
 function WndProcSingleThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
+var
+  WindowObject: TWin32Window;
+  pCreate: PCREATESTRUCT;
 begin
   case message of
+    WM_CREATE:
+      begin
+        pCreate := PCREATESTRUCT(lParam);
+        WindowObject := TWin32Window(pCreate^.lpCreateParams);
+        SetWindowLongPtr(hWnd, GWLP_USERDATA, LONG_PTR(WindowObject));
+        Result := WindowObject.WMCreate(hWnd, message, wParam, lParam);
+      end;
+    WM_DESTROY:
+      begin
+        WindowObject := TWin32Window(GetWindowLongPtr(hWnd, GWLP_USERDATA));
+        Result := WindowObject.WMDestroy(hWnd, message, wParam, lParam);
+      end;
     WM_SYSCOMMAND:
       begin
         { this fixes the pausing of the application when the Alt or F10 key is pressed }
@@ -227,83 +317,6 @@ begin
   end;
 end;
 
-procedure TWin32Window.internal_create(const AWndClass, ATitle: string; AExtra, AStyle: DWord;
-                                       AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded: Boolean;
-				       AData: Pointer);
-var
-  program_instance{, library_instance}: DWord;
-  rectangle: RECT;
-  display_width, display_height: Integer;
-  wc: WNDCLASSEX;
-begin
-  LOG('creating managed window');
-  Defaults;
-  FMultithreaded := AMultithreaded;
-  try
-    program_instance := GetModuleHandle(nil);
-{    library_instance := program_instance;}
-    wc.cbSize := SizeOf(WNDCLASSEX);
-    wc.hInstance := program_instance;
-    wc.lpszClassName := PChar(AWndClass);
-    wc.style := CS_VREDRAW or CS_HREDRAW;
-    wc.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')};
-    wc.hIconSm := 0;
-    wc.lpszMenuName := nil;
-    wc.cbClsExtra := 0;
-    wc.cbWndExtra := 0;
-    wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
-    if AMultithreaded then
-      wc.lpfnWndProc := @WndProcMultiThreaded
-    else
-      wc.lpfnWndProc := @WndProcSingleThreaded;
-    wc.hCursor := LoadCursor(0, IDC_ARROW);
-    RegisterClassEx(wc);
-    with rectangle do
-    begin
-      left := 0;
-      top := 0;
-      right := AWidth;
-      bottom := AHeight;
-    end;
-    AdjustWindowRectEx(rectangle, AStyle, False, AExtra);
-    if ACenter then
-    begin
-      LOG('centering window');
-      display_width := GetSystemMetrics(SM_CXSCREEN);
-      display_height := GetSystemMetrics(SM_CYSCREEN);
-      AX := (display_width - (rectangle.right - rectangle.left)) div 2;
-      AY := (display_height - (rectangle.bottom - rectangle.top)) div 2;
-    end;
-    FName := AWndClass;
-    FTitle := ATitle;
-    FExtra := AExtra;
-    FStyle := AStyle;
-    FShow := AShow;
-    FX := AX;
-    FY := AY;
-    FWidth := rectangle.right - rectangle.left;
-    FHeight := rectangle.bottom - rectangle.top;
-    FData := AData;
-    if AMultithreaded then
-    begin
-      {...}
-    end
-    else
-    begin
-      FWindow := CreateWindowEx(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, FData);
-      if not IsWindow(FWindow) then
-        raise TPTCError.Create('could not create window');
-      ShowWindow(FWindow, FShow);
-      SetFocus(FWindow);
-      SetActiveWindow(FWindow);
-      SetForegroundWindow(FWindow);
-    end;
-  except
-    on error: TPTCError do
-      raise TPTCError.Create('could not create window', error);
-  end;
-end;
-
 procedure TWin32Window.Defaults;
 begin
   FWindow := 0;
@@ -319,7 +332,6 @@ begin
   FY := 0;
   FWidth := 0;
   FHeight := 0;
-  FData := nil;
   FManaged := True;
   FMultithreaded := False;
 end;
@@ -367,7 +379,7 @@ var
 begin
   with AOwner do
   begin
-    FWindow := CreateWindowEx(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, FData);
+    FWindow := CreateWindowEx(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, nil);
     if IsWindow(FWindow) then
     begin
       ShowWindow(FWindow, FShow);
@@ -384,3 +396,13 @@ begin
       SetEvent(FEvent);
   end;
 end;
+
+function TWin32Window.WMCreate(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
+begin
+  Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
+end;
+
+function TWin32Window.WMDestroy(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
+begin
+  Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
+end;

packages/ptc/src/win32/base/windowd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009, 2010, 2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -44,26 +44,24 @@ type
     FShow: Integer;
     FX, FY: Integer;
     FWidth, FHeight: Integer;
-    FData: Pointer;
     FManaged: Boolean;
     FMultithreaded: Boolean;
     FCursorConfineInEffect: Boolean;
 
 {    class function WndProcSingleThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;
     class function WndProcMultiThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;}
-    procedure internal_create(const AWndClass, ATitle: string; AExtra, AStyle: DWord;
-                              AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded: Boolean;
-			      AData: Pointer);
 
     procedure Defaults;
     procedure Close;
     function GetThread: DWord;
     class procedure ThreadFunction(AOwner: TWin32Window);
+  protected
+    function WMCreate(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; virtual;
+    function WMDestroy(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; virtual;
   public
     constructor Create(window: HWND);
-    constructor Create(const AWndClass, ATitle: string; AExtra, AStyle: DWord;
-                       AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded: Boolean;
-		       AData: Pointer = nil);
+    constructor Create(const AWndClass, ATitle: string; AExtra, AStyle, AClassStyle: DWord;
+                       AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded, ACursor: Boolean);
     destructor Destroy; override;
     procedure Cursor(AFlag: Boolean);
     procedure ConfineCursor(AFlag: Boolean);

packages/ptc/src/win32/directx/check.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/directx/directxconsoled.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -32,7 +32,7 @@
 
 type
   TPrimaryModeEnum = (DIRECT, SECONDARY);
-  TDirectXConsole = class(TPTCBaseConsole)
+  TDirectXConsole = class(TPTCOpenGLLessConsole)
   private
     { title data }
 {    FTitle: array [0..1023] of Char;}

packages/ptc/src/win32/directx/directxconsolei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -313,18 +313,14 @@ begin
   if AOption = 'grab mouse' then
   begin
     if FOpen and (not FFullscreen) then
-    begin
       FWindow.ConfineCursor(True);
-    end;
     FGrabMouse := True;
     exit;
   end;
   if AOption = 'ungrab mouse' then
   begin
     if FOpen and (not FFullscreen) then
-    begin
       FWindow.ConfineCursor(False);
-    end;
     FGrabMouse := False;
     exit;
   end;
@@ -1028,17 +1024,15 @@ begin
                                     FTitle,
                                     WS_EX_TOPMOST,
                                     DWord(WS_POPUP or WS_SYSMENU or WS_VISIBLE), // fpc windows RTL bug - WS_POPUP should be a DWord!!!
+                                    CS_VREDRAW or CS_HREDRAW,
                                     SW_NORMAL,
                                     0, 0,
                                     GetSystemMetrics(SM_CXSCREEN),
                                     GetSystemMetrics(SM_CYSCREEN),
-                                    False, False)
+                                    False, False, FCursor)
   else
     FWindow := TWin32Window.Create(window);
 
-  { set window cursor }
-  FWindow.Cursor(FCursor);
-
   if FCursor then
     FWin32Cursor.Show
   else
@@ -1147,12 +1141,11 @@ begin
       extended := WS_EX_TOPMOST;
     case FWindowMode of
       RESIZABLE: FWindow := TWin32Window.Create('PTC_DIRECTX_WINDOWED_RESIZABLE', FTitle,
-                                              extended, WS_OVERLAPPEDWINDOW or WS_VISIBLE, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, FCenterWindow, False);
+                                              extended, WS_OVERLAPPEDWINDOW or WS_VISIBLE, CS_VREDRAW or CS_HREDRAW, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, FCenterWindow, False, FCursor);
       FIXED: FWindow := TWin32Window.Create('PTC_DIRECTX_WINDOWED_FIXED', FTitle,
-                                              extended, WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, FCenterWindow, False);
+                                              extended, WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX, CS_VREDRAW or CS_HREDRAW, SW_NORMAL, CW_USEDEFAULT, CW_USEDEFAULT, mode.width, mode.height, FCenterWindow, False, FCursor);
     end;
   end;
-  FWindow.Cursor(FCursor);
   FDisplay.cooperative(FWindow.handle, False);
 end;
 

packages/ptc/src/win32/directx/display.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/directx/displayd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/directx/hook.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -139,6 +139,22 @@ begin
 	end;
       end;
     end;
+    WM_PALETTECHANGED:
+      begin
+        LOG('TDirectXHook WM_PALETTECHANGED');
+        if Windows.HWND(wParam) <> hWnd then
+        begin
+          LOG('not our window');
+          if FConsole.FPrimary.Active then
+          begin
+            FConsole.FPrimary.ResetPalette;
+          end;
+        end;
+      end;
+    WM_QUERYNEWPALETTE:
+      begin
+        LOG('TDirectXHook WM_QUERYNEWPALETTE');
+      end;
     WM_CLOSE: begin
       LOG('TDirectXHook WM_CLOSE');
 

packages/ptc/src/win32/directx/hookd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/directx/library.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/directx/libraryd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/directx/primary.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -483,22 +483,27 @@ begin
 end;
 
 procedure TDirectXPrimary.Palette(APalette: IPTCPalette);
+begin
+  Block;
+
+  FPalette.Load(APalette.Data);
+  ResetPalette;
+end;
+
+procedure TDirectXPrimary.ResetPalette;
 var
   data: PUint32;
   temp: array [0..255] of PALETTEENTRY;
   I: Integer;
   DDP: IDirectDrawPalette;
 begin
-  Block;
-
-  FPalette.Load(APalette.Data);
   if not FFormat.Indexed then
   begin
     LOG('palette set in direct color');
   end
   else
   begin
-    data := APalette.Data;
+    data := FPalette.Data;
     for I := 0 to 255 do
     begin
       temp[I].peRed := (data[I] and $00FF0000) shr 16;

packages/ptc/src/win32/directx/primaryd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2009-2012  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -96,6 +96,7 @@ type
     procedure Clear(AColor: IPTCColor; const AArea: IPTCArea);
 
     procedure Palette(APalette: IPTCPalette);
+    procedure ResetPalette;
     function Palette: IPTCPalette;
 
     procedure Clip(const AArea: IPTCArea);

packages/ptc/src/win32/directx/translate.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or

packages/ptc/src/win32/gdi/gdiconsoled.inc

@@ -1,7 +1,6 @@
 {
-    Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
-    Original C++ version by Glenn Fiedler ([email protected])
+    This file is part of the PTCPas framebuffer library
+    Copyright (C) 2007, 2009-2012  Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -37,6 +36,8 @@ type
     FWin32DIB: TWin32DIB;
     FKeyboard: TWin32Keyboard;
     FMouse: TWin32Mouse;
+    FWin32Cursor: TWin32Cursor;
+    FHook: TGDIHook;
 
     FCopy: TPTCCopy;
     FClear: TPTCClear;
@@ -46,6 +47,10 @@ type
     FPalette: IPTCPalette;
     FModes: array of IPTCMode;
 
+    FFullscreen: Boolean;
+    FModeSetter: TWin32ModeSetter;
+    FGrabMouse: Boolean;
+
     FOpen: Boolean;
     FLocked: Boolean;
     FCursor: Boolean;
@@ -60,6 +65,8 @@ type
     FDefaultHeight: Integer;
     FDefaultFormat: IPTCFormat;
 
+    FUseOpenGL: Boolean;
+
     procedure UpdateCursor;
 
     function GetWidth: Integer; override;
@@ -72,6 +79,9 @@ type
     function GetTitle: string; override;
     function GetInformation: string; override;
 
+    function GetOpenGL_Enabled: Boolean; override;
+    procedure SetOpenGL_Enabled(AValue: Boolean); override;
+
     procedure CheckOpen(const AMessage: string);
     procedure CheckUnlocked(const AMessage: string);
   public
@@ -134,4 +144,8 @@ type
 
     function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
     function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
+
+    procedure OpenGL_SwapBuffers; override;
+	procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
+	function OpenGL_GetSwapInterval: Integer; override;
   end;

packages/ptc/src/win32/gdi/gdiconsolei.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2007, 2009-2012  Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -38,8 +38,8 @@ begin
   FDisplayWidth := GetSystemMetrics(SM_CXSCREEN);
   FDisplayHeight := GetSystemMetrics(SM_CYSCREEN);
 
-  FDefaultWidth := 320;
-  FDefaultHeight := 200;
+  FDefaultWidth := 640;
+  FDefaultHeight := 480;
   FDefaultFormat := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
 
   FCopy := TPTCCopy.Create;
@@ -47,6 +47,11 @@ begin
   FArea := TPTCArea.Create;
   FClip := TPTCArea.Create;
   FPalette := TPTCPalette.Create;
+  FWin32Cursor := TWin32Cursor.Create;
+
+  FFullscreen := True;
+
+  FModeSetter := TWin32ModeSetter.Create;
 
   FOpen := False;
 
@@ -65,11 +70,14 @@ begin
 
   {...}
 
+  FModeSetter.Free;
+
   FWin32DIB.Free;
   FWindow.Free;
   FEventQueue.Free;
   FCopy.Free;
   FClear.Free;
+  FWin32Cursor.Free;
 
   inherited Destroy;
 end;
@@ -99,44 +107,112 @@ begin
   if FOpen then
     Close;
 
+  case FCursorMode of
+    CURSOR_DEFAULT:
+      FCursor := not FFullScreen;
+    CURSOR_SHOW:
+      FCursor := True;
+    CURSOR_HIDE:
+      FCursor := False;
+  end;
+
+  if FFullscreen then
+  begin
+    FModeSetter.Save;
+    FModeSetter.Open(AWidth, AHeight, AFormat);
+  end;
+
 (*  FWindow := TWin32Window.Create('PTC_GDI_FULLSCREEN',
                                  ATitle,
                                  WS_EX_TOPMOST,
                                  DWord(WS_POPUP or WS_SYSMENU or WS_VISIBLE), // fpc windows RTL bug - WS_POPUP should be a DWord!!!
+                                 CS_HREDRAW or CS_VREDRAW,
                                  SW_NORMAL,
                                  0, 0,
                                  GetSystemMetrics(SM_CXSCREEN),
                                  GetSystemMetrics(SM_CYSCREEN),
                                  False, False);*)
 
-  FWindow := TWin32Window.Create('PTC_GDI_WINDOWED_FIXED',
-                                 ATitle,
-                                 0,
-                                 WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX,
-                                 SW_NORMAL,
-                                 CW_USEDEFAULT, CW_USEDEFAULT,
-                                 AWidth, AHeight,
-                                 {m_center_window}False,
-                                 False);
-
 (*  FWindow := TWin32Window.Create('PTC_GDI_WINDOWED_RESIZABLE',
                                  ATitle,
                                  0,
                                  WS_OVERLAPPEDWINDOW or WS_VISIBLE,
+                                 CS_HREDRAW or CS_VREDRAW,
                                  SW_NORMAL,
                                  CW_USEDEFAULT, CW_USEDEFAULT,
                                  AWidth, AHeight,
                                  {m_center_window}False,
                                  False);*)
 
+  if FFullscreen then
+  begin
+    if FUseOpenGL then
+      FWindow := TWin32OpenGLWindow.Create('PTC_OPENGL_FULLSCREEN',
+                                           ATitle,
+                                           WS_EX_TOPMOST or WS_EX_APPWINDOW,
+                                           WS_VISIBLE or WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
+                                           CS_HREDRAW or CS_VREDRAW or CS_OWNDC,
+                                           SW_NORMAL,
+                                           CW_USEDEFAULT, CW_USEDEFAULT,
+                                           AWidth, AHeight,
+                                           {m_center_window}False,
+                                           False,
+                                           FCursor,
+                                           FOpenGLAttributes)
+    else
+      FWindow := TWin32Window.Create('PTC_GDI_FULLSCREEN',
+                                     ATitle,
+                                     WS_EX_TOPMOST or WS_EX_APPWINDOW,
+                                     WS_VISIBLE or WS_POPUP,
+                                     CS_HREDRAW or CS_VREDRAW,
+                                     SW_NORMAL,
+                                     CW_USEDEFAULT, CW_USEDEFAULT,
+                                     AWidth, AHeight,
+                                     {m_center_window}False,
+                                     False,
+                                     FCursor);
+  end
+  else
+  begin
+    if FUseOpenGL then
+      FWindow := TWin32OpenGLWindow.Create('PTC_OPENGL_WINDOWED_FIXED',
+                                           ATitle,
+                                           0,
+                                           WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX or WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
+                                           CS_HREDRAW or CS_VREDRAW or CS_OWNDC,
+                                           SW_NORMAL,
+                                           CW_USEDEFAULT, CW_USEDEFAULT,
+                                           AWidth, AHeight,
+                                           {m_center_window}False,
+                                           False,
+                                           FCursor,
+                                           FOpenGLAttributes)
+    else
+      FWindow := TWin32Window.Create('PTC_GDI_WINDOWED_FIXED',
+                                     ATitle,
+                                     0,
+                                     WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX,
+                                     CS_HREDRAW or CS_VREDRAW,
+                                     SW_NORMAL,
+                                     CW_USEDEFAULT, CW_USEDEFAULT,
+                                     AWidth, AHeight,
+                                     {m_center_window}False,
+                                     False,
+                                     FCursor);
+  end;
+
   FWin32DIB := TWin32DIB.Create(AWidth, AHeight);
 
   FreeAndNil(FKeyboard);
   FreeAndNil(FMouse);
+  FreeAndNil(FHook);
   FreeAndNil(FEventQueue);
   FEventQueue := TEventQueue.Create;
+  FHook := TGDIHook.Create(Self, FWindow.Handle, FWindow.Thread, FCursor, {AManaged}True, FFullScreen);
   FKeyboard := TWin32Keyboard.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue);
-  FMouse := TWin32Mouse.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue, {FFullScreen}False, AWidth, AHeight);
+  FMouse := TWin32Mouse.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue, FFullScreen, AWidth, AHeight);
+  if FFullscreen then
+    FMouse.SetWindowArea(0, 0, AWidth, AHeight);
 
   tmpArea := TPTCArea.Create(0, 0, AWidth, AHeight);
   FArea := tmpArea;
@@ -144,6 +220,13 @@ begin
 
   FWindow.Update;
 
+  { hide/show cursor globally if running fullscreen }
+  if FFullscreen then
+    if FCursor then
+      FWin32Cursor.Show
+    else
+      FWin32Cursor.Hide;
+
   FTitle := ATitle;
 
   FOpen := True;
@@ -156,8 +239,16 @@ begin
 
   {...}
 
+  if FFullscreen then
+  begin
+    FModeSetter.Close;
+    FModeSetter.Restore;
+    FWin32Cursor.Show;
+  end;
+
   FreeAndNil(FKeyboard);
   FreeAndNil(FMouse);
+  FreeAndNil(FHook);
 
   FreeAndNil(FWin32DIB);
   FreeAndNil(FWindow);
@@ -273,22 +364,25 @@ begin
 
   case FCursorMode of
     CURSOR_DEFAULT:
-      FCursor := {Not FFullScreen}True;
+      FCursor := not FFullScreen;
     CURSOR_SHOW:
       FCursor := True;
     CURSOR_HIDE:
       FCursor := False;
   end;
 
+  { update hook cursor }
+  FHook.Cursor(FCursor);
+
   { update window cursor }
   FWindow.Cursor(FCursor);
 
   { hide/show cursor globally if running fullscreen }
-{  if FFullscreen then
+  if FFullscreen then
     if FCursor then
-      Win32Cursor_resurrect
+      FWin32Cursor.Show
     else
-      Win32Cursor_kill;}
+      FWin32Cursor.Hide;
 end;
 
 procedure TGDIConsole.Clear;
@@ -334,6 +428,21 @@ function TGDIConsole.Option(const AOption: String): Boolean;
 begin
   LOG('console option', AOption);
   Result := True;
+  if AOption = 'default output' then
+  begin
+    FFullscreen := False;
+    exit;
+  end;
+  if AOption = 'windowed output' then
+  begin
+    FFullscreen := False;
+    exit;
+  end;
+  if AOption = 'fullscreen output' then
+  begin
+    FFullscreen := True;
+    exit;
+  end;
   if AOption = 'default cursor' then
   begin
     FCursorMode := CURSOR_DEFAULT;
@@ -354,12 +463,16 @@ begin
   end;
   if AOption = 'grab mouse' then
   begin
-    FWindow.ConfineCursor(true);
+    if FOpen and (not FFullscreen) then
+      FWindow.ConfineCursor(True);
+    FGrabMouse := True;
     exit;
   end;
   if AOption = 'ungrab mouse' then
   begin
-    FWindow.ConfineCursor(false);
+    if FOpen and (not FFullscreen) then
+      FWindow.ConfineCursor(False);
+    FGrabMouse := False;
     exit;
   end;
 
@@ -539,6 +652,58 @@ begin
   Result := ''; // todo...
 end;
 
+function TGDIConsole.GetOpenGL_Enabled: Boolean;
+begin
+  Result := FUseOpenGL;
+end;
+
+procedure TGDIConsole.SetOpenGL_Enabled(AValue: Boolean);
+begin
+  if FOpen then
+    raise TPTCError.Create('Value of UseOpenGL cannot be modified while the console is open');
+  FUseOpenGL := AValue;
+end;
+
+procedure TGDIConsole.OpenGL_SwapBuffers;
+begin
+  SwapBuffers(wglGetCurrentDC);
+end;
+
+procedure TGDIConsole.OpenGL_SetSwapInterval(AInterval: Integer);
+begin
+  LOG('SetSwapInterval(' + IntToStr(AInterval) + ')');
+  if AInterval < 0 then
+    raise TPTCError.Create('Invalid swap interval');
+  LOG('checking if WGL_EXT_swap_control is supported');
+  if Load_WGL_EXT_swap_control then
+  begin
+    LOG('using WGL_EXT_swap_control');
+    LOG('wglSwapIntervalEXT(' + IntToStr(AInterval) + ')');
+    if not wglSwapIntervalEXT(AInterval) then
+	  LOG('wglSwapIntervalEXT failed');
+  end
+  else
+    LOG('no supported extensions found for setting the swap interval');
+end;
+
+function TGDIConsole.OpenGL_GetSwapInterval: Integer;
+begin
+  LOG('GetSwapInterval');
+  LOG('checking if WGL_EXT_swap_control is supported');
+  if Load_WGL_EXT_swap_control then
+  begin
+    LOG('using WGL_EXT_swap_control');
+    LOG('wglGetSwapIntervalEXT()');
+    Result := wglGetSwapIntervalEXT();
+    LOG('wglGetSwapIntervalEXT() result', Result);
+  end
+  else
+  begin
+    LOG('no supported extensions found for setting the swap interval, assuming the swap interval is 0');
+    Result := 0;
+  end;
+end;
+
 procedure TGDIConsole.CheckOpen(const AMessage: String);
 begin
   if not FOpen then

packages/ptc/src/win32/gdi/gdihookd.inc

@@ -0,0 +1,55 @@
+{
+    This file is part of the PTCPas framebuffer library
+    Copyright (C) 2012 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library 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
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+type
+  TGDIConsole = class;
+  TGDIHook = class(TWin32Hook)
+  private
+    { console }
+    FCursor: Boolean;
+    FManaged: Boolean;
+    FFullscreen: Boolean;
+    FConsole: TGDIConsole;
+  protected
+    { window procedure }
+    function WndProc(hWnd: HWND; message: DWord; wParam: WPARAM; lParam: LPARAM): LRESULT; override;
+
+    { window management }
+    procedure Activate;
+    procedure Deactivate;
+  public
+    { setup }
+    constructor Create(AConsole: TGDIConsole; AWindow: HWND; AThread: DWord; ACursor, AManaged, AFullscreen: Boolean);
+    destructor Destroy; override;
+
+    { cursor management }
+    procedure Cursor(AFlag: Boolean);
+  end;

packages/ptc/src/win32/gdi/gdihooki.inc

@@ -0,0 +1,214 @@
+{
+    This file is part of the PTCPas framebuffer library
+    Copyright (C) 2012 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library 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
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+constructor TGDIHook.Create(AConsole: TGDIConsole; AWindow: HWND; AThread: DWord; ACursor, AManaged, AFullscreen: Boolean);
+begin
+  FConsole := AConsole;
+
+  FCursor := ACursor;
+  FManaged := AManaged;
+  FFullscreen := AFullscreen;
+
+  LOG('creating window hook');
+
+  inherited Create(AWindow, AThread);
+end;
+
+destructor TGDIHook.Destroy;
+begin
+  LOG('destroying window hook');
+  inherited Destroy;
+end;
+
+procedure TGDIHook.Cursor(AFlag: Boolean);
+begin
+  FCursor := AFlag;
+end;
+
+function TGDIHook.WndProc(hWnd: HWND; message: DWord; wParam: WPARAM; lParam: LPARAM): LRESULT;
+
+  function WMSizeWParam2String(wParam: WPARAM): string;
+  begin
+    case wParam of
+      SIZE_MAXHIDE:   Result := 'SIZE_MAXHIDE';
+      SIZE_MAXIMIZED: Result := 'SIZE_MAXIMIZED';
+      SIZE_MAXSHOW:   Result := 'SIZE_MAXSHOW';
+      SIZE_MINIMIZED: Result := 'SIZE_MINIMIZED';
+      SIZE_RESTORED:  Result := 'SIZE_RESTORED';
+      else
+        Result := 'Unknown (' + IntToStr(wParam) + ')';
+    end;
+  end;
+
+var
+  active: Boolean;
+  thread: DWord;
+  console: TGDIConsole;
+begin
+  case message of
+    WM_PAINT: begin
+      LOG('TGDIHook WM_PAINT');
+
+      { paint console }
+      //FConsole.Paint;
+    end;
+    WM_ACTIVATEAPP: begin
+      LOG('TGDIHook WM_ACTIVATEAPP');
+
+      { get window message data }
+      active := wParam <> 0;
+      thread := DWord(lParam);
+
+      { check active flag }
+      if active = False then
+      begin
+        if FConsole.FGrabMouse and (not FFullscreen) then
+          FConsole.FWindow.ConfineCursor(False);
+
+        if FFullscreen then
+          ShowWindow(FWindow, SW_MINIMIZE);
+      end
+      else
+      begin
+        if FConsole.FGrabMouse and (not FFullscreen) then
+          FConsole.FWindow.ConfineCursor(True);
+      end;
+
+    end;
+    WM_SIZE:
+      begin
+        LOG('TGDIHook WM_SIZE, wParam = ' + WMSizeWParam2String(wParam));
+        case wParam of
+          SIZE_MINIMIZED:
+            begin
+              Deactivate;
+            end;
+          SIZE_RESTORED, SIZE_MAXIMIZED:
+            begin
+              Activate;
+            end;
+        end;
+
+        { pass to the next handler (or DefWindowProc) }
+        Result := 0;
+        exit;
+      end;
+    WM_SETCURSOR: begin
+      { check cursor }
+      if not FCursor then
+      begin
+        if FFullscreen or (LOWORD(lParam) = HTCLIENT) then
+        begin
+          { hide cursor }
+          SetCursor(0);
+
+          { handled }
+          Result := 1;
+        end;
+      end;
+    end;
+    WM_CLOSE: begin
+      LOG('TGDIHook WM_CLOSE');
+
+      if FManaged then
+      begin
+        console := FConsole;
+
+        { close console }
+        console.Close;
+
+        { note: at this point the hook object has been destroyed by the console! }
+
+        { internal console shutdown }
+        //console.internal_shutdown;
+
+        { halt }
+        Halt(0);
+      end;
+
+      { handled }
+      Result := 1;
+      exit;
+    end;
+  end;
+
+  { unhandled }
+  Result := 0;
+end;
+
+procedure TGDIHook.Activate;
+var
+//  placement: WINDOWPLACEMENT;
+  ModeSetter: TWin32ModeSetter;
+begin
+  LOG('activate');
+
+  if FConsole.FOpen then
+  begin
+    if FFullscreen then
+    begin
+      ModeSetter := FConsole.FModeSetter;
+
+      if not ModeSetter.InMode then
+      begin
+        ModeSetter.Save;
+        ModeSetter.Enter;
+      end;
+
+      if not FCursor then
+        FConsole.FWin32Cursor.Hide;
+    end;
+  end;
+end;
+
+procedure TGDIHook.Deactivate;
+var
+  ModeSetter: TWin32ModeSetter;
+begin
+  LOG('deactivate');
+
+  if FConsole.FOpen then
+  begin
+    if FFullscreen then
+    begin
+      if not FCursor then
+        FConsole.FWin32Cursor.Show;
+
+      ModeSetter := FConsole.FModeSetter;
+
+      if ModeSetter.InMode then
+      begin
+        ModeSetter.Leave;
+        ModeSetter.Restore;
+      end;
+    end;
+  end;
+end;

packages/ptc/src/win32/gdi/win32dibd.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2011 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public

packages/ptc/src/win32/gdi/win32dibi.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2011 Nikolay Nikolov ([email protected])
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public

packages/ptc/src/win32/gdi/win32modesetterd.inc

@@ -0,0 +1,56 @@
+{
+    This file is part of the PTCPas framebuffer library
+    Copyright (C) 2012 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library 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
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+type
+  TWin32ModeSetter = class
+  private
+    FInMode: Boolean;
+    FOpen: Boolean;
+    FModes: array of IPTCMode;
+
+    FChosenMode: TDEVMODE;
+
+    procedure SetupModeList;
+    procedure DispChangeCheck(ADispChangeResult: LONG);
+    procedure LogDevMode(const ADevMode: TDEVMODE);
+  public
+    constructor Create;
+
+    procedure Open(AWidth, AHeight: Integer; AFormat: IPTCFormat);
+    procedure Close;
+
+    procedure Save;
+    procedure Restore;
+    procedure Enter;
+    procedure Leave;
+    property InMode: Boolean read FInMode;
+    property IsOpen: Boolean read FOpen;
+  end;

packages/ptc/src/win32/gdi/win32modesetteri.inc

@@ -0,0 +1,288 @@
+{
+    This file is part of the PTCPas framebuffer library
+    Copyright (C) 2012 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library 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
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{$WARNING add these to windows unit}
+const
+  DISP_CHANGE_BADPARAM = -5;
+  DISP_CHANGE_BADDUALVIEW = -6;
+  DM_POSITION = $00000020;
+  DM_NUP = $00000040;
+  DM_PANNINGWIDTH = $08000000;
+  DM_PANNINGHEIGHT = $10000000;
+  DMDFO_DEFAULT = 0;
+  DMDFO_STRETCH = 1;
+  DMDFO_CENTER  = 2;
+
+constructor TWin32ModeSetter.Create;
+begin
+  SetupModeList;
+end;
+
+procedure TWin32ModeSetter.Open(AWidth, AHeight: Integer; AFormat: IPTCFormat);
+var
+  dm: TDEVMODE;
+begin
+  FillChar(dm, SizeOf(dm), 0);
+  dm.dmSize := SizeOf(dm);
+  dm.dmPelsWidth := AWidth;
+  dm.dmPelsHeight := AHeight;
+  dm.dmBitsPerPel := AFormat.Bits;
+  dm.dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
+
+  DispChangeCheck(ChangeDisplaySettings(@dm, CDS_FULLSCREEN));
+
+  FillChar(FChosenMode, SizeOf(FChosenMode), 0);
+  FChosenMode.dmSize := SizeOf(FChosenMode);
+  FChosenMode.dmDriverExtra := 0;
+  if not EnumDisplaySettings(nil, ENUM_CURRENT_SETTINGS, @FChosenMode) then
+    raise TPTCError.Create('EnumDisplaySettings(ENUM_CURRENT_SETTINGS) failed after mode set');
+
+  FInMode := True;
+  FOpen := True;
+end;
+
+procedure TWin32ModeSetter.Close;
+begin
+  FOpen := False;
+  if not FInMode then
+    exit;
+
+  DispChangeCheck(ChangeDisplaySettings(nil, 0));
+  FInMode := False;
+end;
+
+procedure TWin32ModeSetter.Save;
+begin
+  LOG('saving desktop');
+end;
+
+procedure TWin32ModeSetter.Restore;
+begin
+  LOG('restoring desktop');
+end;
+
+procedure TWin32ModeSetter.Enter;
+begin
+  LOG('entering mode');
+  if not FInMode then
+  begin
+    DispChangeCheck(ChangeDisplaySettings(@FChosenMode, CDS_FULLSCREEN));
+    FInMode := True;
+  end;
+end;
+
+procedure TWin32ModeSetter.Leave;
+begin
+  LOG('leaving mode');
+  if FInMode then
+  begin
+    DispChangeCheck(ChangeDisplaySettings(nil, 0));
+    FInMode := False;
+  end;
+end;
+
+procedure TWin32ModeSetter.SetupModeList;
+var
+  dm: TDEVMODE;
+  I: Integer;
+  ModeExists: Boolean;
+begin
+  LOG('getting list of display modes');
+  SetLength(FModes, 0);
+  I := 0;
+  repeat
+    FillChar(dm, SizeOf(dm), 0);
+    dm.dmSize := SizeOf(dm);
+    dm.dmDriverExtra := 0;
+    ModeExists := EnumDisplaySettings(nil, I, @dm);
+    if ModeExists then
+    begin
+      LogDevMode(dm);
+      LOG(IntToStr(dm.dmPelsWidth) + 'x' + IntToStr(dm.dmPelsHeight) + 'x' + IntToStr(dm.dmBitsPerPel) + ' ' + IntToStr(dm.dmDisplayFrequency) + ' Hz');
+      {todo: add to FModes list...}
+      Inc(I);
+    end;
+  until not ModeExists;
+  LOG('done getting the list of modes');
+end;
+
+procedure TWin32ModeSetter.DispChangeCheck(ADispChangeResult: LONG);
+
+  function DispChangeResult2String(ADispChangeResult: LONG): string;
+  begin
+    case ADispChangeResult of
+      DISP_CHANGE_SUCCESSFUL:  Result := 'DISP_CHANGE_SUCCESSFUL';
+      DISP_CHANGE_BADDUALVIEW: Result := 'DISP_CHANGE_BADDUALVIEW';
+      DISP_CHANGE_BADFLAGS:    Result := 'DISP_CHANGE_BADFLAGS';
+      DISP_CHANGE_BADMODE:     Result := 'DISP_CHANGE_BADMODE';
+      DISP_CHANGE_BADPARAM:    Result := 'DISP_CHANGE_BADPARAM';
+      DISP_CHANGE_FAILED:      Result := 'DISP_CHANGE_FAILED';
+      DISP_CHANGE_NOTUPDATED:  Result := 'DISP_CHANGE_NOTUPDATED';
+      DISP_CHANGE_RESTART:     Result := 'DISP_CHANGE_RESTART';
+      else
+        Result := 'Unknown';
+    end;
+    Result := IntToStr(ADispChangeResult) + ' (' + Result + ')';
+  end;
+
+begin
+  if ADispChangeResult <> DISP_CHANGE_SUCCESSFUL then
+    raise TPTCError.Create('Error setting display mode; ChangeDisplaySettings returned ' + DispChangeResult2String(ADispChangeResult));
+end;
+
+procedure TWin32ModeSetter.LogDevMode(const ADevMode: TDEVMODE);
+
+  function Fields2String(dmFields: DWORD): string;
+  begin
+    Result := '';
+    if (dmFields and DM_ORIENTATION) <> 0 then
+      Result := Result + 'DM_ORIENTATION + ';
+    if (dmFields and DM_PAPERSIZE) <> 0 then
+      Result := Result + 'DM_PAPERSIZE + ';
+    if (dmFields and DM_PAPERLENGTH) <> 0 then
+      Result := Result + 'DM_PAPERLENGTH + ';
+    if (dmFields and DM_PAPERWIDTH) <> 0 then
+      Result := Result + 'DM_PAPERWIDTH + ';
+    if (dmFields and DM_SCALE) <> 0 then
+      Result := Result + 'DM_SCALE + ';
+    if (dmFields and DM_COPIES) <> 0 then
+      Result := Result + 'DM_COPIES + ';
+    if (dmFields and DM_DEFAULTSOURCE) <> 0 then
+      Result := Result + 'DM_DEFAULTSOURCE + ';
+    if (dmFields and DM_PRINTQUALITY) <> 0 then
+      Result := Result + 'DM_PRINTQUALITY + ';
+    if (dmFields and DM_POSITION) <> 0 then
+      Result := Result + 'DM_POSITION + ';
+    if (dmFields and DM_DISPLAYORIENTATION) <> 0 then
+      Result := Result + 'DM_DISPLAYORIENTATION + ';
+    if (dmFields and DM_DISPLAYFIXEDOUTPUT) <> 0 then
+      Result := Result + 'DM_DISPLAYFIXEDOUTPUT + ';
+    if (dmFields and DM_COLOR) <> 0 then
+      Result := Result + 'DM_COLOR + ';
+    if (dmFields and DM_DUPLEX) <> 0 then
+      Result := Result + 'DM_DUPLEX + ';
+    if (dmFields and DM_YRESOLUTION) <> 0 then
+      Result := Result + 'DM_YRESOLUTION + ';
+    if (dmFields and DM_TTOPTION) <> 0 then
+      Result := Result + 'DM_TTOPTION + ';
+    if (dmFields and DM_COLLATE) <> 0 then
+      Result := Result + 'DM_COLLATE + ';
+    if (dmFields and DM_FORMNAME) <> 0 then
+      Result := Result + 'DM_FORMNAME + ';
+    if (dmFields and DM_LOGPIXELS) <> 0 then
+      Result := Result + 'DM_LOGPIXELS + ';
+    if (dmFields and DM_BITSPERPEL) <> 0 then
+      Result := Result + 'DM_BITSPERPEL + ';
+    if (dmFields and DM_PELSWIDTH) <> 0 then
+      Result := Result + 'DM_PELSWIDTH + ';
+    if (dmFields and DM_PELSHEIGHT) <> 0 then
+      Result := Result + 'DM_PELSHEIGHT + ';
+    if (dmFields and DM_DISPLAYFLAGS) <> 0 then
+      Result := Result + 'DM_DISPLAYFLAGS + ';
+    if (dmFields and DM_NUP) <> 0 then
+      Result := Result + 'DM_NUP + ';
+    if (dmFields and DM_DISPLAYFREQUENCY) <> 0 then
+      Result := Result + 'DM_DISPLAYFREQUENCY + ';
+    if (dmFields and DM_ICMMETHOD) <> 0 then
+      Result := Result + 'DM_ICMMETHOD + ';
+    if (dmFields and DM_ICMINTENT) <> 0 then
+      Result := Result + 'DM_ICMINTENT + ';
+    if (dmFields and DM_MEDIATYPE) <> 0 then
+      Result := Result + 'DM_MEDIATYPE + ';
+    if (dmFields and DM_DITHERTYPE) <> 0 then
+      Result := Result + 'DM_DITHERTYPE + ';
+    if (dmFields and DM_PANNINGWIDTH) <> 0 then
+      Result := Result + 'DM_PANNINGWIDTH + ';
+    if (dmFields and DM_PANNINGHEIGHT) <> 0 then
+      Result := Result + 'DM_PANNINGHEIGHT + ';
+
+    if Length(Result) > 0 then
+      Result := Copy(Result, 1, Length(Result) - 3);
+
+    Result := IntToStr(dmFields) + ' (' + Result + ')';
+  end;
+
+  function DisplayOrientation2String(dmDisplayOrientation: DWORD): string;
+  begin
+    case dmDisplayOrientation of
+      DMDO_DEFAULT: Result := 'DMDO_DEFAULT';
+      DMDO_90:      Result := 'DMDO_90';
+      DMDO_180:     Result := 'DMDO_180';
+      DMDO_270:     Result := 'DMDO_270';
+      else
+        Result := 'Unknown';
+    end;
+    Result := IntToStr(dmDisplayOrientation) + ' (' + Result + ')';
+  end;
+
+  function DisplayFixedOutput2String(dmDisplayFixedOutput: DWORD): string;
+  begin
+    case dmDisplayFixedOutput of
+      DMDFO_DEFAULT: Result := 'DMDFO_DEFAULT';
+      DMDFO_CENTER:  Result := 'DMDFO_CENTER';
+      DMDFO_STRETCH: Result := 'DMDFO_STRETCH';
+      else
+        Result := 'Unknown';
+    end;
+    Result := IntToStr(dmDisplayFixedOutput) + ' (' + Result + ')';
+  end;
+
+  function DisplayFlags2String(dmDisplayFlags: DWORD): string;
+  begin
+    Result := '';
+    if (dmDisplayFlags and DM_GRAYSCALE) <> 0 then
+      Result := Result + 'DM_GRAYSCALE + ';
+    if (dmDisplayFlags and DM_INTERLACED) <> 0 then
+      Result := Result + 'DM_INTERLACED + ';
+
+    if Length(Result) > 0 then
+      Result := Copy(Result, 1, Length(Result) - 3);
+
+    Result := IntToStr(dmDisplayFlags) + ' (' + Result + ')';
+  end;
+
+begin
+  LOG('dmFields', Fields2String(ADevMode.dmFields));
+  if (ADevMode.dmFields and DM_DISPLAYORIENTATION) <> 0 then
+    LOG('dmDisplayOrientation', DisplayOrientation2String(ADevMode.dmDisplayOrientation));
+  if (ADevMode.dmFields and DM_DISPLAYFIXEDOUTPUT) <> 0 then
+    LOG('dmDisplayFixedOutput', DisplayFixedOutput2String(ADevMode.dmDisplayFixedOutput));
+  if (ADevMode.dmFields and DM_BITSPERPEL) <> 0 then
+    LOG('dmBitsPerPel        ', ADevMode.dmBitsPerPel);
+  if (ADevMode.dmFields and DM_PELSWIDTH) <> 0 then
+    LOG('dmPelsWidth         ', ADevMode.dmPelsWidth);
+  if (ADevMode.dmFields and DM_PELSHEIGHT) <> 0 then
+    LOG('dmPelsHeight        ', ADevMode.dmPelsHeight);
+  if (ADevMode.dmFields and DM_DISPLAYFLAGS) <> 0 then
+    LOG('dmDisplayFlags      ', DisplayFlags2String(ADevMode.dmDisplayFlags));
+  if (ADevMode.dmFields and DM_DISPLAYFREQUENCY) <> 0 then
+    LOG('dmDisplayFrequency  ', IntToStr(ADevMode.dmDisplayFrequency) + ' Hz');
+end;

packages/ptc/src/win32/gdi/win32openglwindowd.inc

@@ -0,0 +1,49 @@
+{
+    This file is part of the PTCPas framebuffer library
+    Copyright (C) 2012 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library 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
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+type
+  TWin32OpenGLWindow = class(TWin32Window)
+  private
+    FPixelFormatDescriptor: PIXELFORMATDESCRIPTOR;
+	FChosenPixelFormatDescriptor: PIXELFORMATDESCRIPTOR;
+
+	procedure SetOpenGLAttributes(const AOpenGLAttributes: IPTCOpenGLAttributes);
+    function EnumerateAllPixelFormats(hdc: HDC): Boolean;
+    function SetupOpenGLPixelFormat(hdc: HDC): Boolean;
+    procedure LogPixelFormatDescriptor(const pfd: PIXELFORMATDESCRIPTOR);
+  protected
+    function WMCreate(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; override;
+    function WMDestroy(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; override;
+  public
+    constructor Create(const AWndClass, ATitle: string; AExtra, AStyle, AClassStyle: DWord;
+                       AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded,
+                       ACursor: Boolean; const AOpenGLAttributes: IPTCOpenGLAttributes);
+  end;

packages/ptc/src/win32/gdi/win32openglwindowi.inc

@@ -0,0 +1,358 @@
+{
+    This file is part of the PTCPas framebuffer library
+    Copyright (C) 2012 Nikolay Nikolov ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library 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
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{$WARNING add these to the windows unit}
+const
+  PFD_DIRECT3D_ACCELERATED = $00004000;
+  PFD_SUPPORT_COMPOSITION = $00008000;
+
+constructor TWin32OpenGLWindow.Create(const AWndClass, ATitle: string; AExtra, AStyle, AClassStyle: DWord;
+              AShow, AX, AY, AWidth, AHeight: Integer; ACenter, AMultithreaded, ACursor: Boolean;
+              const AOpenGLAttributes: IPTCOpenGLAttributes);
+begin
+  SetOpenGLAttributes(AOpenGLAttributes);
+  inherited Create(AWndClass, ATitle, AExtra, AStyle, AClassStyle,
+                   AShow, AX, AY, AWidth, AHeight, ACenter, AMultithreaded, ACursor);
+end;
+
+function TWin32OpenGLWindow.WMCreate(
+                              hWnd: HWND;
+                              uMsg: UINT;
+                              wParam: WPARAM;
+                              lParam: LPARAM): LRESULT;
+var
+  dc: HDC;
+  Context: HGLRC;
+begin
+  LOG('inside OpenGL WM_CREATE handler');
+  LOG('getting device context');
+  dc := GetDC(hWnd);
+  if dc = 0 then
+  begin
+    LOG('GetDC returned an error, failing WM_CREATE');
+    exit(-1);
+  end;
+
+{$IFDEF DEBUG}
+  LOG('enumerating all pixel formats available on this device context');
+  if not EnumerateAllPixelFormats(dc) then
+  begin
+    LOG('error enumerating pixel formats, failing WM_CREATE');
+    LOG('ReleaseDC');
+    if ReleaseDC(hWnd, dc) = 0 then
+      LOG('ReleaseDC failed');
+    exit(-1);
+  end;
+{$ENDIF DEBUG}
+
+  LOG('setting up OpenGL pixel format');
+  if not Self.SetupOpenGLPixelFormat(dc) then
+  begin
+    LOG('error setting up OpenGL pixel format, failing WM_CREATE');
+    LOG('ReleaseDC');
+    if ReleaseDC(hWnd, dc) = 0 then
+      LOG('ReleaseDC failed');
+    exit(-1);
+  end;
+
+  LOG('creating OpenGL rendering context');
+  Context := wglCreateContext(dc);
+  if Context = 0 then
+  begin
+    LOG('error creating OpenGL rendering context, failing WM_CREATE');
+    LOG('ReleaseDC');
+    if ReleaseDC(hWnd, dc) = 0 then
+      LOG('ReleaseDC failed');
+    exit(-1);
+  end;
+
+  LOG('making it current');
+  if not wglMakeCurrent(dc, Context) then
+  begin
+    LOG('error making the OpenGL rendering context current, failing WM_CREATE');
+    LOG('ReleaseDC');
+    if ReleaseDC(hWnd, dc) = 0 then
+      LOG('ReleaseDC failed');
+    LOG('wglDeleteContext');
+    if not wglDeleteContext(Context) then
+      LOG('wglDeleteContext failed');
+    exit(-1);
+  end;
+
+  LOG('WM_CREATE success');
+  Result := 0;
+end;
+
+function TWin32OpenGLWindow.WMDestroy(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
+var
+  dc: HDC;
+  Context: HGLRC;
+begin
+  LOG('inside OpenGL WM_DESTROY handler');
+
+  Context := wglGetCurrentContext;
+  if Context <> 0 then
+  begin
+    dc := wglGetCurrentDC;
+
+    LOG('wglMakeCurrent(0, 0)');
+    if not wglMakeCurrent(0, 0) then
+      LOG('wglMakeCurrent(0, 0) failed');
+
+    if dc <> 0 then
+    begin
+      LOG('ReleaseDC');
+      if ReleaseDC(hWnd, dc) = 0 then
+        LOG('ReleaseDC failed');
+    end
+    else
+      LOG('no WGL device context to release');
+
+    LOG('wglDeleteContext');
+    if not wglDeleteContext(Context) then
+      LOG('wglDeleteContext failed');
+  end
+  else
+    LOG('no current context to cleanup');
+
+  LOG('WM_DESTROY done');
+
+  inherited;
+end;
+
+procedure TWin32OpenGLWindow.SetOpenGLAttributes(const AOpenGLAttributes: IPTCOpenGLAttributes);
+var
+  Flags: DWORD;
+begin
+  Flags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
+
+  if AOpenGLAttributes.DoubleBufferDontCare then
+    Flags := Flags or PFD_DOUBLEBUFFER_DONTCARE
+  else
+    if AOpenGLAttributes.DoubleBuffer then
+	  Flags := Flags or PFD_DOUBLEBUFFER;
+
+  if AOpenGLAttributes.StereoDontCare then
+    Flags := Flags or PFD_STEREO_DONTCARE
+  else
+    if AOpenGLAttributes.Stereo then
+	  Flags := Flags or PFD_STEREO;
+
+  FillChar(FPixelFormatDescriptor, SizeOf(FPixelFormatDescriptor), 0);
+  FPixelFormatDescriptor.nSize := SizeOf(FPixelFormatDescriptor);
+  FPixelFormatDescriptor.nVersion := 1;
+  FPixelFormatDescriptor.dwFlags := Flags;
+  FPixelFormatDescriptor.iPixelType := PFD_TYPE_RGBA;
+  FPixelFormatDescriptor.cColorBits := AOpenGLAttributes.BufferSize;
+  FPixelFormatDescriptor.cRedBits := 0;
+  FPixelFormatDescriptor.cRedShift := 0;
+  FPixelFormatDescriptor.cGreenBits := 0;
+  FPixelFormatDescriptor.cGreenShift := 0;
+  FPixelFormatDescriptor.cBlueBits := 0;
+  FPixelFormatDescriptor.cBlueShift := 0;
+  FPixelFormatDescriptor.cAlphaBits := 0;
+  FPixelFormatDescriptor.cAlphaShift := 0;
+  FPixelFormatDescriptor.cAccumBits := 0;
+  FPixelFormatDescriptor.cAccumRedBits := 0;
+  FPixelFormatDescriptor.cAccumGreenBits := 0;
+  FPixelFormatDescriptor.cAccumBlueBits := 0;
+  FPixelFormatDescriptor.cAccumAlphaBits := 0;
+  FPixelFormatDescriptor.cDepthBits := AOpenGLAttributes.DepthSize;
+  FPixelFormatDescriptor.cStencilBits := AOpenGLAttributes.StencilSize;
+  FPixelFormatDescriptor.cAuxBuffers := 0;
+  FPixelFormatDescriptor.iLayerType := PFD_MAIN_PLANE;
+  FPixelFormatDescriptor.bReserved := 0;
+  FPixelFormatDescriptor.dwLayerMask := 0;
+  FPixelFormatDescriptor.dwVisibleMask := 0;
+  FPixelFormatDescriptor.dwDamageMask := 0;
+end;
+
+function TWin32OpenGLWindow.EnumerateAllPixelFormats(hdc: HDC): Boolean;
+var
+  pfd: PIXELFORMATDESCRIPTOR;
+  pf_index, pf_count: Integer;
+begin
+  pf_count := DescribePixelFormat(hdc, 1, 0, nil);
+  if pf_count = 0 then
+  begin
+    LOG('DescribePixelFormat failed');
+    exit(False);
+  end;
+  LOG('pixel formats count', pf_count);
+
+  for pf_index := 1 to pf_count do
+  begin
+    FillChar(pfd, SizeOf(pfd), 0);
+    pfd.nSize := SizeOf(pfd);
+
+    LOG('describing pixel format ' + IntToStr(pf_index));
+    if DescribePixelFormat(hdc, pf_index, SizeOf(pfd), @pfd) = 0 then
+    begin
+      LOG('DescribePixelFormat failed');
+      exit(False);
+    end;
+    LogPixelFormatDescriptor(pfd);
+  end;
+end;
+
+function TWin32OpenGLWindow.SetupOpenGLPixelFormat(hdc: HDC): Boolean;
+var
+  pf_index: Integer;
+begin
+  LOG('calling ChoosePixelFormat with:');
+  LogPixelFormatDescriptor(FPixelFormatDescriptor);
+
+  pf_index := ChoosePixelFormat(hdc, FPixelFormatDescriptor);
+  if pf_index = 0 then
+  begin
+    LOG('ChoosePixelFormat failed');
+    exit(False);
+  end;
+  LOG('ChoosePixelFormat result', pf_index);
+
+  LOG('getting description');
+  if DescribePixelFormat(hdc, pf_index, SizeOf(FChosenPixelFormatDescriptor), @FChosenPixelFormatDescriptor) = 0 then
+  begin
+    LOG('DescribePixelFormat failed');
+    exit(False);
+  end;
+  LogPixelFormatDescriptor(FChosenPixelFormatDescriptor);
+
+  LOG('setting pixel format');
+  if not SetPixelFormat(hdc, pf_index, @FPixelFormatDescriptor) then
+  begin
+    LOG('SetPixelFormat failed');
+    exit(False);
+  end;
+
+  Result := True;
+end;
+
+procedure TWin32OpenGLWindow.LogPixelFormatDescriptor(const pfd: PIXELFORMATDESCRIPTOR);
+
+  function dwFlags2String(dwFlags: DWORD): string;
+  begin
+    Result := IntToStr(dwFlags) + ' (';
+    if (dwFlags and PFD_DOUBLEBUFFER) <> 0 then
+      Result := Result + 'PFD_DOUBLEBUFFER + ';
+    if (dwFlags and PFD_STEREO) <> 0 then
+      Result := Result + 'PFD_STEREO + ';
+    if (dwFlags and PFD_DRAW_TO_WINDOW) <> 0 then
+      Result := Result + 'PFD_DRAW_TO_WINDOW + ';
+    if (dwFlags and PFD_DRAW_TO_BITMAP) <> 0 then
+      Result := Result + 'PFD_DRAW_TO_BITMAP + ';
+    if (dwFlags and PFD_SUPPORT_GDI) <> 0 then
+      Result := Result + 'PFD_SUPPORT_GDI + ';
+    if (dwFlags and PFD_SUPPORT_OPENGL) <> 0 then
+      Result := Result + 'PFD_SUPPORT_OPENGL + ';
+    if (dwFlags and PFD_GENERIC_FORMAT) <> 0 then
+      Result := Result + 'PFD_GENERIC_FORMAT + ';
+    if (dwFlags and PFD_NEED_PALETTE) <> 0 then
+      Result := Result + 'PFD_NEED_PALETTE + ';
+    if (dwFlags and PFD_NEED_SYSTEM_PALETTE) <> 0 then
+      Result := Result + 'PFD_NEED_SYSTEM_PALETTE + ';
+    if (dwFlags and PFD_SWAP_EXCHANGE) <> 0 then
+      Result := Result + 'PFD_SWAP_EXCHANGE + ';
+    if (dwFlags and PFD_SWAP_COPY) <> 0 then
+      Result := Result + 'PFD_SWAP_COPY + ';
+    if (dwFlags and PFD_SWAP_LAYER_BUFFERS) <> 0 then
+      Result := Result + 'PFD_SWAP_LAYER_BUFFERS + ';
+    if (dwFlags and PFD_GENERIC_ACCELERATED) <> 0 then
+      Result := Result + 'PFD_GENERIC_ACCELERATED + ';
+    if (dwFlags and PFD_SUPPORT_DIRECTDRAW) <> 0 then
+      Result := Result + 'PFD_SUPPORT_DIRECTDRAW + ';
+    if (dwFlags and PFD_DIRECT3D_ACCELERATED) <> 0 then
+      Result := Result + 'PFD_DIRECT3D_ACCELERATED + ';
+    if (dwFlags and PFD_SUPPORT_COMPOSITION) <> 0 then
+      Result := Result + 'PFD_SUPPORT_COMPOSITION + ';
+    if (dwFlags and PFD_DEPTH_DONTCARE) <> 0 then
+      Result := Result + 'PFD_DEPTH_DONTCARE + ';
+    if (dwFlags and PFD_DOUBLEBUFFER_DONTCARE) <> 0 then
+      Result := Result + 'PFD_DOUBLEBUFFER_DONTCARE + ';
+    if (dwFlags and PFD_STEREO_DONTCARE) <> 0 then
+      Result := Result + 'PFD_STEREO_DONTCARE + ';
+    if Copy(Result, Length(Result) - 2, 3) = ' + ' then
+      Result := Copy(Result, 1, Length(Result) - 3);
+    Result := Result + ')';
+  end;
+
+  function iPixelType2String(iPixelType: Byte): string;
+  begin
+    case iPixelType of
+      PFD_TYPE_RGBA: Result := 'PFD_TYPE_RGBA';
+      PFD_TYPE_COLORINDEX: Result := 'PFD_TYPE_COLORINDEX';
+      else
+        Result := 'Unknown';
+    end;
+    Result := IntToStr(iPixelType) + ' (' + Result + ')';
+  end;
+
+  function iLayerType2String(iLayerType: Byte): string;
+  begin
+    case iLayerType of
+      PFD_MAIN_PLANE: Result := 'PFD_MAIN_PLANE';
+      PFD_OVERLAY_PLANE: Result := 'PFD_OVERLAY_PLANE';
+      Byte(PFD_UNDERLAY_PLANE): Result := 'PFD_UNDERLAY_PLANE';
+      else
+        Result := 'Unknown';
+    end;
+    Result := IntToStr(iLayerType) + ' (' + Result + ')';
+  end;
+
+begin
+  LOG('PIXELFORMATDESCRIPTOR:');
+  LOG('nSize          ', pfd.nSize);
+  LOG('nVersion       ', pfd.nVersion);
+  LOG('dwFlags        ', dwFlags2String(pfd.dwFlags));
+  LOG('iPixelType     ', iPixelType2String(pfd.iPixelType));
+  LOG('cColorBits     ', pfd.cColorBits);
+  LOG('cRedBits       ', pfd.cRedBits);
+  LOG('cRedShift      ', pfd.cRedShift);
+  LOG('cGreenBits     ', pfd.cGreenBits);
+  LOG('cGreenShift    ', pfd.cGreenShift);
+  LOG('cBlueBits      ', pfd.cBlueBits);
+  LOG('cBlueShift     ', pfd.cBlueShift);
+  LOG('cAlphaBits     ', pfd.cAlphaBits);
+  LOG('cAlphaShift    ', pfd.cAlphaShift);
+  LOG('cAccumBits     ', pfd.cAccumBits);
+  LOG('cAccumRedBits  ', pfd.cAccumRedBits);
+  LOG('cAccumGreenBits', pfd.cAccumGreenBits);
+  LOG('cAccumBlueBits ', pfd.cAccumBlueBits);
+  LOG('cAccumAlphaBits', pfd.cAccumAlphaBits);
+  LOG('cDepthBits     ', pfd.cDepthBits);
+  LOG('cStencilBits   ', pfd.cStencilBits);
+  LOG('cAuxBuffers    ', pfd.cAuxBuffers);
+  LOG('iLayerType     ', iLayerType2String(pfd.iLayerType));
+  LOG('bReserved      ', pfd.bReserved);
+  LOG('dwLayerMask    ', pfd.dwLayerMask);
+  LOG('dwVisibleMask  ', pfd.dwVisibleMask);
+  LOG('dwDamageMask   ', pfd.dwDamageMask);
+end;