Merged revisions 6909-6910,6912-6914 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
r6909 | daniel | 2007-03-18 11:24:21 +0100 (Sun, 18 Mar 2007) | 2 lines

  + UPgrade PTCpas to 0.99.7

........
r6910 | daniel | 2007-03-18 11:30:08 +0100 (Sun, 18 Mar 2007) | 2 lines

  * Temp commit to allow upgrade

........
r6912 | daniel | 2007-03-18 11:51:23 +0100 (Sun, 18 Mar 2007) | 2 lines

  + UPgrade PTCPas to latest svn revision

........
r6913 | daniel | 2007-03-18 12:01:32 +0100 (Sun, 18 Mar 2007) | 2 lines

  + Upgrade PTCPas to lastest svn revision.

........
r6914 | daniel | 2007-03-18 12:40:17 +0100 (Sun, 18 Mar 2007) | 2 lines

  * Fix paths

........

git-svn-id: branches/fixes_2_2@8451 -

.gitattributes

@@ -3159,12 +3159,14 @@ packages/extra/pcap/fpmake.pp svneol=native#text/plain
 packages/extra/pcap/pcap.pp svneol=native#text/plain
 packages/extra/ptc/Makefile -text
 packages/extra/ptc/Makefile.fpc -text
-packages/extra/ptc/aread.inc -text
-packages/extra/ptc/areai.inc -text
+packages/extra/ptc/aread.inc svneol=native#text/x-pascal
+packages/extra/ptc/areai.inc svneol=native#text/x-pascal
 packages/extra/ptc/basecond.inc -text
 packages/extra/ptc/baseconi.inc -text
-packages/extra/ptc/basesurd.inc -text
-packages/extra/ptc/basesuri.inc -text
+packages/extra/ptc/baseconsoled.inc svneol=native#text/x-pascal
+packages/extra/ptc/baseconsolei.inc svneol=native#text/x-pascal
+packages/extra/ptc/basesurfaced.inc svneol=native#text/x-pascal
+packages/extra/ptc/basesurfacei.inc svneol=native#text/x-pascal
 packages/extra/ptc/c_api/area.inc -text
 packages/extra/ptc/c_api/aread.inc -text
 packages/extra/ptc/c_api/clear.inc -text
@@ -3194,16 +3196,18 @@ packages/extra/ptc/c_api/surface.inc -text
 packages/extra/ptc/c_api/surfaced.inc -text
 packages/extra/ptc/c_api/timer.inc -text
 packages/extra/ptc/c_api/timerd.inc -text
-packages/extra/ptc/cleard.inc -text
-packages/extra/ptc/cleari.inc -text
-packages/extra/ptc/clipperd.inc -text
-packages/extra/ptc/clipperi.inc -text
-packages/extra/ptc/colord.inc -text
-packages/extra/ptc/colori.inc -text
-packages/extra/ptc/consoled.inc -text
-packages/extra/ptc/consolei.inc -text
-packages/extra/ptc/copyd.inc -text
-packages/extra/ptc/copyi.inc -text
+packages/extra/ptc/cleard.inc svneol=native#text/x-pascal
+packages/extra/ptc/cleari.inc svneol=native#text/x-pascal
+packages/extra/ptc/clipperd.inc svneol=native#text/x-pascal
+packages/extra/ptc/clipperi.inc svneol=native#text/x-pascal
+packages/extra/ptc/colord.inc svneol=native#text/x-pascal
+packages/extra/ptc/colori.inc svneol=native#text/x-pascal
+packages/extra/ptc/consoled.inc svneol=native#text/x-pascal
+packages/extra/ptc/consolei.inc svneol=native#text/x-pascal
+packages/extra/ptc/copyd.inc svneol=native#text/x-pascal
+packages/extra/ptc/copyi.inc svneol=native#text/x-pascal
+packages/extra/ptc/coreimplementation.inc svneol=native#text/x-pascal
+packages/extra/ptc/coreinterface.inc svneol=native#text/x-pascal
 packages/extra/ptc/demos/Makefile -text
 packages/extra/ptc/demos/Makefile.fpc -text
 packages/extra/ptc/demos/fire.pp -text
@@ -3238,8 +3242,10 @@ packages/extra/ptc/dos/timeunit/timeunit.pp -text
 packages/extra/ptc/dos/vesa/console.inc -text
 packages/extra/ptc/dos/vesa/consoled.inc -text
 packages/extra/ptc/dos/vesa/vesa.pp -text
-packages/extra/ptc/errord.inc -text
-packages/extra/ptc/errori.inc -text
+packages/extra/ptc/errord.inc svneol=native#text/x-pascal
+packages/extra/ptc/errori.inc svneol=native#text/x-pascal
+packages/extra/ptc/eventd.inc svneol=native#text/x-pascal
+packages/extra/ptc/eventi.inc svneol=native#text/x-pascal
 packages/extra/ptc/examples/Makefile -text
 packages/extra/ptc/examples/Makefile.fpc -text
 packages/extra/ptc/examples/area.pp -text
@@ -3261,64 +3267,102 @@ packages/extra/ptc/examples/save.pp -text
 packages/extra/ptc/examples/stretch.pp -text
 packages/extra/ptc/examples/stretch.tga -text
 packages/extra/ptc/examples/timer.pp -text
-packages/extra/ptc/formatd.inc -text
-packages/extra/ptc/formati.inc -text
-packages/extra/ptc/keyd.inc -text
-packages/extra/ptc/keyi.inc -text
-packages/extra/ptc/log.inc -text
-packages/extra/ptc/moded.inc -text
-packages/extra/ptc/modei.inc -text
-packages/extra/ptc/paletted.inc -text
-packages/extra/ptc/palettei.inc -text
-packages/extra/ptc/ptc.cfg -text
+packages/extra/ptc/formatd.inc svneol=native#text/x-pascal
+packages/extra/ptc/formati.inc svneol=native#text/x-pascal
+packages/extra/ptc/keyd.inc svneol=native#text/x-pascal
+packages/extra/ptc/keyeventd.inc svneol=native#text/x-pascal
+packages/extra/ptc/keyeventi.inc svneol=native#text/x-pascal
+packages/extra/ptc/keyi.inc svneol=native#text/x-pascal
+packages/extra/ptc/log.inc svneol=native#text/x-pascal
+packages/extra/ptc/moded.inc svneol=native#text/x-pascal
+packages/extra/ptc/modei.inc svneol=native#text/x-pascal
+packages/extra/ptc/mouseeventd.inc svneol=native#text/x-pascal
+packages/extra/ptc/mouseeventi.inc svneol=native#text/x-pascal
+packages/extra/ptc/paletted.inc svneol=native#text/x-pascal
+packages/extra/ptc/palettei.inc svneol=native#text/x-pascal
 packages/extra/ptc/ptc.pp -text
-packages/extra/ptc/surfaced.inc -text
-packages/extra/ptc/surfacei.inc -text
+packages/extra/ptc/ptcpas.cfg svneol=native#text/plain
+packages/extra/ptc/surfaced.inc svneol=native#text/x-pascal
+packages/extra/ptc/surfacei.inc svneol=native#text/x-pascal
 packages/extra/ptc/test/convtest.pas -text
 packages/extra/ptc/test/endian.pas -text
 packages/extra/ptc/test/view.pp -text
-packages/extra/ptc/timerd.inc -text
-packages/extra/ptc/timeri.inc -text
+packages/extra/ptc/timerd.inc svneol=native#text/x-pascal
+packages/extra/ptc/timeri.inc svneol=native#text/x-pascal
 packages/extra/ptc/tinyptc/tinyptc.pp -text
-packages/extra/ptc/win32/base/cursor.inc -text
-packages/extra/ptc/win32/base/event.inc -text
-packages/extra/ptc/win32/base/eventd.inc -text
-packages/extra/ptc/win32/base/hook.inc -text
-packages/extra/ptc/win32/base/hookd.inc -text
-packages/extra/ptc/win32/base/kbd.inc -text
-packages/extra/ptc/win32/base/kbdd.inc -text
-packages/extra/ptc/win32/base/monitor.inc -text
-packages/extra/ptc/win32/base/monitord.inc -text
+packages/extra/ptc/win32/base/cursor.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/event.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/eventd.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/hook.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/hookd.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/kbd.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/kbdd.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/monitor.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/monitord.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/moused.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/mousei.inc svneol=native#text/x-pascal
 packages/extra/ptc/win32/base/ptcres.rc -text
 packages/extra/ptc/win32/base/ptcres.res -text
-packages/extra/ptc/win32/base/window.inc -text
-packages/extra/ptc/win32/base/windowd.inc -text
+packages/extra/ptc/win32/base/window.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/base/windowd.inc svneol=native#text/x-pascal
 packages/extra/ptc/win32/base/windows.ico -text
-packages/extra/ptc/win32/directx/check.inc -text
-packages/extra/ptc/win32/directx/console.inc -text
-packages/extra/ptc/win32/directx/consoled.inc -text
+packages/extra/ptc/win32/directx/check.inc svneol=native#text/x-pascal
 packages/extra/ptc/win32/directx/directdr.pp -text
-packages/extra/ptc/win32/directx/display.inc -text
-packages/extra/ptc/win32/directx/displayd.inc -text
-packages/extra/ptc/win32/directx/hook.inc -text
-packages/extra/ptc/win32/directx/hookd.inc -text
-packages/extra/ptc/win32/directx/library.inc -text
-packages/extra/ptc/win32/directx/libraryd.inc -text
-packages/extra/ptc/win32/directx/primary.inc -text
-packages/extra/ptc/win32/directx/primaryd.inc -text
-packages/extra/ptc/win32/directx/translte.inc -text
-packages/extra/ptc/x11/check.inc -text
-packages/extra/ptc/x11/console.inc -text
-packages/extra/ptc/x11/consoled.inc -text
-packages/extra/ptc/x11/dgadisp.inc -text
-packages/extra/ptc/x11/dgadispd.inc -text
-packages/extra/ptc/x11/display.inc -text
-packages/extra/ptc/x11/displayd.inc -text
-packages/extra/ptc/x11/image.inc -text
-packages/extra/ptc/x11/imaged.inc -text
-packages/extra/ptc/x11/window.inc -text
-packages/extra/ptc/x11/windowd.inc -text
-packages/extra/ptc/x11/xunikey.inc -text
+packages/extra/ptc/win32/directx/directxconsole.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/directxconsoled.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/display.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/displayd.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/hook.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/hookd.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/library.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/libraryd.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/primary.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/primaryd.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/directx/translate.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/gdi/gdiconsoled.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/gdi/gdiconsolei.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/gdi/win32dibd.inc svneol=native#text/x-pascal
+packages/extra/ptc/win32/gdi/win32dibi.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/base/wincekeyboardd.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/base/wincekeyboardi.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/base/wincemoused.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/base/wincemousei.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/base/wincewindowd.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/base/wincewindowi.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/gapi/p_gx.pp svneol=native#text/x-pascal
+packages/extra/ptc/wince/gapi/wincegapiconsoled.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/gapi/wincegapiconsolei.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/gdi/wincebitmapinfod.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/gdi/wincebitmapinfoi.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/gdi/wincegdiconsoled.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/gdi/wincegdiconsolei.inc svneol=native#text/x-pascal
+packages/extra/ptc/wince/includes.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/check.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/extensions.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/includes.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/modesd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/modesi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/svnimaged.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/svnimagei.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11consoled.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11consolei.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11dga1displayd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11dga1displayi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11dga2displayd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11dga2displayi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11dgadisplayd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11dgadisplayi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11displayd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11displayi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11imaged.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11imagei.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11modesd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11modesi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11windowd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11windowdisplayd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11windowdisplayi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11windowi.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/xunikey.inc svneol=native#text/x-pascal
 packages/extra/rexx/Makefile svneol=native#text/plain
 packages/extra/rexx/Makefile.fpc svneol=native#text/plain
 packages/extra/rexx/fpmake.inc svneol=native#text/plain

packages/extra/ptc/aread.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -21,18 +21,19 @@
 Type
   TPTCArea=Class(TObject)
   Private
-    Fleft, Ftop, Fright, Fbottom : Integer;
+    FLeft, FTop, FRight, FBottom : Integer;
+    Function GetWidth : Integer;
+    Function GetHeight : Integer;
   Public
     Constructor Create;
-    Constructor Create(_left, _top, _right, _bottom : Integer);
-    Constructor Create(Const Area : TPTCArea);
-    Destructor Destroy; Override;
-    Function width : Integer;
-    Function height : Integer;
-    Procedure Assign(Const area : TPTCArea);
-    Function Equals(Const area : TPTCArea) : Boolean;
-    Property left : Integer read Fleft;
-    Property top : Integer read Ftop;
-    Property right : Integer read Fright;
-    Property bottom : Integer read Fbottom;
+    Constructor Create(ALeft, ATop, ARight, ABottom : Integer);
+    Constructor Create(Const AArea : TPTCArea);
+    Procedure Assign(Const AArea : TPTCArea);
+    Function Equals(Const AArea : TPTCArea) : Boolean;
+    Property Left : Integer Read FLeft;
+    Property Top : Integer Read FTop;
+    Property Right : Integer Read FRight;
+    Property Bottom : Integer Read FBottom;
+    Property Width : Integer Read GetWidth;
+    Property Height : Integer Read GetHeight;
   End;

packages/extra/ptc/areai.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -18,80 +18,75 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-Constructor TPTCArea.Create(_left, _top, _right, _bottom : Integer);
+Constructor TPTCArea.Create(ALeft, ATop, ARight, ABottom : Integer);
 
 Begin
-  If _left < _right Then
+  If ALeft < ARight Then
   Begin
-    Fleft := _left;
-    Fright := _right;
+    FLeft := ALeft;
+    FRight := ARight;
   End
   Else
   Begin
-    Fleft := _right;
-    Fright := _left;
+    FLeft := ARight;
+    FRight := ALeft;
   End;
-  If _top < _bottom Then
+  If ATop < ABottom Then
   Begin
-    Ftop := _top;
-    Fbottom := _bottom;
+    FTop := ATop;
+    FBottom := ABottom;
   End
   Else
   Begin
-    Ftop := _bottom;
-    Fbottom := _top;
+    FTop := ABottom;
+    FBottom := ATop;
   End;
 End;
 
 Constructor TPTCArea.Create;
 
 Begin
-  Fleft := 0;
-  Fright := 0;
-  Ftop := 0;
-  Fbottom := 0;
+  FLeft   := 0;
+  FRight  := 0;
+  FTop    := 0;
+  FBottom := 0;
 End;
 
-Constructor TPTCArea.Create(Const area : TPTCArea);
+Constructor TPTCArea.Create(Const AArea : TPTCArea);
 
 Begin
-  ASSign(area);
+  FLeft   := AArea.FLeft;
+  FTop    := AArea.FTop;
+  FRight  := AArea.FRight;
+  FBottom := AArea.FBottom;
 End;
 
-Destructor TPTCArea.Destroy;
+Procedure TPTCArea.Assign(Const AArea : TPTCArea);
 
 Begin
-  Inherited Destroy;
+  FLeft   := AArea.FLeft;
+  FTop    := AArea.FTop;
+  FRight  := AArea.FRight;
+  FBottom := AArea.FBottom;
 End;
 
-Procedure TPTCArea.Assign(Const area : TPTCArea);
+Function TPTCArea.Equals(Const AArea : TPTCArea) : Boolean;
 
 Begin
-  If Self = area Then
-    Raise TPTCError.Create('self assignment is not allowed');
-  Fleft := area.Fleft;
-  Ftop := area.Ftop;
-  Fright := area.Fright;
-  Fbottom := area.Fbottom;
+  Result := (FLeft   = AArea.FLeft) And
+            (FTop    = AArea.FTop) And
+            (FRight  = AArea.FRight) And
+            (FBottom = AArea.FBottom);
 End;
 
-Function TPTCArea.Equals(Const area : TPTCArea) : Boolean;
+Function TPTCArea.GetWidth : Integer;
 
 Begin
-  Equals := (Fleft = area.Fleft) And
-	    (Ftop = area.Ftop) And
-	    (Fright = area.Fright) And
-	    (Fbottom = area.Fbottom);
+  Result := FRight - FLeft;
 End;
 
-Function TPTCArea.width : Integer;
+Function TPTCArea.GetHeight : Integer;
 
 Begin
-  width := Fright - Fleft;
-End;
-
-Function TPTCArea.height : Integer;
-
-Begin
-  height := Fbottom - Ftop;
+  Result := FBottom - FTop;
 End;

packages/extra/ptc/basecond.inc

@@ -20,41 +20,38 @@
 
 Type
   TPTCBaseConsole=Class(TPTCBaseSurface)
-  Protected
+  Private
     FReleaseEnabled : Boolean;
-    
-    Procedure internal_ReadKey(k : TPTCKey); Virtual; Abstract;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Virtual; Abstract;
   Public
     Constructor Create;
     Procedure configure(Const _file : String); Virtual; Abstract;
     Function modes : PPTCMode; Virtual; Abstract;
-    Procedure open(Const _title : String; _pages : Integer); Overload; Virtual; Abstract;
+    Procedure open(Const _title : String; _pages : Integer = 0); Overload; Virtual; Abstract;
     Procedure open(Const _title : String; Const _format : TPTCFormat;
-                   _pages : Integer); Overload; Virtual; Abstract;
+                   _pages : Integer = 0); Overload; Virtual; Abstract;
     Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat; _pages : Integer); Overload; Virtual; Abstract;
+                   Const _format : TPTCFormat; _pages : Integer = 0); Overload; Virtual; Abstract;
     Procedure open(Const _title : String; Const _mode : TPTCMode;
-                   _pages : Integer); Overload; Virtual; Abstract;
-    {pages=0}
-    Procedure open(Const _title : String); Overload; Virtual;
-    Procedure open(Const _title : String; Const _format : TPTCFormat); Overload; Virtual;
-    Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat); Overload; Virtual;
-    Procedure open(Const _title : String; Const _mode : TPTCMode); Overload; Virtual;
-    {/pages=0}
+                   _pages : Integer = 0); Overload; Virtual; Abstract;
     Procedure close; Virtual; Abstract;
     Procedure flush; Virtual; Abstract;
     Procedure finish; Virtual; Abstract;
     Procedure update; Virtual; Abstract;
     Procedure update(Const _area : TPTCArea); Virtual; Abstract;
+    
+    { event handling }
+    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Virtual; Abstract;
+    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract;
+    
+    { key handling }
     Function KeyPressed : Boolean;
-    Function PeekKey(k : TPTCKey) : Boolean;
-    Procedure ReadKey(k : TPTCKey);
+    Function PeekKey(Var k : TPTCKeyEvent) : Boolean;
+    Procedure ReadKey(Var k : TPTCKeyEvent);
     Procedure ReadKey;
+    Property KeyReleaseEnabled : Boolean Read FReleaseEnabled Write FReleaseEnabled;
+    
     Function pages : Integer; Virtual; Abstract;
     Function name : String; Virtual; Abstract;
     Function title : String; Virtual; Abstract;
     Function information : String; Virtual; Abstract;
-    Property KeyReleaseEnabled : Boolean Read FReleaseEnabled Write FReleaseEnabled;
   End;

packages/extra/ptc/baseconi.inc

@@ -24,60 +24,44 @@ Begin
   FReleaseEnabled := False;
 End;
 
-Procedure TPTCBaseConsole.open(Const _title : String);{ Overload;}
-
-Begin
-  open(_title, 0);
-End;
-
-Procedure TPTCBaseConsole.open(Const _title : String; Const _format : TPTCFormat);{ Overload;}
-
-Begin
-  open(_title, _format, 0);
-End;
-
-Procedure TPTCBaseConsole.open(Const _title : String; _width, _height : Integer;
-                               Const _format : TPTCFormat);{ Overload;}
-
-Begin
-  open(_title, _width, _height, _format, 0);
-End;
-
-Procedure TPTCBaseConsole.open(Const _title : String; Const _mode : TPTCMode);{ Overload;}
-
-Begin
-  open(_title, _mode, 0);
-End;
-
 Function TPTCBaseConsole.KeyPressed : Boolean;
 
 Var
-  k : TPTCKey;
+  k, kpeek : TPTCEvent;
 
 Begin
-  k := TPTCKey.Create;
+  k := Nil;
   Try
     Repeat
-      If internal_PeekKey(k) = False Then
+      kpeek := PeekEvent(False, [PTCKeyEvent]);
+      If kpeek = Nil Then
         Exit(False);
-      If FReleaseEnabled Or k.Press Then
+      If FReleaseEnabled Or (kpeek As TPTCKeyEvent).Press Then
         Exit(True);
-      internal_ReadKey(k);
+      NextEvent(k, False, [PTCKeyEvent]);
     Until False;
   Finally
     k.Free;
   End;
 End;
 
-Procedure TPTCBaseConsole.ReadKey(k : TPTCKey);
+Procedure TPTCBaseConsole.ReadKey(Var k : TPTCKeyEvent);
+
+Var
+  ev : TPTCEvent;
 
 Begin
-  Repeat
-    internal_ReadKey(k);
-  Until FReleaseEnabled Or k.Press;
+  ev := k;
+  Try
+    Repeat
+      NextEvent(ev, True, [PTCKeyEvent]);
+    Until FReleaseEnabled Or (ev As TPTCKeyEvent).Press;
+  Finally
+    k := ev As TPTCKeyEvent;
+  End;
 End;
 
-Function TPTCBaseConsole.PeekKey(k : TPTCKey) : Boolean;
+Function TPTCBaseConsole.PeekKey(Var k : TPTCKeyEvent) : Boolean;
 
 Begin
   If KeyPressed Then
@@ -92,10 +76,10 @@ End;
 Procedure TPTCBaseConsole.ReadKey;
 
 Var
-  k : TPTCKey;
+  k : TPTCKeyEvent;
 
 Begin
-  k := TPTCKey.Create;
+  k := TPTCKeyEvent.Create;
   Try
     ReadKey(k);
   Finally

packages/extra/ptc/baseconsoled.inc

@@ -0,0 +1,61 @@
+{
+    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 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.
+
+    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
+  TPTCBaseConsole=Class(TPTCBaseSurface)
+  Private
+    FReleaseEnabled : Boolean;
+    Function GetPages : Integer; Virtual; Abstract;
+    Function GetName : String; Virtual; Abstract;
+    Function GetTitle : String; Virtual; Abstract;
+    Function GetInformation : String; Virtual; Abstract;
+  Public
+    Constructor Create; Virtual;
+    Procedure Configure(Const AFileName : String); Virtual; Abstract;
+    Function Modes : PPTCMode; Virtual; Abstract;
+    Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Virtual; Abstract;
+    Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat;
+                   APages : Integer = 0); Overload; Virtual; Abstract;
+    Procedure Open(Const ATitle : String; AWidth, AHeight : Integer;
+                   Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Virtual; Abstract;
+    Procedure Open(Const ATitle : String; Const AMode : TPTCMode;
+                   APages : Integer = 0); Overload; Virtual; Abstract;
+    Procedure Close; Virtual; Abstract;
+    Procedure Flush; Virtual; Abstract;
+    Procedure Finish; Virtual; Abstract;
+    Procedure Update; Virtual; Abstract;
+    Procedure Update(Const AArea : TPTCArea); Virtual; Abstract;
+
+    { event handling }
+    Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Virtual; Abstract;
+    Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract;
+
+    { key handling }
+    Function KeyPressed : Boolean;
+    Function PeekKey(Var AKey : TPTCKeyEvent) : Boolean;
+    Procedure ReadKey(Var AKey : TPTCKeyEvent);
+    Procedure ReadKey;
+    Property KeyReleaseEnabled : Boolean Read FReleaseEnabled Write FReleaseEnabled;
+
+    Property Pages : Integer Read GetPages;
+    Property Name : String Read GetName;
+    Property Title : String Read GetTitle;
+    Property Information : String Read GetInformation;
+  End;

packages/extra/ptc/baseconsolei.inc

@@ -0,0 +1,88 @@
+{
+    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 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.
+
+    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 TPTCBaseConsole.Create;
+
+Begin
+  FReleaseEnabled := False;
+End;
+
+Function TPTCBaseConsole.KeyPressed : Boolean;
+
+Var
+  k, kpeek : TPTCEvent;
+
+Begin
+  k := Nil;
+  Try
+    Repeat
+      kpeek := PeekEvent(False, [PTCKeyEvent]);
+      If kpeek = Nil Then
+        Exit(False);
+      If FReleaseEnabled Or (kpeek As TPTCKeyEvent).Press Then
+        Exit(True);
+      NextEvent(k, False, [PTCKeyEvent]);
+    Until False;
+  Finally
+    k.Free;
+  End;
+End;
+
+Procedure TPTCBaseConsole.ReadKey(Var AKey : TPTCKeyEvent);
+
+Var
+  ev : TPTCEvent;
+
+Begin
+  ev := AKey;
+  Try
+    Repeat
+      NextEvent(ev, True, [PTCKeyEvent]);
+    Until FReleaseEnabled Or (ev As TPTCKeyEvent).Press;
+  Finally
+    AKey := ev As TPTCKeyEvent;
+  End;
+End;
+
+Function TPTCBaseConsole.PeekKey(Var AKey : TPTCKeyEvent) : Boolean;
+
+Begin
+  If KeyPressed Then
+  Begin
+    ReadKey(AKey);
+    Result := True;
+  End
+  Else
+    Result := False;
+End;
+
+Procedure TPTCBaseConsole.ReadKey;
+
+Var
+  k : TPTCKeyEvent;
+
+Begin
+  k := TPTCKeyEvent.Create;
+  Try
+    ReadKey(k);
+  Finally
+    k.Free;
+  End;
+End;

packages/extra/ptc/basesurd.inc

@@ -1,63 +0,0 @@
-{
-    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 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.
-
-    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
-  TPTCBaseSurface=Class(TObject)
-  Public
-{    Constructor Create;}
-{    Destructor Destroy; Override;}
-    Procedure copy(Var surface : TPTCBaseSurface); Virtual; Abstract;
-    Procedure copy(Var surface : TPTCBaseSurface;
-                   Const source, destination : TPTCArea); Virtual; Abstract;
-    Function lock : Pointer; Virtual; Abstract;
-    Procedure unlock; Virtual; Abstract;
-    Procedure load(Const pixels : Pointer;
-                   _width, _height, _pitch : Integer;
-                   Const _format : TPTCFormat;
-                   Const _palette : TPTCPalette); Virtual; Abstract;
-    Procedure load(Const pixels : Pointer;
-                   _width, _height, _pitch : Integer;
-                   Const _format : TPTCFormat;
-                   Const _palette : TPTCPalette;
-                   Const source, destination : TPTCArea); Virtual; Abstract;
-    Procedure save(pixels : Pointer;
-                   _width, _height, _pitch : Integer;
-                   Const _format : TPTCFormat;
-                   Const _palette : TPTCPalette); Virtual; Abstract;
-    Procedure save(pixels : Pointer;
-                   _width, _height, _pitch : Integer;
-                   Const _format : TPTCFormat;
-                   Const _palette : TPTCPalette;
-                   Const source, destination : TPTCArea); Virtual; Abstract;
-    Procedure clear; Virtual; Abstract;
-    Procedure clear(Const color : TPTCColor); Virtual; Abstract;
-    Procedure clear(Const color : TPTCColor;
-                    Const _area : TPTCArea); Virtual; Abstract;
-    Procedure palette(Const _palette : TPTCPalette); Virtual; Abstract;
-    Function palette : TPTCPalette; Virtual; Abstract;
-    Procedure clip(Const _area : TPTCArea); Virtual; Abstract;
-    Function width : Integer; Virtual; Abstract;
-    Function height : Integer; Virtual; Abstract;
-    Function pitch : Integer; Virtual; Abstract;
-    Function area : TPTCArea; Virtual; Abstract;
-    Function clip : TPTCArea; Virtual; Abstract;
-    Function format : TPTCFormat; Virtual; Abstract;
-    Function option(Const _option : String) : Boolean; Virtual; Abstract;
-  End;

packages/extra/ptc/basesurfaced.inc

@@ -0,0 +1,67 @@
+{
+    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 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.
+
+    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
+  TPTCBaseSurface=Class(TObject)
+  Private
+    Function GetWidth : Integer; Virtual; Abstract;
+    Function GetHeight : Integer; Virtual; Abstract;
+    Function GetPitch : Integer; Virtual; Abstract;
+    Function GetArea : TPTCArea; Virtual; Abstract;
+    Function GetFormat : TPTCFormat; Virtual; Abstract;
+  Public
+    Procedure Copy(Var ASurface : TPTCBaseSurface); Virtual; Abstract;
+    Procedure Copy(Var ASurface : TPTCBaseSurface;
+                   Const ASource, ADestination : TPTCArea); Virtual; Abstract;
+    Function Lock : Pointer; Virtual; Abstract;
+    Procedure Unlock; Virtual; Abstract;
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Virtual; Abstract;
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Virtual; Abstract;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Virtual; Abstract;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Virtual; Abstract;
+    Procedure Clear; Virtual; Abstract;
+    Procedure Clear(Const AColor : TPTCColor); Virtual; Abstract;
+    Procedure Clear(Const AColor : TPTCColor;
+                    Const AArea : TPTCArea); Virtual; Abstract;
+    Procedure Palette(Const APalette : TPTCPalette); Virtual; Abstract;
+    Procedure Clip(Const AArea : TPTCArea); Virtual; Abstract;
+    Function Option(Const AOption : String) : Boolean; Virtual; Abstract;
+    Function Clip : TPTCArea; Virtual; Abstract;
+    Function Palette : TPTCPalette; Virtual; Abstract;
+    Property Width : Integer Read GetWidth;
+    Property Height : Integer Read GetHeight;
+    Property Pitch : Integer Read GetPitch;
+    Property Area : TPTCArea Read GetArea;
+    Property Format : TPTCFormat Read GetFormat;
+  End;

packages/extra/ptc/basesuri.inc → packages/extra/ptc/basesurfacei.inc

@@ -17,15 +17,3 @@
     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 TPTCBaseSurface.Create;
-
-Begin
-End;
-}
-{Destructor TPTCBaseSurface.Destroy;
-
-Begin
-  Inherited Destroy;
-End;
-}

packages/extra/ptc/cleard.inc

@@ -21,11 +21,13 @@
 Type
   TPTCClear=Class(TObject)
   Private
-    Fhandle : THermesHandle;
-    Fformat : TPTCFormat;
+    FHandle : THermesHandle;
+    FFormat : TPTCFormat;
   Public
     Constructor Create;
     Destructor Destroy; Override;
-    Procedure request(Const format : TPTCFormat);
-    Procedure clear(pixels : Pointer; x, y, width, height, pitch : Integer; Const color : TPTCColor);
+    Procedure Request(Const AFormat : TPTCFormat);
+    Procedure Clear(APixels : Pointer;
+                    AX, AY, AWidth, AHeight, APitch : Integer;
+                    Const AColor : TPTCColor);
   End;

packages/extra/ptc/cleari.inc

@@ -21,17 +21,17 @@
 Constructor TPTCClear.Create;
 
 Begin
-  Fformat := Nil;
+  FFormat := Nil;
   { initialize hermes }
   If Not Hermes_Init Then
     Raise TPTCError.Create('could not initialize hermes');
 
   { default current format }
-  Fformat := TPTCFormat.Create;
+  FFormat := TPTCFormat.Create;
   { create hermes clearer instance }
-  Fhandle := Hermes_ClearerInstance;
+  FHandle := Hermes_ClearerInstance;
   { check hermes clearer instance }
-  If Fhandle = 0 Then
+  If FHandle = 0 Then
     Raise TPTCError.Create('could not create hermes clearer instance');
 End;
 
@@ -39,64 +39,52 @@ Destructor TPTCClear.Destroy;
 
 Begin
   { return the clearer instance }
-  Hermes_ClearerReturn(Fhandle);
-  Fformat.Free;
+  Hermes_ClearerReturn(FHandle);
+  FFormat.Free;
+
   { free hermes }
   Hermes_Done;
-  
+
   Inherited Destroy;
 End;
 
-Procedure TPTCClear.request(Const format : TPTCFormat);
+Procedure TPTCClear.Request(Const AFormat : TPTCFormat);
 
 Var
   hermes_format : PHermesFormat;
 
 Begin
-  hermes_format := @format.Fformat;
+  hermes_format := @AFormat.FFormat;
   { request surface clear for this format }
-  If Not Hermes_ClearerRequest(Fhandle, hermes_format) Then
+  If Not Hermes_ClearerRequest(FHandle, hermes_format) Then
     Raise TPTCError.Create('unsupported clear format');
 
   { update current format }
-  Fformat.Assign(format);
+  FFormat.Assign(AFormat);
 End;
 
-Procedure TPTCClear.clear(pixels : Pointer; x, y, width, height, pitch : Integer; Const color : TPTCColor);
+Procedure TPTCClear.Clear(APixels : Pointer; AX, AY, AWidth, AHeight, APitch : Integer; Const AColor : TPTCColor);
 
 Var
   r, g, b, a : LongInt;
   index : LongInt;
 
 Begin
-{$IFDEF DEBUG}
-  {
-  This checking is performed only when DEBUG is defined,
-  and can be used to track down errors early caused by passing
-  nil pointers to the clear function.
-
-  Even though technically clear should never receive a nil
-  pointer, we provide a check here to assist in debugging
-  just in case it ever does!
-  }
-  If pixels = Nil Then
+  If APixels = Nil Then
     Raise TPTCError.Create('nil pixels pointer in clear');
-{$ELSE}
-  { In release build no checking is performed for the sake of efficiency. }
-{$ENDIF}
 
   { check format type }
-  If Fformat.direct Then
+  If FFormat.direct Then
   Begin
     { check color type }
-    If Not color.direct Then
+    If Not AColor.direct Then
       Raise TPTCError.Create('direct pixel formats can only be cleared with direct color');
 
     { setup clear color }
-    r := Trunc(color.r * 255);
-    g := Trunc(color.g * 255);
-    b := Trunc(color.b * 255);
-    a := Trunc(color.a * 255);
+    r := Trunc(AColor.R * 255);
+    g := Trunc(AColor.G * 255);
+    b := Trunc(AColor.B * 255);
+    a := Trunc(AColor.A * 255);
 
     { clamp red }
     If r > 255 Then
@@ -127,16 +115,17 @@ Begin
         a := 0;
 
     { perform the clearing }
-    Hermes_ClearerClear(Fhandle,pixels,x,y,width,height,pitch,r,g,b,a);
+    Hermes_ClearerClear(FHandle, APixels, AX, AY, AWidth, AHeight, APitch,
+                        r, g, b, a);
   End
   Else
   Begin
     { check color type }
-    If Not color.indexed Then
+    If Not AColor.indexed Then
       Raise TPTCError.Create('indexed pixel formats can only be cleared with indexed color');
 
     { setup clear index }
-    index := color.index;
+    index := AColor.index;
 
     { clamp color index }
     If index > 255 Then
@@ -146,6 +135,7 @@ Begin
         index := 0;
 
     { perform the clearing }
-    Hermes_ClearerClear(Fhandle,pixels,x,y,width,height,pitch,0,0,0,index);
+    Hermes_ClearerClear(FHandle, APixels, AX, AY, AWidth, AHeight, APitch,
+                        0, 0, 0, index);
   End;
 End;

packages/extra/ptc/clipperd.inc

@@ -18,14 +18,13 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-{ $INLINE ON}
 Type
   TPTCClipper=Class(TObject)
   Public
     { clip a single area against clip area }
-    Function clip(Const _area, _clip : TPTCArea) : TPTCArea;
+    Class Function Clip(Const AArea, AClip : TPTCArea) : TPTCArea;
     { clip source and destination areas against source and destination clip areas }
-    Procedure clip(Const source, clip_source, clipped_source,
-                   destination, clip_destination,
-                   clipped_destination : TPTCArea);
+    Class Procedure Clip(Const ASource, AClipSource, AClippedSource,
+                         ADestination, AClipDestination,
+                         AClippedDestination : TPTCArea);
   End;

packages/extra/ptc/clipperi.inc

@@ -18,9 +18,9 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-{ $INLINE ON}
+{$INLINE ON}
 
-Class Function TPTCClipper.clip(Const _area, _clip : TPTCArea) : TPTCArea;
+Class Function TPTCClipper.Clip(Const AArea, AClip : TPTCArea) : TPTCArea;
 
 Var
   left, top, right, bottom : Integer;
@@ -28,41 +28,47 @@ Var
 
 Begin
   { get in coordinates }
-  left := _area.left;
-  top := _area.top;
-  right := _area.right;
-  bottom := _area.bottom;
+  left   := AArea.Left;
+  top    := AArea.Top;
+  right  := AArea.Right;
+  bottom := AArea.Bottom;
+
   { get clip coordinates }
-  clip_left := _clip.left;
-  clip_top := _clip.top;
-  clip_right := _clip.right;
-  clip_bottom := _clip.bottom;
+  clip_left   := AClip.Left;
+  clip_top    := AClip.Top;
+  clip_right  := AClip.Right;
+  clip_bottom := AClip.Bottom;
+
   { clip left }
   If left < clip_left Then
     left := clip_left;
   If left > clip_right Then
     left := clip_right;
+
   { clip top }
   If top < clip_top Then
     top := clip_top;
   If top > clip_bottom Then
     top := clip_bottom;
+
   { clip right }
   If right < clip_left Then
     right := clip_left;
   If right > clip_right Then
     right := clip_right;
+
   { clip bottom }
   If bottom < clip_top Then
     bottom := clip_top;
   If bottom > clip_bottom Then
     bottom := clip_bottom;
-  clip := TPTCArea.Create(left, top, right, bottom);
+
+  Result := TPTCArea.Create(Left, Top, Right, Bottom);
 End;
 
 { clip floating point area against a floating point clip area }
 Procedure TPTCClipper_clip(Var left, top, right, bottom : Real;
-                           clip_left, clip_top, clip_right, clip_bottom : Real);{ Inline;}
+                           clip_left, clip_top, clip_right, clip_bottom : Real); Inline;
 
 Begin
   { clip left }
@@ -88,7 +94,7 @@ Begin
 End;
 
 { clip floating point area against clip area }
-Procedure TPTCClipper_clip(Var left, top, right, bottom : Real; Const _clip : TPTCArea);{ Inline;}
+Procedure TPTCClipper_clip(Var left, top, right, bottom : Real; Const _clip : TPTCArea); Inline;
 
 Var
   clip_left, clip_top, clip_right, clip_bottom : Real;
@@ -104,7 +110,7 @@ Begin
 End;
 
 { snap a floating point area to integer coordinates }
-Procedure TPTCClipper_round(Var left, top, right, bottom : Real);{ Inline;}
+Procedure TPTCClipper_round(Var left, top, right, bottom : Real); Inline;
 
 Begin
   left := Round(left);
@@ -113,9 +119,9 @@ Begin
   bottom := Round(bottom);
 End;
 
-Class Procedure TPTCClipper.clip(Const source, clip_source, clipped_source,
-                                 destination, clip_destination,
-                                 clipped_destination : TPTCArea);
+Class Procedure TPTCClipper.Clip(Const ASource, AClipSource, AClippedSource,
+                                 ADestination, AClipDestination,
+                                 AClippedDestination : TPTCArea);
 
 Var
   tmp1, tmp2 : TPTCArea;
@@ -143,88 +149,103 @@ Begin
   tmp2 := Nil;
   Try
     { expand source area to floating point }
-    source_left := source.left;
-    source_top := source.top;
-    source_right := source.right;
-    source_bottom := source.bottom;
+    source_left   := ASource.Left;
+    source_top    := ASource.Top;
+    source_right  := ASource.Right;
+    source_bottom := ASource.Bottom;
+
     { setup clipped source area }
     clipped_source_left := source_left;
     clipped_source_top := source_top;
     clipped_source_right := source_right;
     clipped_source_bottom := source_bottom;
+
     { perform clipping on floating point source area }
     TPTCClipper_clip(clipped_source_left, clipped_source_top, clipped_source_right,
-                     clipped_source_bottom, clip_source);
+                     clipped_source_bottom, AClipSource);
+
     { check for early source area clipping exit }
     If (clipped_source_left = clipped_source_right) Or
        (clipped_source_top = clipped_source_bottom) Then
     Begin
       { clipped area is zero }
       tmp1 := TPTCArea.Create(0, 0, 0, 0);
-      clipped_source.ASSign(tmp1);
-      clipped_destination.ASSign(tmp1);
+      AClippedSource.Assign(tmp1);
+      AClippedDestination.Assign(tmp1);
       Exit;
     End;
+
     { calculate deltas in source clip }
     source_delta_left := clipped_source_left - source_left;
     source_delta_top := clipped_source_top - source_top;
     source_delta_right := clipped_source_right - source_right;
     source_delta_bottom := clipped_source_bottom - source_bottom;
+
     { calculate ratio of source area to destination area }
-    source_to_destination_x := destination.width / source.width;
-    source_to_destination_y := destination.height / source.height;
+    source_to_destination_x := ADestination.Width / ASource.Width;
+    source_to_destination_y := ADestination.Height / ASource.Height;
+
     { expand destination area to floating point }
-    destination_left := destination.left;
-    destination_top := destination.top;
-    destination_right := destination.right;
-    destination_bottom := destination.bottom;
+    destination_left   := ADestination.Left;
+    destination_top    := ADestination.Top;
+    destination_right  := ADestination.Right;
+    destination_bottom := ADestination.Bottom;
+
     { calculate adjusted destination area }
     adjusted_destination_left := destination_left + source_delta_left * source_to_destination_x;
     adjusted_destination_top := destination_top + source_delta_top * source_to_destination_y;
     adjusted_destination_right := destination_right + source_delta_right * source_to_destination_x;
     adjusted_destination_bottom := destination_bottom + source_delta_bottom * source_to_destination_y;
+
     { setup clipped destination area }
     clipped_destination_left := adjusted_destination_left;
     clipped_destination_top := adjusted_destination_top;
     clipped_destination_right := adjusted_destination_right;
     clipped_destination_bottom := adjusted_destination_bottom;
+
     { perform clipping on floating point destination area }
     TPTCClipper_clip(clipped_destination_left, clipped_destination_top,
-                     clipped_destination_right, clipped_destination_bottom, clip_destination);
+                     clipped_destination_right, clipped_destination_bottom, AClipDestination);
+
     { check for early destination area clipping exit }
     If (clipped_destination_left = clipped_destination_right) Or
-       (clipped_destination_top = clipped_destination_bottom)
-   Then
+       (clipped_destination_top = clipped_destination_bottom) Then
     Begin
       { clipped area is zero }
       tmp1 := TPTCArea.Create(0, 0, 0, 0);
-      clipped_source.ASSign(tmp1);
-      clipped_destination.ASSign(tmp1);
+      AClippedSource.Assign(tmp1);
+      AClippedDestination.Assign(tmp1);
       Exit;
     End;
+
     { calculate deltas in destination clip }
     destination_delta_left := clipped_destination_left - adjusted_destination_left;
     destination_delta_top := clipped_destination_top - adjusted_destination_top;
     destination_delta_right := clipped_destination_right - adjusted_destination_right;
     destination_delta_bottom := clipped_destination_bottom - adjusted_destination_bottom;
+
     { calculate ratio of destination area to source area }
     destination_to_source_x := 1 / source_to_destination_x;
     destination_to_source_y := 1 / source_to_destination_y;
+
     { calculate adjusted source area }
     adjusted_source_left := clipped_source_left + destination_delta_left * destination_to_source_x;
     adjusted_source_top := clipped_source_top + destination_delta_top * destination_to_source_y;
     adjusted_source_right := clipped_source_right + destination_delta_right * destination_to_source_x;
     adjusted_source_bottom := clipped_source_bottom + destination_delta_bottom * destination_to_source_y;
+
     { assign adjusted source to clipped source }
     clipped_source_left := adjusted_source_left;
     clipped_source_top := adjusted_source_top;
     clipped_source_right := adjusted_source_right;
     clipped_source_bottom := adjusted_source_bottom;
+
     { round clipped areas to integer coordinates }
     TPTCClipper_round(clipped_source_left, clipped_source_top,
                       clipped_source_right, clipped_source_bottom);
     TPTCClipper_round(clipped_destination_left, clipped_destination_top,
                       clipped_destination_right, clipped_destination_bottom);
+
     { construct clipped area rectangles from rounded floating point areas }
     tmp1 := TPTCArea.Create(Trunc(clipped_source_left),
                             Trunc(clipped_source_top),
@@ -234,8 +255,8 @@ Begin
                             Trunc(clipped_destination_top),
                             Trunc(clipped_destination_right),
                             Trunc(clipped_destination_bottom));
-    clipped_source.ASSign(tmp1);
-    clipped_destination.ASSign(tmp2);
+    AClippedSource.Assign(tmp1);
+    AClippedDestination.Assign(tmp2);
   Finally
     tmp1.Free;
     tmp2.Free;

packages/extra/ptc/colord.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -21,24 +21,22 @@
 Type
   TPTCColor=Class(TObject)
   Private
-    m_index : Integer;
-    m_r, m_g, m_b, m_a : Single;
-    m_direct : Boolean;
-    m_indexed : Boolean;
+    FIndex : Integer;
+    FRed, FGreen, FBlue, FAlpha : Single;
+    FDirect : Boolean;
+    FIndexed : Boolean;
   Public
     Constructor Create;
-    Constructor Create(_index : Integer);
-    Constructor Create(_r, _g, _b, _a : Real);
-    Constructor Create(_r, _g, _b : Real);
-    Constructor Create(Const color : TPTCColor);
-    Destructor Destroy; Override;
-    Procedure Assign(Const color : TPTCColor);
-    Function Equals(Const color : TPTCColor) : Boolean;
-    Property index : Integer read m_index;
-    Property r : Single read m_r;
-    Property g : Single read m_g;
-    Property b : Single read m_b;
-    Property a : Single read m_a;
-    Property direct : Boolean read m_direct;
-    Property indexed : Boolean read m_indexed;
+    Constructor Create(AIndex : Integer);
+    Constructor Create(ARed, AGreen, ABlue : Single; AAlpha : Single = 1);
+    Constructor Create(Const AColor : TPTCColor);
+    Procedure Assign(Const AColor : TPTCColor);
+    Function Equals(Const AColor : TPTCColor) : Boolean;
+    Property Index : Integer Read FIndex;
+    Property R : Single Read FRed;
+    Property G : Single Read FGreen;
+    Property B : Single Read FBlue;
+    Property A : Single Read FAlpha;
+    Property Direct : Boolean Read FDirect;
+    Property Indexed : Boolean Read FIndexed;
   End;

packages/extra/ptc/colori.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -21,89 +21,71 @@
 Constructor TPTCColor.Create;
 
 Begin
-  m_indexed := False;
-  m_direct := False;
-  m_index := 0;
-  m_r := 0;
-  m_g := 0;
-  m_b := 0;
-  m_a := 1;
+  FIndexed := False;
+  FDirect  := False;
+  FIndex   := 0;
+  FRed     := 0;
+  FGreen   := 0;
+  FBlue    := 0;
+  FAlpha   := 1;
 End;
 
-Constructor TPTCColor.Create(_index : Integer);
+Constructor TPTCColor.Create(AIndex : Integer);
 
 Begin
-  m_indexed := True;
-  m_direct := False;
-  m_index := _index;
-  m_r := 0;
-  m_g := 0;
-  m_b := 0;
-  m_a := 1;
+  FIndexed := True;
+  FDirect  := False;
+  FIndex   := AIndex;
+  FRed     := 0;
+  FGreen   := 0;
+  FBlue    := 0;
+  FAlpha   := 1;
 End;
 
-Constructor TPTCColor.Create(_r, _g, _b, _a : Real);
+Constructor TPTCColor.Create(ARed, AGreen, ABlue : Single; AAlpha : Single = 1);
 
 Begin
-  m_indexed := False;
-  m_direct := True;
-  m_index := 0;
-  m_r := _r;
-  m_g := _g;
-  m_b := _b;
-  m_a := _a;
+  FIndexed := False;
+  FDirect  := True;
+  FIndex   := 0;
+  FRed     := ARed;
+  FGreen   := AGreen;
+  FBlue    := ABlue;
+  FAlpha   := AAlpha;
 End;
 
-Constructor TPTCColor.Create(_r, _g, _b : Real);
+Constructor TPTCColor.Create(Const AColor : TPTCColor);
 
 Begin
-  m_indexed := False;
-  m_direct := True;
-  m_index := 0;
-  m_r := _r;
-  m_g := _g;
-  m_b := _b;
-  m_a := 1;
+  FIndex   := AColor.FIndex;
+  FRed     := AColor.FRed;
+  FGreen   := AColor.FGreen;
+  FBlue    := AColor.FBlue;
+  FAlpha   := AColor.FAlpha;
+  FDirect  := AColor.FDirect;
+  FIndexed := AColor.FIndexed;
 End;
 
-Constructor TPTCColor.Create(Const color : TPTCColor);
+Procedure TPTCColor.Assign(Const AColor : TPTCColor);
 
 Begin
-  ASSign(color);
+  FIndex   := AColor.FIndex;
+  FRed     := AColor.FRed;
+  FGreen   := AColor.FGreen;
+  FBlue    := AColor.FBlue;
+  FAlpha   := AColor.FAlpha;
+  FDirect  := AColor.FDirect;
+  FIndexed := AColor.FIndexed;
 End;
 
-Destructor TPTCColor.Destroy;
+Function TPTCColor.Equals(Const AColor : TPTCColor) : Boolean;
 
 Begin
-  Inherited Destroy;
-End;
-
-Procedure TPTCColor.Assign(Const color : TPTCColor);
-
-Begin
-  If Self = color Then
-    Raise TPTCError.Create('self assignment is not allowed');
-  m_index := color.index;
-  m_r := color.r;
-  m_g := color.g;
-  m_b := color.b;
-  m_a := color.a;
-  m_direct := color.direct;
-  m_indexed := color.indexed;
-End;
-
-Function TPTCColor.Equals(Const color : TPTCColor) : Boolean;
-
-Begin
-  If m_direct And color.m_direct Then
-    If (m_r = color.m_r) And (m_g = color.m_g) And
-       (m_b = color.m_b) And (m_a = color.m_a) Then
-      Equals := True
-    Else
-      Equals := False
-  Else
-    If m_index = color.m_index Then
-      Equals := True
-    Else
-      Equals := False;
+  Result := (FIndexed = AColor.FIndexed) And
+            (FDirect  = AColor.FDirect) And
+            (FIndex   = AColor.FIndex) And
+            (FRed     = AColor.FRed) And
+            (FGreen   = AColor.FGreen) And
+            (FBlue    = AColor.FBlue) And
+            (FAlpha   = AColor.FAlpha);
 End;

packages/extra/ptc/consoled.inc

@@ -22,36 +22,24 @@ Type
   TPTCConsole=Class(TPTCBaseConsole)
   Private
     Function ConsoleCreate(index : Integer) : TPTCBaseConsole;
-    Function ConsoleCreate(Const _name : String) : TPTCBaseConsole;
+    Function ConsoleCreate(Const AName : String) : TPTCBaseConsole;
     Procedure check;
     console : TPTCBaseConsole;
     m_modes : Array[0..1023] Of TPTCMode;
     hacky_option_console_flag : Boolean;
-  Protected
-    Procedure internal_ReadKey(k : TPTCKey); Override;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Override;
   Public
-    Constructor Create;
+    Constructor Create; Override;
     Destructor Destroy; Override;
     Procedure configure(Const _file : String); Override;
     Function option(Const _option : String) : Boolean; Override;
     Function modes : PPTCMode; Override;
-    Procedure open(Const _title : String; _pages : Integer); Overload; Override;
+    Procedure open(Const _title : String; _pages : Integer = 0); Overload; Override;
     Procedure open(Const _title : String; Const _format : TPTCFormat;
-                   _pages : Integer); Overload; Override;
+                   _pages : Integer = 0); Overload; Override;
     Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat; _pages : Integer); Overload; Override;
+                   Const _format : TPTCFormat; _pages : Integer = 0); Overload; Override;
     Procedure open(Const _title : String; Const _mode : TPTCMode;
-                   _pages : Integer); Overload; Override;
-
-    {$WARNING this should be removed for fpc 1.1}
-    {pages=0}
-    Procedure open(Const _title : String); Overload; Override;
-    Procedure open(Const _title : String; Const _format : TPTCFormat); Overload; Override;
-    Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat); Overload; Override;
-    Procedure open(Const _title : String; Const _mode : TPTCMode); Overload; Override;
-    {/pages=0}
+                   _pages : Integer = 0); Overload; Override;
 
     Procedure close; Override;
     Procedure flush; Override;
@@ -86,16 +74,18 @@ Type
     Procedure clear(Const color : TPTCColor;
                     Const _area : TPTCArea); Override;
     Procedure palette(Const _palette : TPTCPalette); Override;
-    Function palette : TPTCPalette; Override;
-    Procedure clip(Const _area : TPTCArea); Override;
-    Function width : Integer; Override;
-    Function height : Integer; Override;
-    Function pitch : Integer; Override;
-    Function pages : Integer; Override;
-    Function area : TPTCArea; Override;
-    Function clip : TPTCArea; Override;
-    Function format : TPTCFormat; Override;
-    Function name : String; Override;
-    Function title : String; Override;
-    Function information : String; Override;
+    Function Palette : TPTCPalette; Override;
+    Procedure Clip(Const _area : TPTCArea); Override;
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+    Function GetPitch : Integer; Override;
+    Function GetPages : Integer; Override;
+    Function GetArea : TPTCArea; Override;
+    Function Clip : TPTCArea; Override;
+    Function GetFormat : TPTCFormat; Override;
+    Function GetName : String; Override;
+    Function GetTitle : String; Override;
+    Function GetInformation : String; Override;
+    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override;
   End;

packages/extra/ptc/consolei.inc

@@ -18,6 +18,47 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+Const
+ {$IFDEF GO32V2}
+  ConsoleTypesNumber = 4;
+ {$ENDIF GO32V2}
+ {$IFDEF Win32}
+  ConsoleTypesNumber = 2;
+ {$ENDIF Win32}
+ {$IFDEF WinCE}
+  ConsoleTypesNumber = 2;
+ {$ENDIF WinCE}
+ {$IFDEF UNIX}
+  ConsoleTypesNumber = 1;
+ {$ENDIF UNIX}
+  ConsoleTypes : Array[0..ConsoleTypesNumber - 1] Of
+    Record
+      ConsoleClass : Class Of TPTCBaseConsole;
+      Names : Array[1..2] Of String;
+    End =
+  (
+  {$IFDEF GO32V2}
+   (ConsoleClass : TVESAConsole;      Names : ('VESA', '')),
+   (ConsoleClass : TVGAConsole;       Names : ('VGA', 'Fakemode')),
+   (ConsoleClass : TCGAConsole;       Names : ('CGA', '')),
+   (ConsoleClass : TTEXTFX2Console;   Names : ('TEXTFX2', 'Text'))
+  {$ENDIF GO32V2}
+
+  {$IFDEF Win32}
+   (ConsoleClass : TDirectXConsole;   Names : ('DirectX', '')),
+   (ConsoleClass : TGDIConsole;       Names : ('GDI', ''))
+  {$ENDIF Win32}
+
+  {$IFDEF WinCE}
+   (ConsoleClass : TWinCEGAPIConsole; Names : ('GAPI', '')),
+   (ConsoleClass : TWinCEGDIConsole;  Names : ('GDI', ''))
+  {$ENDIF WinCE}
+
+  {$IFDEF UNIX}
+   (ConsoleClass : TX11Console;       Names : ('X11', ''))
+  {$ENDIF UNIX}
+  );
+
 Constructor TPTCConsole.Create;
 
 Var
@@ -33,18 +74,29 @@ Begin
   FillChar(m_modes, SizeOf(m_modes), 0);
   For I := Low(m_modes) To High(m_modes) Do
     m_modes[I] := TPTCMode.Create;
+
   {$IFDEF UNIX}
-  configure('/usr/share/ptc/ptc.conf');
-  s := fpgetenv('HOME');
-  If s = '' Then
-    s := '/';
-  If s[Length(s)] <> '/' Then
-    s := s + '/';
-  s := s + '.ptc.conf';
-  configure(s);
-  {$ELSE UNIX}
-  configure('ptc.cfg');
+    configure('/usr/share/ptcpas/ptcpas.conf');
+    s := fpgetenv('HOME');
+    If s = '' Then
+      s := '/';
+    If s[Length(s)] <> '/' Then
+      s := s + '/';
+    s := s + '.ptcpas.conf';
+    configure(s);
   {$ENDIF UNIX}
+
+  {$IFDEF Win32}
+    configure('ptcpas.cfg');
+  {$ENDIF Win32}
+
+  {$IFDEF GO32V2}
+    configure('ptcpas.cfg');
+  {$ENDIF GO32V2}
+
+  {$IFDEF WinCE}
+  {todo: configure WinCE}
+  {$ENDIF WinCE}
 End;
 
 Destructor TPTCConsole.Destroy;
@@ -67,7 +119,7 @@ Var
   S : String;
 
 Begin
-  ASSignFile(F, _file);
+  AssignFile(F, _file);
   {$I-}
   Reset(F);
   {$I+}
@@ -88,7 +140,6 @@ End;
 Function TPTCConsole.option(Const _option : String) : Boolean;
 
 Begin
-{$IFDEF PTC_LOGGING}
   If _option = 'enable logging' Then
   Begin
     LOG_enabled := True;
@@ -101,7 +152,6 @@ Begin
     option := True;
     Exit;
   End;
-{$ENDIF PTC_LOGGING}
 
   If Assigned(console) Then
     option := console.option(_option)
@@ -152,7 +202,7 @@ Begin
         local := 0;
         While _modes[local].valid Do
         Begin
-          m_modes[mode].ASSign(_modes[local]);
+          m_modes[mode].Assign(_modes[local]);
           Inc(local);
           Inc(mode);
         End;
@@ -164,7 +214,7 @@ Begin
     { todo: strip duplicate modes from list? }
     tmp := TPTCMode.Create;
     Try
-      m_modes[mode].ASSign(tmp);
+      m_modes[mode].Assign(tmp);
     Finally
       tmp.Free;
     End;
@@ -213,7 +263,7 @@ Begin
         On error : TPTCError Do Begin
           tmp := TPTCError.Create(error.message, composite);
           Try
-            composite.ASSign(tmp);
+            composite.Assign(tmp);
           Finally
             tmp.Free;
           End;
@@ -273,7 +323,7 @@ Begin
         On error : TPTCError Do Begin
           tmp := TPTCError.Create(error.message, composite);
           Try
-            composite.ASSign(tmp);
+            composite.Assign(tmp);
           Finally
             tmp.Free;
           End;
@@ -333,7 +383,7 @@ Begin
         On error : TPTCError Do Begin
           tmp := TPTCError.Create(error.message, composite);
           Try
-            composite.ASSign(tmp);
+            composite.Assign(tmp);
           Finally
             tmp.Free;
           End;
@@ -393,7 +443,7 @@ Begin
         On error : TPTCError Do Begin
           tmp := TPTCError.Create(error.message, composite);
           Try
-            composite.ASSign(tmp);
+            composite.Assign(tmp);
           Finally
             tmp.Free;
           End;
@@ -447,20 +497,6 @@ Begin
   console.update(_area);
 End;
 
-Procedure TPTCConsole.internal_ReadKey(k : TPTCKey);
-
-Begin
-  check;
-  console.internal_ReadKey(k);
-End;
-
-Function TPTCConsole.internal_PeekKey(k : TPTCKey) : Boolean;
-
-Begin
-  check;
-  Result := console.internal_PeekKey(k);
-End;
-
 Procedure TPTCConsole.copy(Var surface : TPTCBaseSurface);
 
 Begin
@@ -563,191 +599,156 @@ Begin
   console.palette(_palette);
 End;
 
-Function TPTCConsole.palette : TPTCPalette;
+Function TPTCConsole.Palette : TPTCPalette;
 
 Begin
   check;
-  palette := console.palette;
+  Result := console.Palette;
 End;
 
-Procedure TPTCConsole.clip(Const _area : TPTCArea);
+Procedure TPTCConsole.Clip(Const _area : TPTCArea);
 
 Begin
   check;
   console.clip(_area);
 End;
 
-Function TPTCConsole.width : Integer;
+Function TPTCConsole.GetWidth : Integer;
 
 Begin
   check;
-  width := console.width;
+  Result := console.GetWidth;
 End;
 
-Function TPTCConsole.height : Integer;
+Function TPTCConsole.GetHeight : Integer;
 
 Begin
   check;
-  height := console.height;
+  Result := console.GetHeight;
 End;
 
-Function TPTCConsole.pitch : Integer;
+Function TPTCConsole.GetPitch : Integer;
 
 Begin
   check;
-  pitch := console.pitch;
+  Result := console.GetPitch;
 End;
 
-Function TPTCConsole.pages : Integer;
+Function TPTCConsole.GetPages : Integer;
 
 Begin
   check;
-  pages := console.pages;
+  Result := console.GetPages;
 End;
 
-Function TPTCConsole.area : TPTCArea;
+Function TPTCConsole.GetArea : TPTCArea;
 
 Begin
   check;
-  area := console.area;
+  Result := console.GetArea;
 End;
 
-Function TPTCConsole.clip : TPTCArea;
+Function TPTCConsole.Clip : TPTCArea;
 
 Begin
   check;
-  clip := console.clip;
+  Result := console.Clip;
 End;
 
-Function TPTCConsole.format : TPTCFormat;
+Function TPTCConsole.GetFormat : TPTCFormat;
 
 Begin
   check;
-  format := console.format;
+  Result := console.GetFormat;
 End;
 
-Function TPTCConsole.name : String;
+Function TPTCConsole.GetName : String;
 
 Begin
-  name := '';
+  Result := '';
   If Assigned(console) Then
-    name := console.name
+    Result := console.GetName
   Else
 {$IFDEF GO32V2}
-    name := 'DOS';
+    Result := 'DOS';
 {$ENDIF GO32V2}
 {$IFDEF WIN32}
-    name := 'Win32';
+    Result := 'Win32';
 {$ENDIF WIN32}
 {$IFDEF LINUX}
-    name := 'Linux';
+    Result := 'Linux';
 {$ENDIF LINUX}
 End;
 
-Function TPTCConsole.title : String;
+Function TPTCConsole.GetTitle : String;
 
 Begin
   check;
-  title := console.title;
+  Result := console.GetTitle;
 End;
 
-Function TPTCConsole.information : String;
+Function TPTCConsole.GetInformation : String;
 
 Begin
   check;
-  information := console.information;
+  Result := console.GetInformation;
 End;
 
-Function TPTCConsole.ConsoleCreate(index : Integer) : TPTCBaseConsole;
+Function TPTCConsole.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean;
 
 Begin
-  {$IFDEF GO32V2}
-  Case index Of
-    0 : ConsoleCreate := VESAConsole.Create;
-    1 : ConsoleCreate := VGAConsole.Create;
-    2 : ConsoleCreate := CGAConsole.Create;
-    3 : ConsoleCreate := TEXTFX2Console.Create;
-    Else
-      ConsoleCreate := Nil;
-  End;
-  {$ENDIF GO32V2}
-  {$IFDEF WIN32}
-  Case index Of
-    0 : ConsoleCreate := TDirectXConsole.Create;
-    Else
-      ConsoleCreate := Nil;
-  End;
-  {$ENDIF WIN32}
-  {$IFDEF UNIX}
-  Case index Of
-    0 : ConsoleCreate := TX11Console.Create;
-    Else
-      ConsoleCreate := Nil;
-  End;
-  {$ENDIF UNIX}
-  If ConsoleCreate <> Nil Then
-    ConsoleCreate.KeyReleaseEnabled := KeyReleaseEnabled;
+  check;
+  Result := console.NextEvent(event, wait, EventMask);
 End;
 
-Function TPTCConsole.ConsoleCreate(Const _name : String) : TPTCBaseConsole;
+Function TPTCConsole.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent;
 
 Begin
-  ConsoleCreate := Nil;
-  {$IFDEF GO32V2}
-  If _name = 'VESA' Then
-    ConsoleCreate := VESAConsole.Create;
-  If (_name = 'VGA') Or (_name = 'Fakemode') Then
-    ConsoleCreate := VGAConsole.Create;
-  If (_name = 'TEXTFX2') Or (_name = 'Text') Then
-    ConsoleCreate := TEXTFX2Console.Create;
-  If _name = 'CGA' Then
-    ConsoleCreate := CGAConsole.Create;
-  {$ENDIF GO32V2}
-  {$IFDEF WIN32}
-  If _name = 'DirectX' Then
-    ConsoleCreate := TDirectXConsole.Create;
-  {$ENDIF WIN32}
-  {$IFDEF UNIX}
-  If _name = 'X11' Then
-    ConsoleCreate := TX11Console.Create;
-  {$ENDIF UNIX}
-  If ConsoleCreate <> Nil Then
-    ConsoleCreate.KeyReleaseEnabled := KeyReleaseEnabled;
+  check;
+  Result := console.PeekEvent(wait, EventMask);
 End;
 
-Procedure TPTCConsole.check;
+Function TPTCConsole.ConsoleCreate(index : Integer) : TPTCBaseConsole;
 
 Begin
-  {$IFDEF DEBUG}
-  If console = Nil Then
-    Raise TPTCError.Create('console is not open (core)');
-  {$ENDIF DEBUG}
-End;
+  Result := Nil;
+  If (index >= Low(ConsoleTypes)) And (index <= High(ConsoleTypes)) Then
+    Result := ConsoleTypes[index].ConsoleClass.Create;
 
-{$WARNING this should be removed for fpc 1.1}
-{pages=0}
-Procedure TPTCConsole.open(Const _title : String);
-
-Begin
-  open(_title, 0);
+  If Result <> Nil Then
+    Result.KeyReleaseEnabled := KeyReleaseEnabled;
 End;
 
-Procedure TPTCConsole.open(Const _title : String; Const _format : TPTCFormat);
+Function TPTCConsole.ConsoleCreate(Const AName : String) : TPTCBaseConsole;
+
+Var
+  I, J : Integer;
 
 Begin
-  open(_title, _format, 0);
-End;
+  Result := Nil;
 
-Procedure TPTCConsole.open(Const _title : String; _width, _height : Integer;
-                           Const _format : TPTCFormat);
+  If AName = '' Then
+    Exit;
 
-Begin
-  open(_title, _width, _height, _format, 0);
+  For I := Low(ConsoleTypes) To High(ConsoleTypes) Do
+    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;
+      End;
 End;
 
-Procedure TPTCConsole.open(Const _title : String; Const _mode : TPTCMode);
+Procedure TPTCConsole.check;
 
 Begin
-  open(_title, _mode, 0);
+  { $IFDEF DEBUG}
+  If console = Nil Then
+    Raise TPTCError.Create('console is not open (core)');
+  { $ENDIF DEBUG}
 End;
-{/pages=0}

packages/extra/ptc/copyd.inc

@@ -21,17 +21,17 @@
 Type
   TPTCCopy=Class(TObject)
   Private
-    Procedure update;
-    m_handle : THermesHandle;
-    m_flags : LongInt;
+    Procedure Update;
+    FHandle : THermesHandle;
+    FFlags : LongInt;
   Public
     Constructor Create;
     Destructor Destroy; Override;
-    Procedure request(Const source, destination : TPTCFormat);
-    Procedure palette(Const source, destination : TPTCPalette);
-    Procedure copy(Const source_pixels : Pointer; source_x, source_y,
-                   source_width, source_height, source_pitch : Integer;
-                   destination_pixels : Pointer; destination_x, destination_y,
-                   destination_width, destination_height, destination_pitch : Integer);
-    Function option(Const _option : String) : Boolean;
+    Procedure Request(Const ASource, ADestination : TPTCFormat);
+    Procedure Palette(Const ASource, ADestination : TPTCPalette);
+    Procedure Copy(Const ASourcePixels : Pointer; ASourceX, ASourceY,
+                   ASourceWidth, ASourceHeight, ASourcePitch : Integer;
+                   ADestinationPixels : Pointer; ADestinationX, ADestinationY,
+                   ADestinationWidth, ADestinationHeight, ADestinationPitch : Integer);
+    Function Option(Const AOption : String) : Boolean;
   End;

packages/extra/ptc/copyi.inc

@@ -23,48 +23,45 @@ Constructor TPTCCopy.Create;
 Begin
   If Not Hermes_Init Then
     Raise TPTCError.Create('could not initialize hermes');
-  m_flags := HERMES_CONVERT_NORMAL;
-  m_handle := Hermes_ConverterInstance(m_flags);
-  If m_handle = 0 Then
+  FFlags := HERMES_CONVERT_NORMAL;
+  FHandle := Hermes_ConverterInstance(FFlags);
+  If FHandle = 0 Then
     Raise TPTCError.Create('could not create hermes converter instance');
 End;
 
 Destructor TPTCCopy.Destroy;
 
 Begin
-  Hermes_ConverterReturn(m_handle);
+  Hermes_ConverterReturn(FHandle);
   Hermes_Done;
   Inherited Destroy;
 End;
 
-Procedure TPTCCopy.request(Const source, destination : TPTCFormat);
+Procedure TPTCCopy.Request(Const ASource, ADestination : TPTCFormat);
 
 Var
   hermes_source_format, hermes_destination_format : PHermesFormat;
 
 Begin
-  hermes_source_format := @source.Fformat;
-  hermes_destination_format := @destination.Fformat;
-  If Not Hermes_ConverterRequest(m_handle, hermes_source_format,
+  hermes_source_format := @ASource.FFormat;
+  hermes_destination_format := @ADestination.FFormat;
+  If Not Hermes_ConverterRequest(FHandle, hermes_source_format,
      hermes_destination_format) Then
     Raise TPTCError.Create('unsupported hermes pixel format conversion');
 End;
 
-Procedure TPTCCopy.palette(Const source, destination : TPTCPalette);
+Procedure TPTCCopy.Palette(Const ASource, ADestination : TPTCPalette);
 
 Begin
-  If Not Hermes_ConverterPalette(m_handle, source.m_handle,
-	 destination.m_handle) Then
+  If Not Hermes_ConverterPalette(FHandle, ASource.m_handle,
+         ADestination.m_handle) Then
     Raise TPTCError.Create('could not set hermes conversion palettes');
 End;
 
-Procedure TPTCCopy.copy(Const source_pixels : Pointer; source_x, source_y,
-		   source_width, source_height, source_pitch : Integer;
-		   destination_pixels : Pointer; destination_x, destination_y,
-		   destination_width, destination_height, destination_pitch : Integer);
-
-Var
-  source : Pointer;
+Procedure TPTCCopy.copy(Const ASourcePixels : Pointer; ASourceX, ASourceY,
+                   ASourceWidth, ASourceHeight, ASourcePitch : Integer;
+                   ADestinationPixels : Pointer; ADestinationX, ADestinationY,
+                   ADestinationWidth, ADestinationHeight, ADestinationPitch : Integer);
 
 Begin
 {$IFDEF DEBUG}
@@ -84,48 +81,47 @@ Begin
   this operation is undefined if the source and destination memory
   areas overlap.
 }
-  If source_pixels = Nil Then
+  If ASourcePixels = Nil Then
     Raise TPTCError.Create('nil source pointer in copy');
-  If destination_pixels = Nil Then
+  If ADestinationPixels = Nil Then
     Raise TPTCError.Create('nil destination pointer in copy');
-  If source_pixels = destination_pixels Then
+  If ASourcePixels = ADestinationPixels Then
     Raise TPTCError.Create('identical source and destination pointers in copy');
 {$ELSE DEBUG}
     { in release build no checking is performed for the sake of efficiency. }
 {$ENDIF DEBUG}
-  source := source_pixels;
-  If Not Hermes_ConverterCopy(m_handle, source, source_x, source_y,
-	  source_width, source_height, source_pitch, destination_pixels,
-	  destination_x, destination_y, destination_width, destination_height,
-	  destination_pitch) Then
+  If Not Hermes_ConverterCopy(FHandle, ASourcePixels, ASourceX, ASourceY,
+          ASourceWidth, ASourceHeight, ASourcePitch, ADestinationPixels,
+          ADestinationX, ADestinationY, ADestinationWidth, ADestinationHeight,
+          ADestinationPitch) Then
     Raise TPTCError.Create('hermes conversion failure');
 End;
 
-Function TPTCCopy.option(Const _option : String) : Boolean;
+Function TPTCCopy.Option(Const AOption : String) : Boolean;
 
 Begin
-  If (_option = 'attempt dithering') And ((m_flags And HERMES_CONVERT_DITHER) = 0) Then
+  If (AOption = 'attempt dithering') And ((FFlags And HERMES_CONVERT_DITHER) = 0) Then
   Begin
-    m_flags := m_flags Or HERMES_CONVERT_DITHER;
-    update;
-    option := True;
+    FFlags := FFlags Or HERMES_CONVERT_DITHER;
+    Update;
+    Result := True;
     Exit;
   End;
-  If (_option = 'disable dithering') And ((m_flags And HERMES_CONVERT_DITHER) <> 0) Then
+  If (AOption = 'disable dithering') And ((FFlags And HERMES_CONVERT_DITHER) <> 0) Then
   Begin
-    m_flags := m_flags And (Not HERMES_CONVERT_DITHER);
-    update;
-    option := True;
+    FFlags := FFlags And (Not HERMES_CONVERT_DITHER);
+    Update;
+    Result := True;
     Exit;
   End;
-  option := False;
+  Result := False;
 End;
 
-Procedure TPTCCopy.update;
+Procedure TPTCCopy.Update;
 
 Begin
-  Hermes_ConverterReturn(m_handle);
-  m_handle := Hermes_ConverterInstance(m_flags);
-  If m_handle = 0 Then
+  Hermes_ConverterReturn(FHandle);
+  FHandle := Hermes_ConverterInstance(FFlags);
+  If FHandle = 0 Then
     Raise TPTCError.Create('could not update hermes converter instance');
 End;

packages/extra/ptc/coreimplementation.inc

@@ -0,0 +1,16 @@
+{$INCLUDE errori.inc}
+{$INCLUDE areai.inc}
+{$INCLUDE colori.inc}
+{$INCLUDE formati.inc}
+{$INCLUDE eventi.inc}
+{$INCLUDE keyeventi.inc}
+{$INCLUDE mouseeventi.inc}
+{$INCLUDE modei.inc}
+{$INCLUDE palettei.inc}
+{$INCLUDE cleari.inc}
+{$INCLUDE copyi.inc}
+{$INCLUDE clipperi.inc}
+{$INCLUDE basesurfacei.inc}
+{$INCLUDE baseconsolei.inc}
+{$INCLUDE surfacei.inc}
+{$INCLUDE timeri.inc}

packages/extra/ptc/coreinterface.inc

@@ -0,0 +1,17 @@
+{$INCLUDE aread.inc}
+{$INCLUDE colord.inc}
+{$INCLUDE formatd.inc}
+{$INCLUDE eventd.inc}
+{$INCLUDE keyeventd.inc}
+{$INCLUDE mouseeventd.inc}
+{$INCLUDE moded.inc}
+{$INCLUDE paletted.inc}
+{$INCLUDE cleard.inc}
+{$INCLUDE copyd.inc}
+{$INCLUDE clipperd.inc}
+{$INCLUDE basesurfaced.inc}
+{$INCLUDE surfaced.inc}
+{$INCLUDE baseconsoled.inc}
+{$INCLUDE consoled.inc}
+{$INCLUDE errord.inc}
+{$INCLUDE timerd.inc}

packages/extra/ptc/demos/fire.pp

@@ -15,7 +15,7 @@ Program Fire;
 Uses
   ptc;
 
-Function pack(r, g, b : int32) : int32;
+Function pack(r, g, b : Uint32) : Uint32;
 
 Begin
   { pack color integer }
@@ -25,50 +25,53 @@ End;
 Procedure generate(palette : TPTCPalette);
 
 Var
-  data : Pint32;
+  data : PUint32;
   i, c : Integer;
 
 Begin
   { lock palette data }
   data := palette.lock;
 
-  { black to red }
-  i := 0;
-  c := 0;
-  While i < 64 Do
-  Begin
-    data[i] := pack(c, 0, 0);
-    Inc(c, 4);
-    Inc(i);
-  End;
+  Try
+    { black to red }
+    i := 0;
+    c := 0;
+    While i < 64 Do
+    Begin
+      data[i] := pack(c, 0, 0);
+      Inc(c, 4);
+      Inc(i);
+    End;
 
-  { red to yellow }
-  c := 0;
-  While i < 128 Do
-  Begin
-    data[i] := pack(255, c, 0);
-    Inc(c, 4);
-    Inc(i);
-  End;
+    { red to yellow }
+    c := 0;
+    While i < 128 Do
+    Begin
+      data[i] := pack(255, c, 0);
+      Inc(c, 4);
+      Inc(i);
+    End;
 
-  { yellow to white }
-  c := 0;
-  While i < {192}128 Do
-  Begin
-    data[i] := pack(255, 255, c);
-    Inc(c, 4);
-    Inc(i);
-  End;
+    { yellow to white }
+    c := 0;
+    While i < {192}128 Do
+    Begin
+      data[i] := pack(255, 255, c);
+      Inc(c, 4);
+      Inc(i);
+    End;
 
-  { white }
-  While i < 256 Do
-  Begin
-    data[i] := pack(255, 255, 255);
-    Inc(i);
-  End;
+    { white }
+    While i < 256 Do
+    Begin
+      data[i] := pack(255, 255, 255);
+      Inc(i);
+    End;
 
-  { unlock palette }
-  palette.unlock;
+  Finally
+    { unlock palette }
+    palette.unlock;
+  End;
 End;
 
 Var
@@ -78,11 +81,11 @@ Var
   palette : TPTCPalette;
   state : Integer;
   intensity : Single;
-  pixels, pixel, p : Pchar8;
+  pixels, pixel, p : PUint8;
   width, height : Integer;
   x, y : Integer;
-  top, bottom, c1, c2 : int32;
-  generator : Pchar8;
+  top, bottom, c1, c2 : Uint32;
+  generator : PUint8;
   color : Integer;
   area : TPTCArea;
 

packages/extra/ptc/demos/flower.pp

@@ -15,7 +15,7 @@ Program Flower;
 Uses
   ptc, Math;
 
-Function pack(r, g, b : int32) : int32;
+Function pack(r, g, b : Uint32) : Uint32;
 
 Begin
   { pack color integer }
@@ -25,7 +25,7 @@ End;
 Procedure generate_flower(flower : TPTCSurface);
 
 Var
-  data : Pchar8;
+  data : PUint8;
   x, y, fx, fy, fx2, fy2 : Integer;
   TWO_PI : Single;
 
@@ -62,7 +62,7 @@ End;
 Procedure generate(palette : TPTCPalette);
 
 Var
-  data : Pint32;
+  data : PUint32;
   i, c : Integer;
 
 Begin
@@ -120,7 +120,7 @@ Var
   palette : TPTCPalette;
   area : TPTCArea;
   time, delta : Single;
-  scr, map : Pchar8;
+  scr, map : PUint8;
   width, height, mapWidth : Integer;
   xo, yo, xo2, yo2, xo3, yo3 : Single;
   offset1, offset2, offset3 : Integer;

packages/extra/ptc/demos/land.pp

@@ -27,8 +27,8 @@ Const
   FOV : Integer = 256; { half of the xy field of view (This is based on the 0-2048 convention) }
 
 Var
-  HMap : Array[0..256*256 - 1] Of char8; { Height field }
-  CMap : Array[0..256*256 - 1] Of char8; { Color map }
+  HMap : Array[0..256*256 - 1] Of Uint8; { Height field }
+  CMap : Array[0..256*256 - 1] Of Uint8; { Color map }
 
   lasty, { Last pixel drawn on a given column }
   lastc : Array[0..SCREENWIDTH - 1] Of Integer; { Color of last pixel on a column }
@@ -144,12 +144,12 @@ End;
  for the distance. x0,y0,x1,y1 are 16.16 fixed point numbers and the
  scaling factor is a 16.8 fixed point value.
 }
-Procedure Line(x0, y0, x1, y1, hy, s : Integer; surface_buffer : Pint32; fadeout : Integer);
+Procedure Line(x0, y0, x1, y1, hy, s : Integer; surface_buffer : PUint32; fadeout : Integer);
 
 Var
   sx, sy, i, a, b, u0, u1, v0, v1, h0, h1, h2, h3, h, c, y : Integer;
   coord_x, coord_y, sc, cc, currentColor : Integer;
-  pixel : Pint32;
+  pixel : PUint32;
 
 Begin
   { Compute xy speed }
@@ -232,7 +232,7 @@ Begin
 End;
 
 { Draw the view from the point x0,y0 (16.16) looking at angle a }
-Procedure View(x0, y0, angle, height : Integer; surface_buffer : Pint32);
+Procedure View(x0, y0, angle, height : Integer; surface_buffer : PUint32);
 
 Var
   d, u0, a, v0, u1, v1, h0, h1, h2, h3 : Integer;
@@ -283,8 +283,8 @@ Var
   console : TPTCConsole;
   surface : TPTCSurface;
   timer : TPTCTimer;
-  key : TPTCKey;
-  pixels : Pint32;
+  key : TPTCKeyEvent;
+  pixels : PUint32;
   Done : Boolean;
 
   x0, y0 : Integer;
@@ -301,7 +301,7 @@ Begin
   key := Nil;
   Try
     Try
-      key := TPTCKey.Create;
+      key := TPTCKeyEvent.Create;
       format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
       console := TPTCConsole.Create;
       console.open('Land demo', SCREENWIDTH, SCREENHEIGHT, format);

packages/extra/ptc/demos/lights.pp

@@ -34,8 +34,8 @@ Var
   palette : TPTCPalette;
   dx, dy : Integer;
   divisor : Single;
-  data : Pint32;
-  pixels, line : Pchar8;
+  data : PUint32;
+  pixels, line : PUint8;
   width : Integer;
   i : Integer;
   x, y, x1, y1, x2, y2, x3, y3, x4, y4 : Integer;

packages/extra/ptc/demos/mojo.pp

@@ -34,11 +34,11 @@ Const
   SC = 12;
   MINSEGSIZE = 2.5;
   NSEG = 5;
-  frandtab_seed : short16 = 54;
+  frandtab_seed : Uint16 = 54;
 
 Var
-  MaskMap : Pchar8;
-  frandtab : Array[0..65535] Of short16;
+  MaskMap : PUint8;
+  frandtab : Array[0..65535] Of Uint16;
 
 Type
   FVector = Object
@@ -596,15 +596,15 @@ Var
   camposn : FVector;
   camaxis : FMatrix;
   c1, c2, c3, ti, xx, yy, zz, i, a, x, y : Integer;
-  idx : Array[0..(200 Div 16) - 1, 0..(320 Div 16) - 1] Of char8;
+  idx : Array[0..(200 Div 16) - 1, 0..(320 Div 16) - 1] Of Uint8;
   order : Array[0..10*19 - 1, 0..1] Of Integer;
   vlightt, t, cz, camf : Single;
   col : FVector;
   ray : TRay;
-  oc, c, c2_ : int32;
+  oc, c, c2_ : Uint32;
   time, delta : Single;
   pitch : Integer;
-  screenbuf, pd : Pchar8;
+  screenbuf, pd : PUint8;
   tmp : FVector;
   F : File;
 
@@ -721,21 +721,21 @@ Begin
 	  oc := c;
 
 	  c2_ := (c Shr 1) And $7F7F7F;
-	  Pint32(pd)[1] := ((Pint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
-	  Pint32(pd)[2] := ((Pint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[1] := ((PUint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[2] := ((PUint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
 	  Inc(pd, pitch);
-	  Pint32(pd)[0] := ((Pint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
-	  Pint32(pd)[1] := c;
-	  Pint32(pd)[2] := c;
-	  Pint32(pd)[3] := ((Pint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[0] := ((PUint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[1] := c;
+	  PUint32(pd)[2] := c;
+	  PUint32(pd)[3] := ((PUint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
 	  Inc(pd, pitch);
-	  Pint32(pd)[0] := ((Pint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
-	  Pint32(pd)[1] := c;
-	  Pint32(pd)[2] := c;
-	  Pint32(pd)[3] := ((Pint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[0] := ((PUint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[1] := c;
+	  PUint32(pd)[2] := c;
+	  PUint32(pd)[3] := ((PUint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
 	  Inc(pd, pitch);
-	  Pint32(pd)[1] := ((Pint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
-	  Pint32(pd)[2] := ((Pint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[1] := ((PUint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
+	  PUint32(pd)[2] := ((PUint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
         End;
         i *= 5;
         i := i Div (3*idx[yy, xx]);

packages/extra/ptc/demos/texwarp.pp

@@ -18,67 +18,75 @@ Uses
 Const
 { colour balance values.  change these if you don't like the colouring }
 { of the texture. }
-  red_balance : int32 = 2;
-  green_balance : int32 = 3;
-  blue_balance : int32 = 1;
+  red_balance : Uint32 = 2;
+  green_balance : Uint32 = 3;
+  blue_balance : Uint32 = 1;
 
 Procedure blur(s : TPTCSurface);
 
 Var
-  d : Pchar8;
+  d : PUint8;
   pitch : Integer;
   spack, r : Integer;
 
 Begin
   { lock surface }
   d := s.lock;
-  pitch := s.pitch;
-  spack := (s.height - 1) * pitch;
+  
+  Try
+    pitch := s.pitch;
+    spack := (s.height - 1) * pitch;
+
+    { first pixel }
+    For r := 0 To 3 Do
+      d[r] := (d[pitch + r] + d[r + 4] + d[spack + r] + d[pitch - 4 + r]) Div 4;
 
-  { first pixel }
-  For r := 0 To 3 Do
-    d[r] := (d[pitch + r] + d[r + 4] + d[spack + r] + d[pitch - 4 + r]) Div 4;
+    { rest of first line }
+    For r := 4 To pitch - 1 Do
+      d[r] := (d[r + pitch] + d[r + 4] + d[r - 4] + d[spack + r]) Div 4;
 
-  { rest of first line }
-  For r := 4 To pitch - 1 Do
-    d[r] := (d[r + pitch] + d[r + 4] + d[r - 4] + d[spack + r]) Div 4;
+    { rest of surface except last line }
+    For r := pitch To ((s.height - 1) * pitch) - 1 Do
+      d[r] := (d[r - pitch] + d[r + pitch] + d[r + 4] + d[r - 4]) Div 4;
 
-  { rest of surface except last line }
-  For r := pitch To ((s.height - 1) * pitch) - 1 Do
-    d[r] := (d[r - pitch] + d[r + pitch] + d[r + 4] + d[r - 4]) Div 4;
+    { last line except last pixel }
+    For r := (s.height - 1) * pitch To (s.height * s.pitch) - 5 Do
+      d[r] := (d[r - pitch] + d[r + 4] + d[r - 4] + d[r - spack]) Div 4;
 
-  { last line except last pixel }
-  For r := (s.height - 1) * pitch To (s.height * s.pitch) - 5 Do
-    d[r] := (d[r - pitch] + d[r + 4] + d[r - 4] + d[r - spack]) Div 4;
+    { last pixel }
+    For r := (s.height * s.pitch) - 4 To s.height * s.pitch Do
+      d[r] := (d[r - pitch] + d[r - 4] + d[r - spack] + d[r + 4 - pitch]) Div 4;
 
-  { last pixel }
-  For r := (s.height * s.pitch) - 4 To s.height * s.pitch Do
-    d[r] := (d[r - pitch] + d[r - 4] + d[r - spack] + d[r + 4 - pitch]) Div 4;
-  s.unlock;
+  Finally
+    s.unlock;
+  End;
 End;
 
 Procedure generate(surface : TPTCSurface);
 
 Var
-  dest : Pint32;
+  dest : PUint32;
   i : Integer;
   x, y : Integer;
-  d : Pint32;
-  cv : int32;
-  r, g, b : char8;
+  d : PUint32;
+  cv : Uint32;
+  r, g, b : Uint8;
 
 Begin
   { draw random dots all over the surface }
   dest := surface.lock;
-  For i := 0 To surface.width * surface.height - 1 Do
-  Begin
-    x := Random(surface.width);
-    y := Random(surface.height);
-    d := dest + (y * surface.width) + x;
-    cv := (Random(100) Shl 16) Or (Random(100) Shl 8) Or Random(100);
-    d^ := cv;
+  Try
+    For i := 0 To surface.width * surface.height - 1 Do
+    Begin
+      x := Random(surface.width);
+      y := Random(surface.height);
+      d := dest + (y * surface.width) + x;
+      cv := (Random(100) Shl 16) Or (Random(100) Shl 8) Or Random(100);
+      d^ := cv;
+    End;
+  Finally
+    surface.unlock;
   End;
-  surface.unlock;
   
   { blur the surface }
   For i := 1 To 5 Do
@@ -86,28 +94,31 @@ Begin
   
   { multiply the color values }
   dest := surface.lock;
-  For i := 0 To surface.width * surface.height - 1 Do
-  Begin
-    cv := dest^;
-    r := (cv Shr 16) And 255;
-    g := (cv Shr 8) And 255;
-    b := cv And 255;
-    r *= red_balance;
-    g *= green_balance;
-    b *= blue_balance;
-    If r > 255 Then
-      r := 255;
-    If g > 255 Then
-      g := 255;
-    If b > 255 Then
-      b := 255;
-    dest^ := (r Shl 16) Or (g Shl 8) Or b;
-    Inc(dest);
+  Try
+    For i := 0 To surface.width * surface.height - 1 Do
+    Begin
+      cv := dest^;
+      r := (cv Shr 16) And 255;
+      g := (cv Shr 8) And 255;
+      b := cv And 255;
+      r *= red_balance;
+      g *= green_balance;
+      b *= blue_balance;
+      If r > 255 Then
+        r := 255;
+      If g > 255 Then
+        g := 255;
+      If b > 255 Then
+        b := 255;
+      dest^ := (r Shl 16) Or (g Shl 8) Or b;
+      Inc(dest);
+    End;
+  Finally
+    surface.unlock;
   End;
-  surface.unlock;
 End;
 
-Procedure grid_map(grid : Pint32; xbase, ybase, xmove, ymove, amp : Single);
+Procedure grid_map(grid : PUint32; xbase, ybase, xmove, ymove, amp : Single);
 
 Var
   x, y : Integer;
@@ -122,8 +133,8 @@ Begin
     Begin
       { it should be noted that there is no scientific basis for }
       { the following three lines :) }
-      grid[0] := int32(Trunc((xbase * 14 + x*4 + xmove*sin(b)+sin(cos(a)*sin(amp))*15) * 65536));
-      grid[1] := int32(Trunc((ybase * 31 + y*3 + ymove*cos(b)*sin(sin(a)*cos(amp))*30) * 65536));
+      grid[0] := Uint32(Trunc((xbase * 14 + x*4 + xmove*sin(b)+sin(cos(a)*sin(amp))*15) * 65536));
+      grid[1] := Uint32(Trunc((ybase * 31 + y*3 + ymove*cos(b)*sin(sin(a)*cos(amp))*30) * 65536));
       id := (cos(xbase) + sin(ybase) + cos(a*xmove*0.17) + sin(b*ymove*0.11)) * amp * 23;
       If id < -127 Then
         grid[2] := 0
@@ -139,7 +150,7 @@ Begin
   End;
 End;
 
-Procedure make_light_table(lighttable : Pchar8);
+Procedure make_light_table(lighttable : PUint8);
 
 Var
   i, j : Integer;
@@ -159,7 +170,7 @@ End;
 
 { if you want to see how to do this properly, look at the tunnel3d demo. }
 { (not included in this distribution :) }
-Procedure texture_warp(dest, grid, texture : Pint32; lighttable : Pchar8);
+Procedure texture_warp(dest, grid, texture : PUint32; lighttable : PUint8);
 
 Var
   utl, utr, ubl, ubr : Integer;
@@ -170,13 +181,13 @@ Var
   bx, by, px, py : Integer;
   uc, vc, ic, ucx, vcx, icx : Integer;
   
-  edi : int32;
-  texel : int32;
+  edi : Uint32;
+  texel : Uint32;
   
-  cbp, dp : Pint32;
-  dpix : int32;
+  cbp, dp : PUint32;
+  dpix : Uint32;
   
-  ltp : Pchar8;
+  ltp : PUint8;
 
 Begin
   cbp := grid;
@@ -259,12 +270,12 @@ Var
   texture : TPTCSurface;
   surface : TPTCSurface;
   console : TPTCConsole;
-  lighttable : Pchar8;
+  lighttable : PUint8;
   { texture grid }
-  grid : Array[0..41*26*3-1] Of int32;
+  grid : Array[0..41*26*3-1] Of Uint32;
   xbase, ybase, xmove, ymove, amp, dct, dxb, dyb, dxm, dym, sa : Single;
   
-  p1, p2 : Pint32;
+  p1, p2 : PUint32;
 
 Begin
   format := Nil;

packages/extra/ptc/demos/tunnel.pp

@@ -23,11 +23,11 @@ Type
     Constructor Create;
     Destructor Destroy; Override;
     Procedure setup;
-    Procedure draw(buffer : Pint32; t : Single);
+    Procedure draw(buffer : PUint32; t : Single);
     Private
     { tunnel data }
-    tunnel : Pint32;
-    texture : Pchar8;
+    tunnel : PUint32;
+    texture : PUint8;
   End;
 
 Constructor TTunnel.Create;
@@ -37,8 +37,8 @@ Begin
   texture := Nil;
   
   { allocate tables }
-  tunnel := GetMem(320*200*SizeOf(int32));
-  texture := GetMem(256*256*2*SizeOf(char8));
+  tunnel := GetMem(320*200*SizeOf(Uint32));
+  texture := GetMem(256*256*2*SizeOf(Uint8));
 
   { setup }
   setup;
@@ -106,11 +106,11 @@ Begin
   End;
 End;
 
-Procedure TTunnel.draw(buffer : Pint32; t : Single);
+Procedure TTunnel.draw(buffer : PUint32; t : Single);
 
 Var
   x, y : Integer;
-  scroll : int32;
+  scroll : Uint32;
   i : Integer;
 
 Begin
@@ -133,7 +133,7 @@ Var
   surface : TPTCSurface;
   TheTunnel : TTunnel;
   time, delta : Single;
-  buffer : Pint32;
+  buffer : PUint32;
 
 Begin
   format := Nil;

packages/extra/ptc/demos/tunnel3d.pp

@@ -19,13 +19,6 @@ Program Tunnel3D;
 Uses
   ptc, Math;
 
-{ for fpc 1.0.10 compatibility... }
-{$IFDEF VER1_0}
-Type
-  PtrUInt = Cardinal;
-  PtrInt = LongInt;
-{$ENDIF VER1_0}
-
 Type
   PVector = ^TVector;
   TVector = Array[0..2] Of Single;      { X,Y,Z }
@@ -40,9 +33,9 @@ Type
 
   TRayTunnel = Class(TObject)
   Private
-    tunneltex : Pchar8;                      { Texture }
-    pal : Pchar8;                            { Original palette }
-    lookup : Pint32;                         { Lookup table for lighting }
+    tunneltex : PUint8;                      { Texture }
+    pal : PUint8;                            { Original palette }
+    lookup : PUint32;                         { Lookup table for lighting }
 
     sintab, costab : PSingle;                { Take a guess }
 
@@ -64,19 +57,19 @@ Type
     Procedure load_texture;
 
     Procedure tilt(x, y, z : Integer);              { Rotate relative }
-    Procedure tilt(x, y, z : Integer; abs : char8); { Absolute }
+    Procedure tilt(x, y, z : Integer; abs : Uint8); { Absolute }
 
     Procedure move(dx, dy, dz : Single);            { Relative move }
-    Procedure move(x, y, z : Single; abs : char8);  { Absolute }
+    Procedure move(x, y, z : Single; abs : Uint8);  { Absolute }
 
     Procedure movelight(dx, dy, dz : Single);
-    Procedure movelight(x, y, z : Single; abs : char8);
+    Procedure movelight(x, y, z : Single; abs : Uint8);
 
     Procedure locklight(lock : Boolean);    { Make the light follow the viewer }
 
     Procedure interpolate;                  { Raytracing }
 
-    Procedure draw(dest : Pint32);          { Draw the finished tunnel }
+    Procedure draw(dest : PUint32);          { Draw the finished tunnel }
   End;
 
 { VECTOR ROUTINES }
@@ -214,8 +207,8 @@ Begin
   l_array := GetMem(64 * 26 * SizeOf(Integer));
   norms := GetMem(64 * 26 * 3 * SizeOf(Single));
 
-  lookup := GetMem(65 * 256 * SizeOf(int32));
-  pal := GetMem(768 * SizeOf(char8));
+  lookup := GetMem(65 * 256 * SizeOf(Uint32));
+  pal := GetMem(768 * SizeOf(Uint8));
 
   For i := 0 To 1023 Do
   Begin
@@ -279,9 +272,9 @@ Procedure TRayTunnel.load_texture;
 
 Var
   texfile : File;
-  tmp : Pchar8;
-  i, j : int32;
-  r, g, b : int32;
+  tmp : PUint8;
+  i, j : Uint32;
+  r, g, b : Uint32;
   newoffs : Integer;
 
 Begin
@@ -420,13 +413,13 @@ Begin
   End;
 End;
 
-Procedure TRayTunnel.draw(dest : Pint32);
+Procedure TRayTunnel.draw(dest : PUint32);
 
 Var
   x, y, lu, lv, ru, rv, liu, liv, riu, riv : Integer;
   iu, iv, i, j, ll, rl, lil, ril, l, il : Integer;
   iadr, adr, til_u, til_v, til_iu, til_iv : DWord;
-  bla : char8;
+  bla : Uint8;
 
 Begin
   For j := 0 To 24 Do
@@ -499,7 +492,7 @@ Begin
   za := (za + z) And $3FF;
 End;
 
-Procedure TRayTunnel.tilt(x, y, z : Integer; abs : char8);
+Procedure TRayTunnel.tilt(x, y, z : Integer; abs : Uint8);
 
 Begin
   xa := x And $3FF;
@@ -516,7 +509,7 @@ Begin
   pos[2] := pos[2] + dz;
 End;
 
-Procedure TRayTunnel.move(x, y, z : Single; abs : char8);
+Procedure TRayTunnel.move(x, y, z : Single; abs : Uint8);
 
 Begin
   pos[0] := x;
@@ -533,7 +526,7 @@ Begin
   light[2] := light[2] + dz;
 End;
 
-Procedure TRayTunnel.movelight(x, y, z : Single; abs : char8);
+Procedure TRayTunnel.movelight(x, y, z : Single; abs : Uint8);
 
 Begin
   light[0] := x;
@@ -555,7 +548,7 @@ Var
   tunnel : TRayTunnel;
   posz, phase_x, phase_y : Single;
   angle_x, angle_y : Integer;
-  buffer : Pint32;
+  buffer : PUint32;
 
 Begin
   format := Nil;

packages/extra/ptc/errord.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -21,16 +21,15 @@
 Type
   TPTCError=Class(TObject)
   Private
-    Procedure defaults;
-    Fmessage : String;
+    FMessage : String;
   Public
     Constructor Create;
-    Constructor Create(Const _message : String);
-    Constructor Create(Const _message : String; Const error : TPTCError);
-    Constructor Create(Const error : TPTCError);
+    Constructor Create(Const AMessage : String);
+    Constructor Create(Const AMessage : String; Const AError : TPTCError);
+    Constructor Create(Const AError : TPTCError);
     Destructor Destroy; Override;
-    Procedure Assign(Const error : TPTCError);
-    Function Equals(Const error : TPTCError) : Boolean;
-    Procedure report;
-    Function message : String;
+    Procedure Assign(Const AError : TPTCError);
+    Function Equals(Const AError : TPTCError) : Boolean;
+    Procedure Report;
+    Property Message : String read FMessage;
   End;

packages/extra/ptc/errori.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -18,37 +18,30 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-Procedure TPTCError.defaults;
-
-Begin
-  Fmessage := '';
-End;
-
 Constructor TPTCError.Create;
 
 Begin
-  defaults;
+  FMessage := '';
 End;
 
-Constructor TPTCError.Create(Const _message : String);
+Constructor TPTCError.Create(Const AMessage : String);
 
 Begin
-  Fmessage := _message;
+  FMessage := AMessage;
   LOG('error', Self);
 End;
 
-Constructor TPTCError.Create(Const _message : String; Const error : TPTCError);
+Constructor TPTCError.Create(Const AMessage : String; Const AError : TPTCError);
 
 Begin
-  Fmessage := _message + #13 + #10 + error.Fmessage;
+  FMessage := AMessage + #10 + AError.FMessage;
   LOG('composite error', Self);
 End;
 
-Constructor TPTCError.Create(Const error : TPTCError);
+Constructor TPTCError.Create(Const AError : TPTCError);
 
 Begin
-  defaults;
-  ASSign(error);
+  FMessage := AError.FMessage;
 End;
 
 Destructor TPTCError.Destroy;
@@ -57,49 +50,51 @@ Begin
   Inherited Destroy;
 End;
 
-Procedure TPTCError.Assign(Const error : TPTCError);
+Procedure TPTCError.Assign(Const AError : TPTCError);
 
 Begin
-  If Self = error Then
-    Raise TPTCError.Create('self assignment is not allowed');
-  Fmessage := error.Fmessage;
+  FMessage := AError.FMessage;
 End;
 
-Function TPTCError.Equals(Const error : TPTCError) : Boolean;
+Function TPTCError.Equals(Const AError : TPTCError) : Boolean;
 
 Begin
-  Equals := (Fmessage = error.Fmessage);
+  Equals := (FMessage = AError.FMessage);
 End;
 
-Procedure TPTCError.report;
+Procedure TPTCError.Report;
+
+{$IFDEF Win32}
+Var
+  txt : AnsiString;
+{$ENDIF Win32}
 
-{$IFDEF WIN32}
+{$IFDEF WinCE}
 Var
-  txt : ShortString;
-{$ENDIF WIN32}
+  txt : WideString;
+{$ENDIF WinCE}
 
 Begin
   LOG('error report', Self);
   {$IFDEF GO32V2}
   RestoreTextMode;
-  Writeln(stderr, Fmessage);
+  Writeln(stderr, 'error: ', FMessage);
   {$ENDIF GO32V2}
 
-  {$IFDEF WIN32}
+  {$IFDEF Win32}
   Win32Cursor_resurrect;
-  txt := Fmessage + #0;
-  MessageBox(0, @txt[1], 'Error', MB_OK Or MB_ICONERROR Or MB_SETFOREGROUND Or MB_TOPMOST);
-  {$ENDIF WIN32}
+  txt := FMessage;
+  MessageBox(0, PChar(txt), 'Error', MB_OK Or MB_ICONERROR Or MB_SETFOREGROUND Or MB_TOPMOST);
+  {$ENDIF Win32}
+
+  {$IFDEF WinCE}
+  txt := FMessage;
+  MessageBox(0, PWideChar(txt), 'Error', MB_OK Or MB_ICONERROR Or MB_SETFOREGROUND Or MB_TOPMOST);
+  {$ENDIF WinCE}
 
   {$IFDEF UNIX}
-  Writeln(stderr, 'error: ', Fmessage);
+  Writeln(stderr, 'error: ', FMessage);
   {$ENDIF UNIX}
 
   Halt(1);
 End;
-
-Function TPTCError.message : String;
-
-Begin
-  message := Fmessage;
-End;

packages/extra/ptc/eventd.inc

@@ -0,0 +1,38 @@
+{
+    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 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.
+
+    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
+  TPTCEventType = (PTCKeyEvent, PTCMouseEvent{, PTCExposeEvent});
+  TPTCEventMask = Set Of TPTCEventType;
+  TPTCEvent = Class(TObject)
+  Protected
+    Function GetType : TPTCEventType; Virtual; Abstract;
+  Public
+    Property EventType : TPTCEventType Read GetType;
+  End;
+
+Const
+  PTCAnyEvent : TPTCEventMask = [PTCKeyEvent, PTCMouseEvent{, PTCExposeEvent}];
+
+{Type
+  TPTCExposeEvent = Class(TPTCEvent)
+  Protected
+    Function GetType : TPTCEventType; Override;
+  End;}

packages/extra/ptc/eventi.inc

@@ -0,0 +1,141 @@
+{
+    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 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.
+
+    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
+}
+
+{Function TPTCExposeEvent.GetType : TPTCEventType;
+
+Begin
+  Result := PTCExposeEvent;
+End;}
+
+Type
+  PEventLinkedList = ^TEventLinkedList;
+  TEventLinkedList = Record
+    Event : TPTCEvent;
+    Next : PEventLinkedList;
+  End;
+  TEventQueue = Class(TObject)
+  Private
+    FHead, FTail : PEventLinkedList;
+  Public
+    Constructor Create;
+    Destructor Destroy; Override;
+    Procedure AddEvent(event : TPTCEvent);
+    Function PeekEvent(Const EventMask : TPTCEventMask) : TPTCEvent;
+    Function NextEvent(Const EventMask : TPTCEventMask) : TPTCEvent;
+  End;
+
+Constructor TEventQueue.Create;
+
+Begin
+  FHead := Nil;
+  FTail := Nil;
+End;
+
+Destructor TEventQueue.Destroy;
+
+Var
+  p, pnext : PEventLinkedList;
+
+Begin
+  p := FHead;
+  While p <> Nil Do
+  Begin
+    FreeAndNil(p^.Event);
+    pnext := p^.Next;
+    Dispose(p);
+    p := pnext;
+  End;
+  Inherited Destroy;
+End;
+
+Procedure TEventQueue.AddEvent(event : TPTCEvent);
+
+Var
+  tmp : PEventLinkedList;
+
+Begin
+  New(tmp);
+  FillChar(tmp^, SizeOf(tmp^), 0);
+  tmp^.Next := Nil;
+  tmp^.Event := event;
+
+  If FTail <> Nil Then
+  Begin
+    FTail^.Next := tmp;
+    FTail := tmp;
+  End
+  Else
+  Begin { FTail = Nil }
+    FHead := tmp;
+    FTail := tmp;
+  End;
+End;
+
+Function TEventQueue.PeekEvent(Const EventMask : TPTCEventMask) : TPTCEvent;
+
+Var
+  p : PEventLinkedList;
+
+Begin
+  p := FHead;
+  While p <> Nil Do
+  Begin
+    If p^.Event.EventType In EventMask Then
+    Begin
+      Result := p^.Event;
+      Exit;
+    End;
+    p := p^.Next;
+  End;
+
+  Result := Nil;
+End;
+
+Function TEventQueue.NextEvent(Const EventMask : TPTCEventMask) : TPTCEvent;
+
+Var
+  prev, p : PEventLinkedList;
+
+Begin
+  prev := Nil;
+  p := FHead;
+  While p <> Nil Do
+  Begin
+    If p^.Event.EventType In EventMask Then
+    Begin
+      Result := p^.Event;
+
+      { delete the element from the linked list }
+      If prev <> Nil Then
+        prev^.Next := p^.Next
+      Else
+        FHead := p^.Next;
+      If p^.Next = Nil Then
+        FTail := prev;
+      Dispose(p);
+
+      Exit;
+    End;
+    prev := p;
+    p := p^.Next;
+  End;
+
+  Result := Nil;
+End;

packages/extra/ptc/formatd.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -21,22 +21,25 @@
 Type
   TPTCFormat=Class(TObject)
   Private
-    Fformat : THermesFormat;
+    FFormat : THermesFormat;
+    Function GetDirect : Boolean;
+    Function GetBytes : Integer;
   Public
     Constructor Create;
-    Constructor Create(_bits : Integer);
-    Constructor Create(_bits : Integer; _r, _g, _b : int32);
-    Constructor Create(_bits : Integer; _r, _g, _b, _a : int32);
+    Constructor Create(ABits : Integer);
+    Constructor Create(ABits : Integer;
+                       ARedMask, AGreenMask, ABlueMask : Uint32;
+                       AAlphaMask : Uint32 = 0);
     Constructor Create(Const format : TPTCFormat);
     Destructor Destroy; Override;
     Procedure Assign(Const format : TPTCFormat);
     Function Equals(Const format : TPTCFormat) : Boolean;
-    Property r : int32 read Fformat.r;
-    Property g : int32 read Fformat.g;
-    Property b : int32 read Fformat.b;
-    Property a : int32 read Fformat.a;
-    Property bits : Integer read Fformat.bits;
-    Property indexed : Boolean read Fformat.indexed;
-    Function direct : Boolean;
-    Function bytes : Integer;
+    Property R : Uint32 read FFormat.r;
+    Property G : Uint32 read FFormat.g;
+    Property B : Uint32 read FFormat.b;
+    Property A : Uint32 read FFormat.a;
+    Property Bits : Integer read FFormat.bits;
+    Property Indexed : Boolean read FFormat.indexed;
+    Property Direct : Boolean read GetDirect;
+    Property Bytes : Integer read GetBytes;
   End;

packages/extra/ptc/formati.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -22,72 +22,54 @@ Constructor TPTCFormat.Create;
 
 Begin
   { defaults }
-  Fformat.r := 0;
-  Fformat.g := 0;
-  Fformat.b := 0;
-  Fformat.a := 0;
-  Fformat.bits := 0;
-  Fformat.indexed := False;
+  FFormat.r := 0;
+  FFormat.g := 0;
+  FFormat.b := 0;
+  FFormat.a := 0;
+  FFormat.bits := 0;
+  FFormat.indexed := False;
 
   { initialize hermes }
   If Not Hermes_Init Then
     Raise TPTCError.Create('could not initialize hermes');
 End;
 
-Constructor TPTCFormat.Create(_bits : Integer);
+Constructor TPTCFormat.Create(ABits : Integer);
 
 Begin
   { check bits per pixel }
-  If _bits <> 8 Then
+  If ABits <> 8 Then
     Raise TPTCError.Create('unsupported bits per pixel');
 
   { indexed color }
-  Fformat.r := 0;
-  Fformat.g := 0;
-  Fformat.b := 0;
-  Fformat.a := 0;
-  Fformat.bits := _bits;
-  Fformat.indexed := True;
+  FFormat.r := 0;
+  FFormat.g := 0;
+  FFormat.b := 0;
+  FFormat.a := 0;
+  FFormat.bits := ABits;
+  FFormat.indexed := True;
 
   { initialize hermes }
   If Not Hermes_Init Then
     Raise TPTCError.Create('could not initialize hermes');
 End;
 
-Constructor TPTCFormat.Create(_bits : Integer; _r, _g, _b, _a : int32);
+Constructor TPTCFormat.Create(ABits : Integer;
+                              ARedMask, AGreenMask, ABlueMask : Uint32;
+                              AAlphaMask : Uint32 = 0);
 
 Begin
   { check bits per pixel }
-  If ((_bits And 7) <> 0) Or (_bits <= 0) Or (_bits > 32) Then
+  If ((ABits And 7) <> 0) Or (ABits <= 0) Or (ABits > 32) Then
     Raise TPTCError.Create('unsupported bits per pixel');
 
   { direct color }
-  Fformat.r := _r;
-  Fformat.g := _g;
-  Fformat.b := _b;
-  Fformat.a := _a;
-  Fformat.bits := _bits;
-  Fformat.indexed := False;
-
-  { initialize hermes }
-  If Not Hermes_Init Then
-    Raise TPTCError.Create('could not initialize hermes');
-End;
-
-Constructor TPTCFormat.Create(_bits : Integer; _r, _g, _b : int32);
-
-Begin
-  { check bits per pixel }
-  If ((_bits And 7) <> 0) Or (_bits <= 0) Or (_bits > 32) Then
-    Raise TPTCError.Create('unsupported bits per pixel');
-
-  { direct color }
-  Fformat.r := _r;
-  Fformat.g := _g;
-  Fformat.b := _b;
-  Fformat.a := 0;
-  Fformat.bits := _bits;
-  Fformat.indexed := False;
+  FFormat.r := ARedMask;
+  FFormat.g := AGreenMask;
+  FFormat.b := ABlueMask;
+  FFormat.a := AAlphaMask;
+  FFormat.bits := ABits;
+  FFormat.indexed := False;
 
   { initialize hermes }
   If Not Hermes_Init Then
@@ -101,9 +83,10 @@ Begin
   If Not Hermes_Init Then
     Raise TPTCError.Create('could not initialize hermes');
 
-  Hermes_FormatCopy(@format.Fformat, @Fformat)
+  Hermes_FormatCopy(@format.FFormat, @FFormat)
 End;
 
+{$INFO TODO: check what happens if Hermes_Init blows up in the constructor...}
 Destructor TPTCFormat.Destroy;
 
 Begin
@@ -115,24 +98,24 @@ Procedure TPTCFormat.Assign(Const format : TPTCFormat);
 
 Begin
   If Self = format Then
-    Raise TPTCError.Create('self assignment is not allowed');
-  Hermes_FormatCopy(@format.Fformat, @Fformat)
+    Exit;
+  Hermes_FormatCopy(@format.Fformat, @Fformat);
 End;
 
 Function TPTCFormat.Equals(Const format : TPTCFormat) : Boolean;
 
 Begin
-  Equals := Hermes_FormatEquals(@format.Fformat, @Fformat);
+  Result := Hermes_FormatEquals(@format.FFormat, @FFormat);
 End;
 
-Function TPTCFormat.direct : Boolean;
+Function TPTCFormat.GetDirect : Boolean;
 
 Begin
-  direct := Not Fformat.indexed;
+  Result := Not FFormat.indexed;
 End;
 
-Function TPTCFormat.bytes : Integer;
+Function TPTCFormat.GetBytes : Integer;
 
 Begin
-  bytes := Fformat.bits Shr 3;
+  Result := FFormat.bits Shr 3;
 End;

packages/extra/ptc/keyd.inc

@@ -19,7 +19,7 @@
 }
 
 Type
-  TPTCKey=Class(TObject)
+  TPTCKeyEvent=Class(TPTCEvent)
   Private
     m_code : Integer;
     m_unicode : Integer;
@@ -29,6 +29,8 @@ Type
     m_press : Boolean;
     
     Function GetRelease : Boolean;
+  Protected
+    Function GetType : TPTCEventType; Override;
   Public
     Constructor Create;
     Constructor Create(_code : Integer);
@@ -40,10 +42,10 @@ Type
                        _alt, _shift, _control : Boolean);
     Constructor Create(_code, _unicode : Integer;
                        _alt, _shift, _control, _press : Boolean);
-    Constructor Create(Const key : TPTCKey);
+    Constructor Create(Const key : TPTCKeyEvent);
     Destructor Destroy; Override;
-    Procedure Assign(Const key : TPTCKey);
-    Function Equals(Const key : TPTCKey) : Boolean;
+    Procedure Assign(Const key : TPTCKeyEvent);
+    Function Equals(Const key : TPTCKeyEvent) : Boolean;
     Property code : Integer read m_code;
     Property unicode : Integer read m_unicode;
     Property alt : Boolean read m_alt;

packages/extra/ptc/keyeventd.inc

@@ -0,0 +1,166 @@
+{
+    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 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.
+
+    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
+  TPTCKeyEvent=Class(TPTCEvent)
+  Private
+    FCode : Integer;
+    FUnicode : Integer;
+    FAlt : Boolean;
+    FShift : Boolean;
+    FControl : Boolean;
+    FPress : Boolean;
+
+    Function GetRelease : Boolean;
+  Protected
+    Function GetType : TPTCEventType; Override;
+  Public
+    Constructor Create;
+    Constructor Create(ACode : Integer);
+    Constructor Create(ACode, AUnicode : Integer);
+    Constructor Create(ACode, AUnicode : Integer; APress : Boolean);
+    Constructor Create(ACode : Integer; AAlt, AShift, AControl : Boolean);
+    Constructor Create(ACode : Integer; AAlt, AShift, AControl, APress : Boolean);
+    Constructor Create(ACode, AUnicode : Integer;
+                       AAlt, AShift, AControl : Boolean);
+    Constructor Create(ACode, AUnicode : Integer;
+                       AAlt, AShift, AControl, APress : Boolean);
+    Constructor Create(Const AKey : TPTCKeyEvent);
+    Procedure Assign(Const AKey : TPTCKeyEvent);
+    Function Equals(Const AKey : TPTCKeyEvent) : Boolean;
+    Property Code : Integer read FCode;
+    Property Unicode : Integer read FUnicode;
+    Property Alt : Boolean read FAlt;
+    Property Shift : Boolean read FShift;
+    Property Control : Boolean read FControl;
+    Property Press : Boolean read FPress;
+    Property Release : Boolean read GetRelease;
+  End;
+
+Const
+  PTCKEY_UNDEFINED    = $00;
+  PTCKEY_CANCEL       = $03;
+  PTCKEY_BACKSPACE    = $08; {'\b'}
+  PTCKEY_TAB          = $09; {'\t'}
+  PTCKEY_ENTER        = $0A; {'\n'}
+  PTCKEY_CLEAR        = $0C;
+  PTCKEY_SHIFT        = $10;
+  PTCKEY_CONTROL      = $11;
+  PTCKEY_ALT          = $12;
+  PTCKEY_PAUSE        = $13;
+  PTCKEY_CAPSLOCK     = $14;
+  PTCKEY_KANA         = $15;
+  PTCKEY_FINAL        = $18;
+  PTCKEY_KANJI        = $19;
+  PTCKEY_ESCAPE       = $1B;
+  PTCKEY_CONVERT      = $1C;
+  PTCKEY_NONCONVERT   = $1D;
+  PTCKEY_ACCEPT       = $1E;
+  PTCKEY_MODECHANGE   = $1F;
+  PTCKEY_SPACE        = $20;
+  PTCKEY_PAGEUP       = $21;
+  PTCKEY_PAGEDOWN     = $22;
+  PTCKEY_END          = $23;
+  PTCKEY_HOME         = $24;
+  PTCKEY_LEFT         = $25;
+  PTCKEY_UP           = $26;
+  PTCKEY_RIGHT        = $27;
+  PTCKEY_DOWN         = $28;
+  PTCKEY_COMMA        = $2C; {','}
+  PTCKEY_PERIOD       = $2E; {'.'}
+  PTCKEY_SLASH        = $2F; {'/'}
+  PTCKEY_ZERO         = $30;
+  PTCKEY_ONE          = $31;
+  PTCKEY_TWO          = $32;
+  PTCKEY_THREE        = $33;
+  PTCKEY_FOUR         = $34;
+  PTCKEY_FIVE         = $35;
+  PTCKEY_SIX          = $36;
+  PTCKEY_SEVEN        = $37;
+  PTCKEY_EIGHT        = $38;
+  PTCKEY_NINE         = $39;
+  PTCKEY_SEMICOLON    = $3B; {';'}
+  PTCKEY_EQUALS       = $3D; {'='}
+  PTCKEY_A            = $41;
+  PTCKEY_B            = $42;
+  PTCKEY_C            = $43;
+  PTCKEY_D            = $44;
+  PTCKEY_E            = $45;
+  PTCKEY_F            = $46;
+  PTCKEY_G            = $47;
+  PTCKEY_H            = $48;
+  PTCKEY_I            = $49;
+  PTCKEY_J            = $4A;
+  PTCKEY_K            = $4B;
+  PTCKEY_L            = $4C;
+  PTCKEY_M            = $4D;
+  PTCKEY_N            = $4E;
+  PTCKEY_O            = $4F;
+  PTCKEY_P            = $50;
+  PTCKEY_Q            = $51;
+  PTCKEY_R            = $52;
+  PTCKEY_S            = $53;
+  PTCKEY_T            = $54;
+  PTCKEY_U            = $55;
+  PTCKEY_V            = $56;
+  PTCKEY_W            = $57;
+  PTCKEY_X            = $58;
+  PTCKEY_Y            = $59;
+  PTCKEY_Z            = $5A;
+  PTCKEY_OPENBRACKET  = $5B; {'['}
+  PTCKEY_BACKSLASH    = $5C; {'\'}
+  PTCKEY_CLOSEBRACKET = $5D; {']'}
+  PTCKEY_NUMPAD0      = $60;
+  PTCKEY_NUMPAD1      = $61;
+  PTCKEY_NUMPAD2      = $62;
+  PTCKEY_NUMPAD3      = $63;
+  PTCKEY_NUMPAD4      = $64;
+  PTCKEY_NUMPAD5      = $65;
+  PTCKEY_NUMPAD6      = $66;
+  PTCKEY_NUMPAD7      = $67;
+  PTCKEY_NUMPAD8      = $68;
+  PTCKEY_NUMPAD9      = $69;
+  PTCKEY_MULTIPLY     = $6A; {numpad '*'}
+  PTCKEY_ADD          = $6B; {numpad '+'}
+  PTCKEY_SEPARATOR    = $6C;
+  PTCKEY_SUBTRACT     = $6D; {numpad '-'}
+  PTCKEY_DECIMAL      = $6E; {numpad '.'}
+  PTCKEY_DIVIDE       = $6F; {numpad '/'}
+  PTCKEY_F1           = $70;
+  PTCKEY_F2           = $71;
+  PTCKEY_F3           = $72;
+  PTCKEY_F4           = $73;
+  PTCKEY_F5           = $74;
+  PTCKEY_F6           = $75;
+  PTCKEY_F7           = $76;
+  PTCKEY_F8           = $77;
+  PTCKEY_F9           = $78;
+  PTCKEY_F10          = $79;
+  PTCKEY_F11          = $7A;
+  PTCKEY_F12          = $7B;
+  PTCKEY_DELETE       = $7F;
+  PTCKEY_NUMLOCK      = $90;
+  PTCKEY_SCROLLLOCK   = $91;
+  PTCKEY_PRINTSCREEN  = $9A;
+  PTCKEY_INSERT       = $9B;
+  PTCKEY_HELP         = $9C;
+  PTCKEY_META         = $9D;
+  PTCKEY_BACKQUOTE    = $C0;
+  PTCKEY_QUOTE        = $DE;

packages/extra/ptc/keyeventi.inc

@@ -0,0 +1,153 @@
+{
+    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 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.
+
+    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
+}
+
+Function TPTCKeyEvent.GetType : TPTCEventType;
+
+Begin
+  Result := PTCKeyEvent;
+End;
+
+Constructor TPTCKeyEvent.Create;
+
+Begin
+  FCode    := Integer(PTCKEY_UNDEFINED);
+  FUnicode := -1;
+  FAlt     := False;
+  FShift   := False;
+  FControl := False;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode : Integer);
+
+Begin
+  FCode    := ACode;
+  FUnicode := -1;
+  FAlt     := False;
+  FShift   := False;
+  FControl := False;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer);
+
+Begin
+  FCode    := ACode;
+  FUnicode := AUnicode;
+  FAlt     := False;
+  FShift   := False;
+  FControl := False;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer; APress : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := AUnicode;
+  FAlt     := False;
+  FShift   := False;
+  FControl := False;
+  FPress   := APress;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode : Integer; AAlt, AShift, AControl : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := -1;
+  FAlt     := AAlt;
+  FShift   := AShift;
+  FControl := AControl;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode : Integer; AAlt, AShift, AControl, APress : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := -1;
+  FAlt     := AAlt;
+  FShift   := AShift;
+  FControl := AControl;
+  FPress   := APress;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer; AAlt, AShift, AControl : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := AUnicode;
+  FAlt     := AAlt;
+  FShift   := AShift;
+  FControl := AControl;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer;
+                                AAlt, AShift, AControl, APress : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := AUnicode;
+  FAlt     := AAlt;
+  FShift   := AShift;
+  FControl := AControl;
+  FPress   := APress;
+End;
+
+Constructor TPTCKeyEvent.Create(Const AKey : TPTCKeyEvent);
+
+Begin
+  FCode    := AKey.Code;
+  FUnicode := AKey.Unicode;
+  FAlt     := AKey.Alt;
+  FShift   := AKey.Shift;
+  FControl := AKey.Control;
+  FPress   := AKey.Press;
+End;
+
+Procedure TPTCKeyEvent.Assign(Const AKey : TPTCKeyEvent);
+
+Begin
+  FCode    := AKey.Code;
+  FUnicode := AKey.Unicode;
+  FAlt     := AKey.Alt;
+  FShift   := AKey.Shift;
+  FControl := AKey.Control;
+  FPress   := AKey.Press;
+End;
+
+Function TPTCKeyEvent.Equals(Const AKey : TPTCKeyEvent) : Boolean;
+
+Begin
+  Result := (FCode    = AKey.FCode) And
+            (FUnicode = AKey.FUnicode) And
+            (FAlt     = AKey.FAlt) And
+            (FShift   = AKey.FShift) And
+            (FControl = AKey.FControl) And
+            (FPress   = AKey.FPress);
+End;
+
+Function TPTCKeyEvent.GetRelease : Boolean;
+
+Begin
+  Result := Not FPress;
+End;

packages/extra/ptc/keyi.inc

@@ -18,7 +18,13 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-Constructor TPTCKey.Create;
+Function TPTCKeyEvent.GetType : TPTCEventType;
+
+Begin
+  Result := PTCKeyEvent;
+End;
+
+Constructor TPTCKeyEvent.Create;
 
 Begin
   m_code := Integer(PTCKEY_UNDEFINED);
@@ -29,7 +35,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code : Integer);
+Constructor TPTCKeyEvent.Create(_code : Integer);
 
 Begin
   m_code := _code;
@@ -40,7 +46,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code, _unicode : Integer);
+Constructor TPTCKeyEvent.Create(_code, _unicode : Integer);
 
 Begin
   m_code := _code;
@@ -51,7 +57,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code, _unicode : Integer; _press : Boolean);
+Constructor TPTCKeyEvent.Create(_code, _unicode : Integer; _press : Boolean);
 
 Begin
   m_code := _code;
@@ -62,7 +68,7 @@ Begin
   m_press := _press;
 End;
 
-Constructor TPTCKey.Create(_code : Integer; _alt, _shift, _control : Boolean);
+Constructor TPTCKeyEvent.Create(_code : Integer; _alt, _shift, _control : Boolean);
 
 Begin
   m_code := _code;
@@ -73,7 +79,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code : Integer; _alt, _shift, _control, _press : Boolean);
+Constructor TPTCKeyEvent.Create(_code : Integer; _alt, _shift, _control, _press : Boolean);
 
 Begin
   m_code := _code;
@@ -84,7 +90,7 @@ Begin
   m_press := _press;
 End;
 
-Constructor TPTCKey.Create(_code, _unicode : Integer; _alt, _shift, _control : Boolean);
+Constructor TPTCKeyEvent.Create(_code, _unicode : Integer; _alt, _shift, _control : Boolean);
 
 Begin
   m_code := _code;
@@ -95,7 +101,7 @@ Begin
   m_press := True;
 End;
 
-Constructor TPTCKey.Create(_code, _unicode : Integer;
+Constructor TPTCKeyEvent.Create(_code, _unicode : Integer;
                            _alt, _shift, _control, _press : Boolean);
 
 Begin
@@ -107,19 +113,19 @@ Begin
   m_press := _press;
 End;
 
-Constructor TPTCKey.Create(Const key : TPTCKey);
+Constructor TPTCKeyEvent.Create(Const key : TPTCKeyEvent);
 
 Begin
   ASSign(key);
 End;
 
-Destructor TPTCKey.Destroy;
+Destructor TPTCKeyEvent.Destroy;
 
 Begin
   Inherited Destroy;
 End;
 
-Procedure TPTCKey.Assign(Const key : TPTCKey);
+Procedure TPTCKeyEvent.Assign(Const key : TPTCKeyEvent);
 
 Begin
   If Self = key Then
@@ -133,7 +139,7 @@ Begin
   m_press := key.press;
 End;
 
-Function TPTCKey.Equals(Const key : TPTCKey) : Boolean;
+Function TPTCKeyEvent.Equals(Const key : TPTCKeyEvent) : Boolean;
 
 Begin
   Equals := (m_code = key.m_code) And (m_unicode = key.m_unicode) And
@@ -141,7 +147,7 @@ Begin
             (m_control = key.m_control) And (m_press = key.m_press);
 End;
 
-Function TPTCKey.GetRelease : Boolean;
+Function TPTCKeyEvent.GetRelease : Boolean;
 
 Begin
   GetRelease := Not m_press;

packages/extra/ptc/log.inc

@@ -18,24 +18,53 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-{$IFDEF PTC_LOGGING}
-
+{$IFNDEF WinCE}
 Const
-  LOG_create : Boolean = True;
-  LOG_enabled : Boolean =
-{$IFDEF DEBUG}
-  True;
-{$ELSE DEBUG}
-  False;
-{$ENDIF DEBUG}
+  LOG_filename = 'ptcpas.log';
+{$ELSE WinCE}
+Function LOG_filename : WideString;
+
+Var
+  RequiredBufferLength : DWord;
+  ReturnedPathLength : DWord;
+  TempPathBuf : PWideChar;
+  dummy : Byte;
+
+Begin
+  RequiredBufferLength := GetTempPathW(0, @dummy);
+  TempPathBuf := GetMem(RequiredBufferLength * SizeOf(WideChar));
+  Try
+    ReturnedPathLength := GetTempPathW(RequiredBufferLength, TempPathBuf);
+
+    If ReturnedPathLength > RequiredBufferLength Then
+    Begin
+      { The temp path length increased between 2 consecutive calls to GetTempPath?! }
+      Result := '';
+      Exit;
+    End;
+
+    Result := TempPathBuf;
+    Result := Result + 'ptcpas.log';
+  Finally
+    FreeMem(TempPathBuf);
+  End;
+End;
+{$ENDIF WinCE}
 
 Var
+  LOG_create : Boolean = True;
+  LOG_enabled : Boolean =
+  {$IFDEF DEBUG}
+    True;
+  {$ELSE DEBUG}
+    False;
+  {$ENDIF DEBUG}
   LOG_file : Text;
 
 Procedure LOG_open;
 
 Begin
-  ASSignFile(LOG_file, 'ptc.log');
+  AssignFile(LOG_file, LOG_filename);
   If LOG_create Then
   Begin
     Rewrite(LOG_file);
@@ -52,7 +81,7 @@ Begin
   CloseFile(LOG_file);
 End;
 
-Procedure LOG(message : String);
+Procedure LOG(Const message : String);
 
 Begin
   If Not LOG_enabled Then
@@ -62,7 +91,7 @@ Begin
   LOG_close;
 End;
 
-Procedure LOG(message : String; data : Boolean);
+Procedure LOG(Const message : String; data : Boolean);
 
 Begin
   If Not LOG_enabled Then
@@ -76,7 +105,37 @@ Begin
   LOG_close;
 End;
 
-Procedure LOG(message : String; data : Integer);
+Procedure LOG(Const message : String; data : Integer);
+
+Begin
+  If Not LOG_enabled Then
+    Exit;
+  LOG_open;
+  Writeln(LOG_file, message, ' = ', data);
+  LOG_close;
+End;
+
+Procedure LOG(Const message : String; data : DWord);
+
+Begin
+  If Not LOG_enabled Then
+    Exit;
+  LOG_open;
+  Writeln(LOG_file, message, ' = ', data);
+  LOG_close;
+End;
+
+Procedure LOG(Const message : String; data : Int64);
+
+Begin
+  If Not LOG_enabled Then
+    Exit;
+  LOG_open;
+  Writeln(LOG_file, message, ' = ', data);
+  LOG_close;
+End;
+
+Procedure LOG(Const message : String; data : QWord);
 
 Begin
   If Not LOG_enabled Then
@@ -86,7 +145,7 @@ Begin
   LOG_close;
 End;
 
-Procedure LOG(message : String; data : Double);
+Procedure LOG(Const message : String; data : Single);
 
 Begin
   If Not LOG_enabled Then
@@ -96,7 +155,7 @@ Begin
   LOG_close;
 End;
 
-Procedure LOG(message : String; data : String);
+Procedure LOG(Const message : String; data : Double);
 
 Begin
   If Not LOG_enabled Then
@@ -106,7 +165,17 @@ Begin
   LOG_close;
 End;
 
-Procedure LOG(message : String; data : TPTCFormat);
+Procedure LOG(Const message : String; Const data : String);
+
+Begin
+  If Not LOG_enabled Then
+    Exit;
+  LOG_open;
+  Writeln(LOG_file, message, ' = ', data);
+  LOG_close;
+End;
+
+Procedure LOG(Const message : String; data : TPTCFormat);
 
 Begin
   If Not LOG_enabled Then
@@ -129,7 +198,7 @@ Begin
   LOG_close;
 End;
 
-Procedure LOG(message : String; data : TPTCError);
+Procedure LOG(Const message : String; data : TPTCError);
 
 Begin
   If Not LOG_enabled Then
@@ -138,7 +207,3 @@ Begin
   Writeln(LOG_file, message, ': ', data.message);
   LOG_close;
 End;
-
-{$ELSE PTC_LOGGING}
-{$DEFINE LOG:=//}
-{$ENDIF PTC_LOGGING}

packages/extra/ptc/moded.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -22,19 +22,19 @@ Type
   PPTCMode=^TPTCMode;
   TPTCMode=Class(TObject)
   Private
-    m_valid : Boolean;
-    m_width : Integer;
-    m_height : Integer;
-    m_format : TPTCFormat;
+    FValid : Boolean;
+    FWidth : Integer;
+    FHeight : Integer;
+    FFormat : TPTCFormat;
   Public
     Constructor Create;
-    Constructor Create(_width, _height : Integer; Const _format : TPTCFormat);
+    Constructor Create(AWidth, AHeight : Integer; Const AFormat : TPTCFormat);
     Constructor Create(Const mode : TPTCMode);
     Destructor Destroy; Override;
     Procedure Assign(Const mode : TPTCMode);
     Function Equals(Const mode : TPTCMode) : Boolean;
-    Property valid : Boolean read m_valid;
-    Property width : Integer read m_width;
-    Property height : Integer read m_height;
-    Property format : TPTCFormat read m_format;
+    Property Valid : Boolean read FValid;
+    Property Width : Integer read FWidth;
+    Property Height : Integer read FHeight;
+    Property Format : TPTCFormat read FFormat;
   End;

packages/extra/ptc/modei.inc

@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
     This library is free software; you can redistribute it and/or
@@ -18,57 +18,57 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+Type
+  TPTCModeDynArray = Array Of TPTCMode;
+
 Constructor TPTCMode.Create;
 
 Begin
-  m_format := Nil;
-  m_format := TPTCFormat.Create;
-  m_valid := False;
-  m_width := 0;
-  m_height := 0;
+  FFormat := TPTCFormat.Create;
+  FWidth := 0;
+  FHeight := 0;
+  FValid := False;
 End;
 
-Constructor TPTCMode.Create(_width, _height : Integer; Const _format : TPTCFormat);
+Constructor TPTCMode.Create(AWidth, AHeight : Integer; Const AFormat : TPTCFormat);
 
 Begin
-  m_format := Nil;
-  m_valid := True;
-  m_width := _width;
-  m_height := _height;
-  m_format := TPTCFormat.Create(_format);
+  FFormat := TPTCFormat.Create(AFormat);
+  FWidth := AWidth;
+  FHeight := AHeight;
+  FValid := True;
 End;
 
 Constructor TPTCMode.Create(Const mode : TPTCMode);
 
 Begin
-  m_format := Nil;
-  m_format := TPTCFormat.Create;
-  ASSign(mode);
+  FFormat := TPTCFormat.Create(mode.FFormat);
+  FWidth := mode.FWidth;
+  FHeight := mode.FHeight;
+  FValid := mode.FValid;
 End;
 
 Destructor TPTCMode.Destroy;
 
 Begin
-  m_format.Free;
+  FFormat.Free;
   Inherited Destroy;
 End;
 
 Procedure TPTCMode.Assign(Const mode : TPTCMode);
 
 Begin
-  If Self = mode Then
-    Raise TPTCError.Create('self assignment is not allowed');
-  m_valid := mode.valid;
-  m_width := mode.width;
-  m_height := mode.height;
-  m_format.ASSign(mode.format);
+  FFormat.Assign(mode.FFormat);
+  FWidth := mode.FWidth;
+  FHeight := mode.FHeight;
+  FValid := mode.FValid;
 End;
 
 Function TPTCMode.Equals(Const mode : TPTCMode) : Boolean;
 
 Begin
-  Equals := (m_valid = mode.m_valid) And
-            (m_width = mode.m_width) And
-            (m_height = mode.m_height) And
-             m_format.Equals(mode.m_format);
+  Result := (FValid = mode.FValid) And
+            (FWidth = mode.FWidth) And
+            (FHeight = mode.FHeight) And
+             FFormat.Equals(mode.FFormat);
 End;

packages/extra/ptc/mouseeventd.inc

@@ -0,0 +1,56 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([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.
+
+    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
+{todo  TPTCMouseCursor = (PTCMouseCursorDefault,
+                     PTCMouseCursorAlwaysVisible,
+                     PTCMouseCursorAlwaysInvisible);}
+  TPTCMouseButton = (PTCMouseButton1, { left mouse button }
+                     PTCMouseButton2, { right mouse button }
+                     PTCMouseButton3, { middle mouse button }
+                     PTCMouseButton4,
+                     PTCMouseButton5);
+  TPTCMouseButtonState = Set Of TPTCMouseButton;
+  TPTCMouseEvent = Class(TPTCEvent)
+  Private
+    FX, FY : Integer;
+    FDeltaX, FDeltaY : Integer;
+    FButtonState : TPTCMouseButtonState;
+  Protected
+    Function GetType : TPTCEventType; Override;
+  Public
+    Constructor Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState);
+    Property X : Integer Read FX;
+    Property Y : Integer Read FY;
+    Property DeltaX : Integer Read FDeltaX;
+    Property DeltaY : Integer Read FDeltaY;
+    Property ButtonState : TPTCMouseButtonState Read FButtonState;
+  End;
+  TPTCMouseButtonEvent = Class(TPTCMouseEvent)
+  Private
+    FPress : Boolean;
+    FButton : TPTCMouseButton;
+    Function GetRelease : Boolean;
+  Public
+    Constructor Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState; APress : Boolean; AButton : TPTCMouseButton);
+    Property Press : Boolean Read FPress;
+    Property Release : Boolean Read GetRelease;
+    Property Button : TPTCMouseButton Read FButton;
+  End;

packages/extra/ptc/mouseeventi.inc

@@ -0,0 +1,53 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([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.
+
+    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
+}
+
+Function TPTCMouseEvent.GetType : TPTCEventType;
+
+Begin
+  Result := PTCMouseEvent;
+End;
+
+Constructor TPTCMouseEvent.Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState);
+
+Begin
+  FX := AX;
+  FY := AY;
+  FDeltaX := ADeltaX;
+  FDeltaY := ADeltaY;
+  FButtonState := AButtonState;
+End;
+
+Constructor TPTCMouseButtonEvent.Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState; APress : Boolean; AButton : TPTCMouseButton);
+
+Begin
+  If APress Xor (AButton In AButtonState) Then
+    Raise TPTCError.Create('Invalid ButtonState');
+
+  Inherited Create(AX, AY, ADeltaX, ADeltaY, AButtonState);
+
+  FPress := APress;
+  FButton := AButton;
+End;
+
+Function TPTCMouseButtonEvent.GetRelease : Boolean;
+
+Begin
+  Result := Not FPress;
+End;

packages/extra/ptc/paletted.inc

@@ -25,16 +25,16 @@ Type
     m_handle : THermesHandle;
   Public
     Constructor Create;
-    Constructor Create(Const _data : Array Of int32);
+    Constructor Create(Const _data : Array Of Uint32);
     Constructor Create(Const palette : TPTCPalette);
     Destructor Destroy; Override;
     Procedure Assign(Const palette : TPTCPalette);
     Function Equals(Const palette : TPTCPalette) : Boolean;
-    Function lock : Pint32;
+    Function lock : PUint32;
     Procedure unlock;
-    Procedure load(Const _data : Array Of int32);
+    Procedure load(Const _data : Array Of Uint32);
     Procedure load(_data : Pointer);
-    Procedure save(Var _data : Array Of int32);
+    Procedure save(Var _data : Array Of Uint32);
     Procedure save(_data : Pointer);
-    Function data : Pint32;
+    Function data : PUint32;
   End;

packages/extra/ptc/palettei.inc

@@ -21,7 +21,7 @@
 Constructor TPTCPalette.Create;
 
 Var
-  zero : Array[0..255] Of int32;
+  zero : Array[0..255] Of Uint32;
 
 Begin
   m_locked := False;
@@ -34,7 +34,7 @@ Begin
   load(zero);
 End;
 
-Constructor TPTCPalette.Create(Const _data : Array Of int32);
+Constructor TPTCPalette.Create(Const _data : Array Of Uint32);
 
 Begin
   m_locked := False;
@@ -55,7 +55,7 @@ Begin
   m_handle := Hermes_PaletteInstance;
   If m_handle = 0 Then
     Raise TPTCError.Create('could not create hermes palette instance');
-  ASSign(palette);
+  Assign(palette);
 End;
 
 Destructor TPTCPalette.Destroy;
@@ -82,7 +82,7 @@ Begin
   Equals := CompareDWord(Hermes_PaletteGet(m_handle)^, Hermes_PaletteGet(palette.m_handle)^, 1024 Div 4) = 0;
 End;
 
-Function TPTCPalette.lock : Pint32;
+Function TPTCPalette.lock : PUint32;
 
 Begin
   If m_locked Then
@@ -99,7 +99,7 @@ Begin
   m_locked := False;
 End;
 
-Procedure TPTCPalette.load(Const _data : Array Of int32);
+Procedure TPTCPalette.load(Const _data : Array Of Uint32);
 
 Begin
   Hermes_PaletteSet(m_handle, @_data);
@@ -111,7 +111,7 @@ Begin
   Hermes_PaletteSet(m_handle, _data);
 End;
 
-Procedure TPTCPalette.save(Var _data : Array Of int32);
+Procedure TPTCPalette.save(Var _data : Array Of Uint32);
 
 Begin
   Move(Hermes_PaletteGet(m_handle)^, _data, 1024);
@@ -123,7 +123,7 @@ Begin
   Move(Hermes_PaletteGet(m_handle)^, _data^, 1024);
 End;
 
-Function TPTCPalette.data : Pint32;
+Function TPTCPalette.data : PUint32;
 
 Begin
   data := Hermes_PaletteGet(m_handle);

packages/extra/ptc/ptc.pp

@@ -1,141 +1,134 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
     Original C++ version by Glenn Fiedler ([email protected])
 
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
+    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.
 
-    This program is distributed in the hope that it will be useful,
+    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.
+    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
 }
 
 {$MODE objfpc}
 {$MACRO ON}
-{$DEFINE PTC_LOGGING}
 {$UNDEF ENABLE_C_API}
 
 {$H+}
 
 {$IFDEF UNIX}
-{$DEFINE HAVE_X11_EXTENSIONS_XSHM}
-{$DEFINE XStringListToTextProperty_notyetimplemented_in_xutil_pp}
+
+  { X11 extensions we want to enable at compile time }
+  {$INCLUDE x11/extensions.inc}
+
+  {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1}
+    {$DEFINE ENABLE_X11_EXTENSION_XF86DGA}
+  {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1}
+  {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2}
+    {$DEFINE ENABLE_X11_EXTENSION_XF86DGA}
+  {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2}
+
 {$ENDIF UNIX}
 
 Unit ptc;
 
 Interface
 
+{$IFNDEF FPDOC}
 Uses
-{$IFDEF WIN32}
-  Windows, DirectDraw,
-{$ENDIF WIN32}
-
-{$IFDEF UNIX}
-  x, xlib, xutil, keysym,
-  xf86vmode, xf86dga,
-  {$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-  xshm, ipc,
-  {$ENDIF HAVE_X11_EXTENSIONS_XSHM}
-{$ENDIF UNIX}
-  {SysUtils,} Hermes;
+  Hermes;
+{$ENDIF FPDOC}
 
 Const
-  PTC_VERSION = 'OpenPTC 1.0';
-  PTC_WIN32_VERSION = 'OpenPTC Win32 1.0.18';
+  PTCPAS_VERSION = 'PTCPas 0.99.7';
 
 Type
-  Pchar8 = ^char8;
-  char8 = Byte;
-  Pshort16 = ^short16;
-  short16 = Word;
-  Pint32 = ^int32;
-  int32 = DWord;
-{$INCLUDE aread.inc}
-{$INCLUDE colord.inc}
-{$INCLUDE formatd.inc}
-{$INCLUDE keyd.inc}
-{$INCLUDE moded.inc}
-{$INCLUDE paletted.inc}
-{$INCLUDE cleard.inc}
-{$INCLUDE copyd.inc}
-{$INCLUDE clipperd.inc}
-{$INCLUDE basesurd.inc}
-{$INCLUDE surfaced.inc}
-{$INCLUDE basecond.inc}
-{$INCLUDE consoled.inc}
-{$INCLUDE errord.inc}
-{$INCLUDE timerd.inc}
+  PUint8  = ^Uint8;
+  PUint16 = ^Uint16;
+  PUint32 = ^Uint32;
+  PUint64 = ^Uint64;
+  PSint8  = ^Sint8;
+  PSint16 = ^Sint16;
+  PSint32 = ^Sint32;
+  PSint64 = ^Sint64;
+  Uint8  = Byte;
+  Uint16 = Word;
+  Uint32 = DWord;
+  Uint64 = QWord;
+  Sint8  = ShortInt;
+  Sint16 = SmallInt;
+  Sint32 = LongInt;
+  Sint64 = Int64;
+
+{$INCLUDE coreinterface.inc}
+
+{$IFNDEF FPDOC}
 
 {$IFDEF ENABLE_C_API}
-{$INCLUDE c_api/index.inc}
-{$INCLUDE c_api/errord.inc}
-{$INCLUDE c_api/exceptd.inc}
-{$INCLUDE c_api/aread.inc}
-{$INCLUDE c_api/colord.inc}
-{$INCLUDE c_api/cleard.inc}
-{$INCLUDE c_api/clipperd.inc}
-{$INCLUDE c_api/copyd.inc}
-{$INCLUDE c_api/keyd.inc}
-{$INCLUDE c_api/formatd.inc}
-{$INCLUDE c_api/paletted.inc}
-{$INCLUDE c_api/surfaced.inc}
-{$INCLUDE c_api/consoled.inc}
-{$INCLUDE c_api/moded.inc}
-{$INCLUDE c_api/timerd.inc}
+{$INCLUDE c_api/index.pp}
+{$INCLUDE c_api/errord.pp}
+{$INCLUDE c_api/exceptd.pp}
+{$INCLUDE c_api/aread.pp}
+{$INCLUDE c_api/colord.pp}
+{$INCLUDE c_api/cleard.pp}
+{$INCLUDE c_api/clipperd.pp}
+{$INCLUDE c_api/copyd.pp}
+{$INCLUDE c_api/keyd.pp}
+{$INCLUDE c_api/formatd.pp}
+{$INCLUDE c_api/paletted.pp}
+{$INCLUDE c_api/surfaced.pp}
+{$INCLUDE c_api/consoled.pp}
+{$INCLUDE c_api/moded.pp}
+{$INCLUDE c_api/timerd.pp}
 {$ENDIF ENABLE_C_API}
 
-{$IFDEF GO32V2}
-{$INCLUDE dos/base/kbdd.inc}
-{$INCLUDE dos/vesa/consoled.inc}
-{$INCLUDE dos/fakemode/consoled.inc}
-{$INCLUDE dos/textfx2/consoled.inc}
-{$INCLUDE dos/cga/consoled.inc}
-{$WARNING should be moved in the implementation part}
-{$ENDIF GO32V2}
-
-{$IFDEF WIN32}
-{$INCLUDE win32/base/monitord.inc}
-{$INCLUDE win32/base/eventd.inc}
-{$INCLUDE win32/base/windowd.inc}
-{$INCLUDE win32/base/hookd.inc}
-{$INCLUDE win32/base/kbdd.inc}
-
-{$INCLUDE win32/directx/hookd.inc}
-{$INCLUDE win32/directx/libraryd.inc}
-{$INCLUDE win32/directx/displayd.inc}
-{$INCLUDE win32/directx/primaryd.inc}
-{$INCLUDE win32/directx/consoled.inc}
-{$WARNING should be moved in the implementation part}
-{$ENDIF WIN32}
-
-{$IFDEF UNIX}
-{$INCLUDE x11/imaged.inc}
-{$INCLUDE x11/displayd.inc}
-{$INCLUDE x11/windowd.inc}
-{$INCLUDE x11/dgadispd.inc}
-{$INCLUDE x11/consoled.inc}
-{$WARNING should be moved in the implementation part}
-{$ENDIF UNIX}
+{$ENDIF FPDOC}
 
 Implementation
 
 {$IFDEF GO32V2}
 Uses
-  textfx2, vesa, vga, cga, timeunit, crt, go32;
+  textfx2, vesa, vga, cga, timeunit, crt, go32, mouse33h;
 {$ENDIF GO32V2}
 
-{$IFDEF WIN32}
-{Uses
-  Windows, DirectDraw;}
-{$ENDIF WIN32}
+{$IFDEF Win32}
+Uses
+  Windows, p_ddraw;
+{$ENDIF Win32}
+
+{$IFDEF WinCE}
+Uses
+  Windows, p_gx;
+{$ENDIF WinCE}
 
 {$IFDEF UNIX}
 Uses
-  BaseUnix, Unix;
+  BaseUnix, Unix, ctypes, x, xlib, xutil, xatom, keysym
+  {$IFDEF ENABLE_X11_EXTENSION_XRANDR}
+  , xrandr
+  {$ENDIF ENABLE_X11_EXTENSION_XRANDR}
+  {$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE}
+  , xf86vmode
+  {$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE}
+  {$IFDEF ENABLE_X11_EXTENSION_XF86DGA}
+  , xf86dga
+  {$ENDIF ENABLE_X11_EXTENSION_XF86DGA}
+  {$IFDEF ENABLE_X11_EXTENSION_XSHM}
+  , xshm, ipc
+  {$ENDIF ENABLE_X11_EXTENSION_XSHM}
+  ;
 {$ENDIF UNIX}
 
+{ this little procedure is not a good reason to include the whole sysutils
+  unit :) }
 Procedure FreeAndNil(Var q);
 
 Var
@@ -159,76 +152,92 @@ Begin
     FreeMem(tmp);
 End;
 
+Function IntToStr(Value : Integer) : String;
+
+Begin
+  System.Str(Value, Result);
+End;
+
+Function IntToStr(Value : Int64) : String;
+
+Begin
+  System.Str(Value, Result);
+End;
+
+Function IntToStr(Value : QWord) : String;
+Begin
+  System.Str(Value, Result);
+End;
+
 {$INCLUDE log.inc}
 
 {$IFDEF WIN32}
 {$INCLUDE win32/base/cursor.inc}
 {$ENDIF WIN32}
 
-{$INCLUDE errori.inc}
-{$INCLUDE areai.inc}
-{$INCLUDE colori.inc}
-{$INCLUDE formati.inc}
-{$INCLUDE keyi.inc}
-{$INCLUDE modei.inc}
-{$INCLUDE palettei.inc}
-{$INCLUDE cleari.inc}
-{$INCLUDE copyi.inc}
-{$INCLUDE clipperi.inc}
-{$INCLUDE basesuri.inc}
-{$INCLUDE baseconi.inc}
-{$INCLUDE surfacei.inc}
-{$INCLUDE timeri.inc}
+{$INCLUDE coreimplementation.inc}
 
 {$IFDEF GO32V2}
-{$INCLUDE dos/base/kbd.inc}
-{$INCLUDE dos/vesa/console.inc}
-{$INCLUDE dos/fakemode/console.inc}
-{$INCLUDE dos/textfx2/console.inc}
-{$INCLUDE dos/cga/console.inc}
+{$INCLUDE dos/includes.inc}
 {$ENDIF GO32V2}
 
-{$IFDEF WIN32}
+{$IFDEF Win32}
+{$INCLUDE win32/base/monitord.inc}
+{$INCLUDE win32/base/eventd.inc}
+{$INCLUDE win32/base/windowd.inc}
+{$INCLUDE win32/base/hookd.inc}
+{$INCLUDE win32/base/kbdd.inc}
+{$INCLUDE win32/base/moused.inc}
+{$INCLUDE win32/directx/hookd.inc}
+{$INCLUDE win32/directx/libraryd.inc}
+{$INCLUDE win32/directx/displayd.inc}
+{$INCLUDE win32/directx/primaryd.inc}
+{$INCLUDE win32/directx/directxconsoled.inc}
+{$INCLUDE win32/gdi/win32dibd.inc}
+{$INCLUDE win32/gdi/gdiconsoled.inc}
+
 {$INCLUDE win32/base/monitor.inc}
 {$INCLUDE win32/base/event.inc}
 {$INCLUDE win32/base/window.inc}
 {$INCLUDE win32/base/hook.inc}
 {$INCLUDE win32/base/kbd.inc}
+{$INCLUDE win32/base/mousei.inc}
 {$INCLUDE win32/directx/check.inc}
-{$INCLUDE win32/directx/translte.inc}
+{$INCLUDE win32/directx/translate.inc}
 {$INCLUDE win32/directx/hook.inc}
 {$INCLUDE win32/directx/library.inc}
 {$INCLUDE win32/directx/display.inc}
 {$INCLUDE win32/directx/primary.inc}
-{$INCLUDE win32/directx/console.inc}
-{$ENDIF WIN32}
+{$INCLUDE win32/directx/directxconsolei.inc}
+{$INCLUDE win32/gdi/win32dibi.inc}
+{$INCLUDE win32/gdi/gdiconsolei.inc}
+{$ENDIF Win32}
+
+{$IFDEF WinCE}
+{$INCLUDE wince/includes.inc}
+{$ENDIF WinCE}
 
 {$IFDEF UNIX}
-{$INCLUDE x11/check.inc}
-{$INCLUDE x11/image.inc}
-{$INCLUDE x11/display.inc}
-{$INCLUDE x11/window.inc}
-{$INCLUDE x11/dgadisp.inc}
-{$INCLUDE x11/console.inc}
+{$INCLUDE x11/includes.inc}
 {$ENDIF UNIX}
 
 {$INCLUDE consolei.inc}
 
 {$IFDEF ENABLE_C_API}
-{$INCLUDE c_api/except.inc}
-{$INCLUDE c_api/error.inc}
-{$INCLUDE c_api/area.inc}
-{$INCLUDE c_api/color.inc}
-{$INCLUDE c_api/clear.inc}
-{$INCLUDE c_api/clipper.inc}
-{$INCLUDE c_api/copy.inc}
-{$INCLUDE c_api/key.inc}
-{$INCLUDE c_api/format.inc}
-{$INCLUDE c_api/palette.inc}
-{$INCLUDE c_api/surface.inc}
-{$INCLUDE c_api/console.inc}
-{$INCLUDE c_api/mode.inc}
-{$INCLUDE c_api/timer.inc}
+{$INCLUDE c_api/except.pp}
+{$INCLUDE c_api/error.pp}
+{$INCLUDE c_api/area.pp}
+{$INCLUDE c_api/color.pp}
+{$INCLUDE c_api/clear.pp}
+{$INCLUDE c_api/clipper.pp}
+{$INCLUDE c_api/copy.pp}
+{$INCLUDE c_api/key.pp}
+{$INCLUDE c_api/format.pp}
+{$INCLUDE c_api/palette.pp}
+{$INCLUDE c_api/surface.pp}
+{$INCLUDE c_api/console.pp}
+{$INCLUDE c_api/mode.pp}
+{$INCLUDE c_api/timer.pp}
 {$ENDIF ENABLE_C_API}
 
 Initialization

packages/extra/ptc/ptc.cfg → packages/extra/ptc/ptcpas.cfg

@@ -1,15 +1,21 @@
 #
-# example ptc.cfg, containing all supported options
+# example ptcpas.cfg, containing all supported options
 # remove the '#' to enable an option
 #
 
 
+
+#### Generic options: ####
+
 #enable logging
 #disable logging
 
 #attempt dithering
 
 
+
+#### DirectX options: ####
+
 #DirectX
 
 #default output
@@ -41,9 +47,15 @@
 #disable blocking
 
 
+
+#### VESA options: ####
+
 #VESA
 
 
+
+#### VGA/Fakemode options: ####
+
 #VGA
 #Fakemode
 
@@ -58,6 +70,9 @@
 #FAKEMODE3C
 
 
+
+#### Text mode options: ####
+
 #Text
 #TEXTFX2
 
@@ -71,9 +86,18 @@
 #calcpal_lightbase_g
 
 
+
+#### X11 options: ####
+
 #X11
 
-#dga pedantic init
-#dga off
+#default output
+#windowed output
+#fullscreen output
+#default cursor
+#show cursor
+#hide cursor
 #leave window open
 #leave display open
+#dga
+#dga off

packages/extra/ptc/surfaced.inc

@@ -64,13 +64,13 @@ Type
     Procedure clear(Const color : TPTCColor); Override;
     Procedure clear(Const color : TPTCColor; Const _area : TPTCArea); Override;
     Procedure palette(Const _palette : TPTCPalette); Override;
-    Function palette : TPTCPalette; Override;
+    Function Palette : TPTCPalette; Override;
     Procedure clip(Const _area : TPTCArea); Override;
-    Function width : Integer; Override;
-    Function height : Integer; Override;
-    Function pitch : Integer; Override;
-    Function area : TPTCArea; Override;
-    Function clip : TPTCArea; Override;
-    Function format : TPTCFormat; Override;
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+    Function GetPitch : Integer; Override;
+    Function GetArea : TPTCArea; Override;
+    Function Clip : TPTCArea; Override;
+    Function GetFormat : TPTCFormat; Override;
     Function option(Const _option : String) : Boolean; Override;
   End;

packages/extra/ptc/surfacei.inc

@@ -266,10 +266,10 @@ Begin
   m_palette.load(_palette.data^);
 End;
 
-Function TPTCSurface.palette : TPTCPalette;
+Function TPTCSurface.Palette : TPTCPalette;
 
 Begin
-  palette := m_palette;
+  Result := m_palette;
 End;
 
 Procedure TPTCSurface.clip(Const _area : TPTCArea);
@@ -280,50 +280,50 @@ Var
 Begin
   tmp := TPTCClipper.clip(_area, m_area);
   Try
-    m_clip.ASSign(tmp);
+    m_clip.Assign(tmp);
   Finally
     tmp.Free;
   End;
 End;
 
-Function TPTCSurface.width : Integer;
+Function TPTCSurface.GetWidth : Integer;
 
 Begin
-  width := m_width;
+  Result := m_width;
 End;
 
-Function TPTCSurface.height : Integer;
+Function TPTCSurface.GetHeight : Integer;
 
 Begin
-  height := m_height;
+  Result := m_height;
 End;
 
-Function TPTCSurface.pitch : Integer;
+Function TPTCSurface.GetPitch : Integer;
 
 Begin
-  pitch := m_pitch;
+  Result := m_pitch;
 End;
 
-Function TPTCSurface.area : TPTCArea;
+Function TPTCSurface.GetArea : TPTCArea;
 
 Begin
-  area := m_area;
+  Result := m_area;
 End;
 
-Function TPTCSurface.clip : TPTCArea;
+Function TPTCSurface.Clip : TPTCArea;
 
 Begin
-  clip := m_clip;
+  Result := m_clip;
 End;
 
-Function TPTCSurface.format : TPTCFormat;
+Function TPTCSurface.GetFormat : TPTCFormat;
 
 Begin
-  format := m_format;
+  Result := m_format;
 End;
 
 Function TPTCSurface.option(Const _option : String) : Boolean;
 
 Begin
-  option := m_copy.option(_option);
+  Result := m_copy.option(_option);
 End;

packages/extra/ptc/timeri.inc

@@ -47,7 +47,7 @@ Constructor TPTCTimer.Create(Const timer : TPTCTimer);
 
 Begin
   internal_init_timer;
-  ASSign(timer);
+  Assign(timer);
 End;
 
 Destructor TPTCTimer.Destroy;
@@ -74,8 +74,8 @@ Function TPTCTimer.Equals(Const timer : TPTCTimer) : Boolean;
 
 Begin
   Equals := (m_old = timer.m_old) And (m_time = timer.m_time) And
-	    (m_start = timer.m_start) And (m_current = timer.m_current) And
-	    (m_running = timer.m_running);
+            (m_start = timer.m_start) And (m_current = timer.m_current) And
+            (m_running = timer.m_running);
 End;
 
 Procedure TPTCTimer.settime(_time : Double);
@@ -144,14 +144,17 @@ Function TPTCTimer.resolution : Double;
 
 Begin
   {$IFDEF GO32V2}
-  resolution := TimerResolution;
+  Result := TimerResolution;
   {$ENDIF GO32V2}
-  {$IFDEF WIN32}
-  resolution := 1 / m_frequency;
-{  resolution := 1 / 1000;}
-  {$ENDIF WIN32}
+  {$IFDEF Win32}
+  Result := 1 / m_frequency;
+{  Result := 1 / 1000;}
+  {$ENDIF Win32}
+  {$IFDEF WinCE}
+  Result := 1 / 1000;
+  {$ENDIF WinCE}
   {$IFDEF UNIX}
-  resolution := 1 / 1000000;
+  Result := 1 / 1000000;
   {$ENDIF UNIX}
 End;
 
@@ -177,7 +180,7 @@ Begin
 End;
 {$ENDIF GO32V2}
 
-{$IFDEF WIN32}
+{$IFDEF Win32}
 Function TPTCTimer.clock : Double;
 
 Var
@@ -188,7 +191,15 @@ Begin
   clock := _time / m_frequency;
 {  clock := timeGetTime / 1000;}
 End;
-{$ENDIF WIN32}
+{$ENDIF Win32}
+
+{$IFDEF WinCE}
+Function TPTCTimer.clock : Double;
+
+Begin
+  Result := GetTickCount / 1000;
+End;
+{$ENDIF WinCE}
 
 {$IFDEF UNIX}
 Function TPTCTimer.clock : Double;

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

@@ -34,7 +34,7 @@ Destructor TWin32Event.Destroy;
 Begin
   { close handle }
   CloseHandle(m_event);
-  
+
   Inherited Destroy;
 End;
 

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

@@ -60,14 +60,14 @@ Begin
       { check for lookup window match }
       If TWin32Hook_m_registry[i].window = hwnd Then
       Begin
-	{ setup cached lookup }
-	TWin32Hook_m_cached := @TWin32Hook_m_registry[i];
+        { setup cached lookup }
+        TWin32Hook_m_cached := @TWin32Hook_m_registry[i];
 
-	{ setup lookup }
-	lookup := TWin32Hook_m_cached;
+        { setup lookup }
+        lookup := TWin32Hook_m_cached;
 
-	{ break }
-	Break;
+        { break }
+        Break;
       End;
 {$IFDEF DEBUG}
     { check for search failure }
@@ -211,33 +211,33 @@ Begin
     Begin
       { search for Self }
       For i := 0 To TWin32Hook_m_registry[index].count Do
-	{ check hook }
-	If TWin32Hook_m_registry[index].hook[i] = Self Then
-	Begin
-	  { remove this hook (quite inefficient for high count...) }
-	  For j := i To TWin32Hook_m_registry[index].count - 2 Do
-	    TWin32Hook_m_registry[index].hook[j] :=
-	      TWin32Hook_m_registry[index].hook[j + 1];
+        { check hook }
+        If TWin32Hook_m_registry[index].hook[i] = Self Then
+        Begin
+          { remove this hook (quite inefficient for high count...) }
+          For j := i To TWin32Hook_m_registry[index].count - 2 Do
+            TWin32Hook_m_registry[index].hook[j] :=
+              TWin32Hook_m_registry[index].hook[j + 1];
 
-	  { decrease hook count }
-	  Dec(TWin32Hook_m_registry[index].count);
+          { decrease hook count }
+          Dec(TWin32Hook_m_registry[index].count);
 
-	  { break }
-	  Break;
-	End;
+          { break }
+          Break;
+        End;
 
       { check remaining hook count }
       If TWin32Hook_m_registry[index].count = 0 Then
       Begin
-	{ restore original window procedure }
-	SetWindowLong(window, GWL_WNDPROC, TWin32Hook_m_registry[i].wndproc);
+        { restore original window procedure }
+        SetWindowLong(window, GWL_WNDPROC, TWin32Hook_m_registry[i].wndproc);
 
-	{ remove this lookup (quite inefficient for high count...) }
-	For i := index To TWin32Hook_m_count - 2 Do
-	  TWin32Hook_m_registry[i] := TWin32Hook_m_registry[i + 1];
+        { remove this lookup (quite inefficient for high count...) }
+        For i := index To TWin32Hook_m_count - 2 Do
+          TWin32Hook_m_registry[i] := TWin32Hook_m_registry[i + 1];
 
-	{ decrease count }
-	Dec(TWin32Hook_m_count);
+        { decrease count }
+        Dec(TWin32Hook_m_count);
       End;
 
       { break }

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

@@ -18,7 +18,7 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-Constructor TWin32Keyboard.Create(window : HWND; thread : DWord; multithreaded : Boolean);
+Constructor TWin32Keyboard.Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue);
 
 Begin
   m_monitor := Nil;
@@ -27,21 +27,17 @@ Begin
   m_monitor := TWin32Monitor.Create;
   m_event := TWin32Event.Create;
 
-  { defaults }
-  m_key := False;
-  m_head := 0;
-  m_tail := 0;
-
   { setup defaults }
   m_alt := False;
   m_shift := False;
   m_control := False;
 
-  { enable buffering }
-  m_enabled := True;
-
   { setup data }
+  FEventQueue := EventQueue;
   m_multithreaded := multithreaded;
+
+  { enable buffering }
+  m_enabled := True;
 End;
 
 Destructor TWin32Keyboard.Destroy;
@@ -52,7 +48,7 @@ Begin
   Inherited Destroy;
 End;
 
-Function TWin32Keyboard.internal_PeekKey(window : TWin32Window; k : TPTCKey) : Boolean;
+(*Function TWin32Keyboard.internal_PeekKey(window : TWin32Window; k : TPTCKeyEvent) : Boolean;
 
 Begin
   { check enabled flag }
@@ -71,28 +67,28 @@ Begin
 
   { is a key ready? }
   Result := ready;
-  
+
   If Result = True Then
-    k.ASSign(m_buffer[m_tail]);
+    k.Assign(m_buffer[m_tail]);
 
   { leave monitor if multithreaded }
   If m_multithreaded Then
     m_monitor.leave;
 End;
 
-Procedure TWin32Keyboard.internal_ReadKey(window : TWin32Window; k : TPTCKey);
+Procedure TWin32Keyboard.internal_ReadKey(window : TWin32Window; k : TPTCKeyEvent);
 
 Var
-  read : TPTCKey;
+  read : TPTCKeyEvent;
 
 Begin
   read := Nil;
-  
+
   Try
     { check enabled flag }
     If Not m_enabled Then
     Begin
-      read := TPTCKey.Create;
+      read := TPTCKeyEvent.Create;
       Exit;
     End;
 
@@ -130,10 +126,10 @@ Begin
     End;
   Finally
     If Assigned(read) Then
-      k.ASSign(read);
+      k.Assign(read);
     read.Free;
   End;
-End;
+End;*)
 
 Procedure TWin32Keyboard.enable;
 
@@ -218,7 +214,7 @@ Begin
     { handle key repeat count }
     For i := 1 To lParam And $FFFF Do
       { create and insert key object }
-      insert(TPTCKey.Create(wParam, uni, m_alt, m_shift, m_control, press));
+      FEventQueue.AddEvent(TPTCKeyEvent.Create(wParam, uni, m_alt, m_shift, m_control, press));
 
     { check multithreaded flag }
     If m_multithreaded Then
@@ -246,7 +242,7 @@ Begin
             m_control := False;*)
 End;
 
-Procedure TWin32Keyboard.insert(_key : TPTCKey);
+(*Procedure TWin32Keyboard.insert(_key : TPTCKeyEvent);
 
 Begin
   { check for overflow }
@@ -265,7 +261,7 @@ Begin
   End;
 End;
 
-Function TWin32Keyboard.remove : TPTCKey;
+Function TWin32Keyboard.remove : TPTCKeyEvent;
 
 Begin
   { return key data from tail }
@@ -284,3 +280,4 @@ Function TWin32Keyboard.ready : Boolean;
 Begin
   ready := m_head <> m_tail;
 End;
+*)

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

@@ -25,15 +25,16 @@ Type
     Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; Override;
 
     { internal key functions }
-    Procedure insert(_key : TPTCKey);
-    Function remove : TPTCKey;
-    Function ready : Boolean;
+{    Procedure insert(_key : TPTCKeyEvent);
+    Function remove : TPTCKeyEvent;
+    Function ready : Boolean;}
 
     { data }
-    m_key : Boolean;
+{    m_key : Boolean;}
     m_multithreaded : Boolean;
     m_event : TWin32Event;
     m_monitor : TWin32Monitor;
+    FEventQueue : TEventQueue;
 
     { flag data }
     m_enabled : Boolean;
@@ -44,17 +45,17 @@ Type
     m_control : Boolean;
 
     { key buffer }
-    m_head : Integer;
+{    m_head : Integer;
     m_tail : Integer;
-    m_buffer : Array[0..1023] Of TPTCKey;
+    m_buffer : Array[0..1023] Of TPTCKeyEvent;}
   Public
     { setup }
-    Constructor Create(window : HWND; thread : DWord; multithreaded : Boolean);
+    Constructor Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue);
     Destructor Destroy; Override;
 
     { input }
-    Function internal_PeekKey(window : TWin32Window; k : TPTCKey) : Boolean;
-    Procedure internal_ReadKey(window : TWin32Window; k : TPTCKey);
+{    Function internal_PeekKey(window : TWin32Window; k : TPTCKeyEvent) : Boolean;
+    Procedure internal_ReadKey(window : TWin32Window; k : TPTCKeyEvent);}
 
     { control }
     Procedure enable;

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

@@ -0,0 +1,55 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([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.
+
+    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
+  TWin32Mouse = Class(TWin32Hook)
+  Private
+    { window procedure }
+    Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; Override;
+
+    FEventQueue : TEventQueue;
+
+    FFullScreen : Boolean;
+
+    { the actual image area, inside the window (top left and bottom right corner) }
+    FWindowX1, FWindowY1, FWindowX2, FWindowY2 : Integer;
+
+    { console resolution
+      - mouse cursor position as seen by the user must always be in range:
+        [0..FConsoleWidth-1, 0..FConsoleHeight-1] }
+    FConsoleWidth, FConsoleHeight : Integer;
+
+    FPreviousMouseButtonState : TPTCMouseButtonState;
+    FPreviousMouseX, FPreviousMouseY : Integer; { for calculating the deltas }
+    FPreviousMousePositionSaved : Boolean; { true, if FPreviousMouseX,
+           FPreviousMouseY and FPreviousMouseButtonState contain valid values }
+
+    { flag data }
+    FEnabled : Boolean;
+  Public
+    { setup }
+    Constructor Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer);
+
+    Procedure SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer);
+
+    { control }
+    Procedure enable;
+    Procedure disable;
+  End;

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

@@ -0,0 +1,176 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([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.
+
+    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 TWin32Mouse.Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer);
+
+Begin
+  Inherited Create(window, thread);
+
+  FEventQueue := EventQueue;
+
+  FFullScreen := FullScreen;
+  FConsoleWidth := ConsoleWidth;
+  FConsoleHeight := ConsoleHeight;
+
+  FPreviousMousePositionSaved := False;
+
+  { enable buffering }
+  FEnabled := True;
+End;
+
+Procedure TWin32Mouse.SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer);
+
+Begin
+  FWindowX1 := WindowX1;
+  FWindowY1 := WindowY1;
+  FWindowX2 := WindowX2;
+  FWindowY2 := WindowY2;
+End;
+
+Procedure TWin32Mouse.enable;
+
+Begin
+  { enable buffering }
+  FEnabled := True;
+End;
+
+Procedure TWin32Mouse.disable;
+
+Begin
+  { disable buffering }
+  FEnabled := False;
+End;
+
+Function TWin32Mouse.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT;
+
+Var
+  fwKeys : Integer;
+  xPos, yPos : Integer;
+  LButton, MButton, RButton : Boolean;
+  TranslatedXPos, TranslatedYPos : Integer;
+  PTCMouseButtonState : TPTCMouseButtonState;
+  WindowRect : RECT;
+
+  button : TPTCMouseButton;
+  before, after : Boolean;
+  cstate : TPTCMouseButtonState;
+
+Begin
+  Result := 0;
+  { check enabled flag }
+  If Not FEnabled Then
+    Exit;
+
+  If (message = WM_MOUSEMOVE) Or
+     (message = WM_LBUTTONDOWN) Or (message = WM_LBUTTONUP) Or (message = WM_LBUTTONDBLCLK) Or
+     (message = WM_MBUTTONDOWN) Or (message = WM_MBUTTONUP) Or (message = WM_MBUTTONDBLCLK) Or
+     (message = WM_RBUTTONDOWN) Or (message = WM_RBUTTONUP) Or (message = WM_RBUTTONDBLCLK) Then
+  Begin
+    fwKeys := wParam; {MK_LBUTTON or MK_MBUTTON or MK_RBUTTON or MK_CONTROL or MK_SHIFT}
+    xPos := lParam And $FFFF;
+    yPos := (lParam Shr 16) And $FFFF;
+
+    LButton := (fwKeys And MK_LBUTTON) <> 0;
+    MButton := (fwKeys And MK_MBUTTON) <> 0;
+    RButton := (fwKeys And MK_RBUTTON) <> 0;
+
+    If Not FFullScreen Then
+    Begin
+      GetClientRect(hWnd, WindowRect);
+
+      FWindowX1 := WindowRect.left;
+      FWindowY1 := WindowRect.top;
+      FWindowX2 := WindowRect.right - 1;
+      FWindowY2 := WindowRect.bottom - 1;
+    End;
+
+    If (xPos >= FWindowX1) And (yPos >= FWindowY1) And
+       (xPos <= FWindowX2) And (yPos <= FWindowY2) Then
+    Begin
+      If FWindowX2 <> FWindowX1 Then
+        TranslatedXPos := (xPos - FWindowX1) * (FConsoleWidth  - 1) Div (FWindowX2 - FWindowX1)
+      Else { avoid div by zero }
+        TranslatedXPos := 0;
+
+      If FWindowY2 <> FWindowY1 Then
+        TranslatedYPos := (yPos - FWindowY1) * (FConsoleHeight - 1) Div (FWindowY2 - FWindowY1)
+      Else { avoid div by zero }
+        TranslatedYPos := 0;
+
+      { Just in case... }
+      If TranslatedXPos < 0 Then
+        TranslatedXPos := 0;
+      If TranslatedYPos < 0 Then
+        TranslatedYPos := 0;
+      If TranslatedXPos >= FConsoleWidth Then
+        TranslatedXPos := FConsoleWidth - 1;
+      If TranslatedYPos >= FConsoleHeight Then
+        TranslatedYPos := FConsoleHeight - 1;
+
+      If Not LButton Then
+        PTCMouseButtonState := []
+      Else
+        PTCMouseButtonState := [PTCMouseButton1];
+
+      If RButton Then
+        PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
+
+      If MButton Then
+        PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
+
+      If Not FPreviousMousePositionSaved Then
+      Begin
+        FPreviousMouseX := TranslatedXPos; { first DeltaX will be 0 }
+        FPreviousMouseY := TranslatedYPos; { first DeltaY will be 0 }
+        FPreviousMouseButtonState := [];
+      End;
+
+      { movement? }
+      If (TranslatedXPos <> FPreviousMouseX) Or (TranslatedYPos <> FPreviousMouseY) Then
+        FEventQueue.AddEvent(TPTCMouseEvent.Create(TranslatedXPos, TranslatedYPos, TranslatedXPos - FPreviousMouseX, TranslatedYPos - FPreviousMouseY, FPreviousMouseButtonState));
+
+      { button presses/releases? }
+      cstate := FPreviousMouseButtonState;
+      For button := Low(button) To High(button) Do
+      Begin
+        before := button In FPreviousMouseButtonState;
+        after := button In PTCMouseButtonState;
+        If after And (Not before) Then
+        Begin
+          { button was pressed }
+          cstate := cstate + [button];
+          FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, True, button));
+        End
+        Else
+          If before And (Not after) Then
+          Begin
+            { button was released }
+            cstate := cstate - [button];
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, False, button));
+          End;
+      End;
+
+      FPreviousMouseX := TranslatedXPos;
+      FPreviousMouseY := TranslatedYPos;
+      FPreviousMouseButtonState := PTCMouseButtonState;
+      FPreviousMousePositionSaved := True;
+    End;
+  End;
+End;

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

@@ -57,12 +57,10 @@ Begin
   If flag Then
   Begin
     SetClassLong(m_window, GCL_HCURSOR, LoadCursor(0, IDC_ARROW));
-    Win32Cursor_resurrect;
   End
   Else
   Begin
     SetClassLong(m_window, GCL_HCURSOR, 0);
-    Win32Cursor_kill;
   End;
   SendMessage(m_window, WM_SETCURSOR, 0, 0);
 End;
@@ -203,9 +201,9 @@ Begin
     wc.cbWndExtra := 0;
     wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
     If multithreaded Then
-      Pointer(wc.lpfnWndProc) := Pointer(@WndProcMultiThreaded)
+      wc.lpfnWndProc := @WndProcMultiThreaded
     Else
-      Pointer(wc.lpfnWndProc) := Pointer(@WndProcSingleThreaded);
+      wc.lpfnWndProc := @WndProcSingleThreaded;
     wc.hCursor := LoadCursor(0, IDC_ARROW);
     RegisterClassEx(wc);
     With rectangle Do
@@ -224,8 +222,8 @@ Begin
       x := (display_width - (rectangle.right - rectangle.left)) Div 2;
       y := (display_height - (rectangle.bottom - rectangle.top)) Div 2;
     End;
-    Move(wndclass[1], m_name, Length(wndclass));
-    Move(title[1], m_title, Length(title));
+    m_name := wndclass;
+    m_title := title;
     m_extra := extra;
     m_style := style;
     m_show := show;
@@ -240,7 +238,7 @@ Begin
     End
     Else
     Begin
-      m_window := CreateWindowEx(m_extra, m_name, m_title, m_style, m_x, m_y, m_width, m_height, 0, 0, 0, m_data);
+      m_window := CreateWindowEx(m_extra, PChar(m_name), PChar(m_title), m_style, m_x, m_y, m_width, m_height, 0, 0, 0, m_data);
       If Not IsWindow(m_window) Then
         Raise TPTCError.Create('could not create window');
       ShowWindow(m_window, m_show);
@@ -261,8 +259,8 @@ Begin
   m_event := 0;
   m_thread := 0;
   m_id := 0;
-  m_name[0] := #0;
-  m_title[0] := #0;
+  m_name := '';
+  m_title := '';
   m_extra := 0;
   m_style := 0;
   m_show := 0;
@@ -306,7 +304,7 @@ Begin
     m_event := 0;
     m_thread := 0;
     m_id := 0;
-    UnregisterClass(@m_name, GetModuleHandle(Nil));
+    UnregisterClass(PChar(m_name), GetModuleHandle(Nil));
   End;
 End;
 
@@ -318,7 +316,7 @@ Var
 Begin
   With owner Do
   Begin
-    m_window := CreateWindowEx(m_extra, @m_name, @m_title, m_style, m_x, m_y, m_width, m_height, 0, 0, 0, m_data);
+    m_window := CreateWindowEx(m_extra, PChar(m_name), PChar(m_title), m_style, m_x, m_y, m_width, m_height, 0, 0, 0, m_data);
     If IsWindow(m_window) Then
     Begin
       ShowWindow(m_window, m_show);

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

@@ -19,7 +19,6 @@
 }
 
 Type
-{  PWin32Window = ^TWin32Window;}
   TWin32Window = Class(TObject)
   Private
     Procedure internal_create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer);
@@ -33,8 +32,8 @@ Type
     m_event : THANDLE;
     m_thread : THANDLE;
     m_id : DWord;
-    m_name : Array[0..1023] Of Char;
-    m_title : Array[0..1023] Of Char;
+    m_name : AnsiString;
+    m_title : AnsiString;
     m_extra : DWord;
     m_style : DWord;
     m_show : Integer;

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

@@ -0,0 +1,117 @@
+{
+    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 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.
+
+    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(TPTCBaseConsole)
+  Private
+    FWindow : TWin32Window;
+    FWin32DIB : TWin32DIB;
+    FKeyboard : TWin32Keyboard;
+    FMouse : TWin32Mouse;
+
+    FCopy : TPTCCopy;
+    FClear : TPTCClear;
+    FEventQueue : TEventQueue;
+    FArea : TPTCArea;
+    FClip : TPTCArea;
+    FPalette : TPTCPalette;
+
+    FOpen : Boolean;
+    FLocked : Boolean;
+
+    FTitle : String;
+
+    FDefaultWidth : Integer;
+    FDefaultHeight : Integer;
+    FDefaultFormat : TPTCFormat;
+
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+    Function GetPitch : Integer; Override;
+    Function GetArea : TPTCArea; Override;
+    Function GetFormat : TPTCFormat; Override;
+    Function GetPages : Integer; Override;
+    Function GetName : String; Override;
+    Function GetTitle : String; Override;
+    Function GetInformation : String; Override;
+
+    Procedure CheckOpen(    AMessage : String);
+    Procedure CheckUnlocked(AMessage : String);
+  Public
+    Constructor Create; Override;
+    Destructor Destroy; Override;
+
+    Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat;
+                   APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; AWidth, AHeight : Integer;
+                   Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; Const AMode : TPTCMode;
+                   APages : Integer = 0); Overload; Override;
+    Procedure Close; Override;
+
+    Procedure Copy(Var ASurface : TPTCBaseSurface); Override;
+    Procedure Copy(Var ASurface : TPTCBaseSurface;
+                   Const ASource, ADestination : TPTCArea); Override;
+
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Override;
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Override;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Override;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Override;
+
+    Function Lock : Pointer; Override;
+    Procedure Unlock; Override;
+
+    Procedure Clear; Override;
+    Procedure Clear(Const AColor : TPTCColor); Override;
+    Procedure Clear(Const AColor : TPTCColor;
+                    Const AArea : TPTCArea); Override;
+
+    Procedure Configure(Const AFileName : String); Override;
+    Function Option(Const AOption : String) : Boolean; Override;
+
+    Procedure Palette(Const APalette : TPTCPalette); Override;
+    Procedure Clip(Const AArea : TPTCArea); Override;
+    Function Clip : TPTCArea; Override;
+    Function Palette : TPTCPalette; Override;
+    Function Modes : PPTCMode; Override;
+
+    Procedure Flush; Override;
+    Procedure Finish; Override;
+    Procedure Update; Override;
+    Procedure Update(Const AArea : TPTCArea); Override;
+
+    Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override;
+  End;

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

@@ -0,0 +1,538 @@
+Constructor TGDIConsole.Create;
+
+Begin
+  Inherited Create;
+
+  FDefaultWidth := 320;
+  FDefaultHeight := 200;
+  FDefaultFormat := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+
+  FCopy := TPTCCopy.Create;
+  FClear := TPTCClear.Create;
+  FArea := TPTCArea.Create;
+  FClip := TPTCArea.Create;
+  FPalette := TPTCPalette.Create;
+
+  FOpen := False;
+
+  { configure console }
+  Configure('ptcpas.cfg');
+End;
+
+Destructor TGDIConsole.Destroy;
+
+Begin
+  Close;
+
+  {...}
+
+  FWin32DIB.Free;
+  FWindow.Free;
+  FPalette.Free;
+  FEventQueue.Free;
+  FCopy.Free;
+  FClear.Free;
+  FArea.Free;
+  FClip.Free;
+  FDefaultFormat.Free;
+
+  Inherited Destroy;
+End;
+
+Procedure TGDIConsole.Open(Const ATitle : String; APages : Integer = 0);
+
+Begin
+  Open(ATitle, FDefaultFormat, APages);
+End;
+
+Procedure TGDIConsole.Open(Const ATitle : String; Const AFormat : TPTCFormat;
+               APages : Integer = 0);
+
+Begin
+  Open(ATitle, FDefaultWidth, FDefaultHeight, AFormat, APages);
+End;
+
+Procedure TGDIConsole.Open(Const ATitle : String; Const AMode : TPTCMode;
+                           APages : Integer = 0);
+
+Begin
+  Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages);
+End;
+
+Procedure TGDIConsole.Open(Const ATitle : String; AWidth, AHeight : Integer;
+               Const AFormat : TPTCFormat; APages : Integer = 0);
+
+Var
+  tmp : TPTCArea;
+
+Begin
+  If FOpen Then
+    Close;
+
+(*  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!!!
+                                 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,
+                                 SW_NORMAL,
+                                 CW_USEDEFAULT, CW_USEDEFAULT,
+                                 AWidth, AHeight,
+                                 {m_center_window}False,
+                                 False);*)
+
+  FWin32DIB := TWin32DIB.Create(AWidth, AHeight);
+
+  FreeAndNil(FKeyboard);
+  FreeAndNil(FMouse);
+  FreeAndNil(FEventQueue);
+  FEventQueue := TEventQueue.Create;
+  FKeyboard := TWin32Keyboard.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue);
+  FMouse := TWin32Mouse.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue, {FFullScreen}False, AWidth, AHeight);
+
+  tmp := TPTCArea.Create(0, 0, AWidth, AHeight);
+  Try
+    FArea.Assign(tmp);
+    FClip.Assign(tmp);
+  Finally
+    tmp.Free;
+  End;
+
+  FWindow.Update;
+
+  FTitle := ATitle;
+
+  FOpen := True;
+End;
+
+Procedure TGDIConsole.Close;
+
+Begin
+  If Not FOpen Then
+    Exit;
+
+  {...}
+
+  FreeAndNil(FKeyboard);
+  FreeAndNil(FMouse);
+
+  FreeAndNil(FWin32DIB);
+  FreeAndNil(FWindow);
+
+  FreeAndNil(FEventQueue);
+
+  FTitle := '';
+
+  FOpen := False;
+End;
+
+Procedure TGDIConsole.Copy(Var ASurface : TPTCBaseSurface);
+
+Begin
+  // todo...
+End;
+
+Procedure TGDIConsole.Copy(Var ASurface : TPTCBaseSurface;
+                           Const ASource, ADestination : TPTCArea);
+
+Begin
+  // todo...
+End;
+
+Procedure TGDIConsole.Load(Const APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette);
+Var
+  Area_ : TPTCArea;
+  console_pixels : Pointer;
+
+Begin
+  CheckOpen(    'TGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)');
+  CheckUnlocked('TGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)');
+  If Clip.Equals(Area) Then
+  Begin
+    Try
+      console_pixels := Lock;
+      Try
+        FCopy.Request(AFormat, Format);
+        FCopy.Palette(APalette, Palette);
+        FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, console_pixels, 0, 0,
+                    Width, Height, Pitch);
+      Finally
+        Unlock;
+      End;
+    Except
+      On error : TPTCError Do
+        Raise TPTCError.Create('failed to load pixels to console', error);
+    End;
+  End
+  Else
+  Begin
+    Area_ := TPTCArea.Create(0, 0, width, height);
+    Try
+      Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, Area);
+    Finally
+      Area_.Free;
+    End;
+  End;
+End;
+
+Procedure TGDIConsole.Load(Const APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette;
+                           Const ASource, ADestination : TPTCArea);
+Var
+  console_pixels : Pointer;
+  clipped_source, clipped_destination : TPTCArea;
+  tmp : TPTCArea;
+
+Begin
+  CheckOpen(    'TGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)');
+  CheckUnlocked('TGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)');
+  clipped_source := Nil;
+  clipped_destination := Nil;
+  Try
+    console_pixels := Lock;
+    Try
+      clipped_source := TPTCArea.Create;
+      clipped_destination := TPTCArea.Create;
+      tmp := TPTCArea.Create(0, 0, AWidth, AHeight);
+      Try
+        TPTCClipper.Clip(ASource, tmp, clipped_source, ADestination, Clip, clipped_destination);
+      Finally
+        tmp.Free;
+      End;
+      FCopy.request(AFormat, Format);
+      FCopy.palette(APalette, Palette);
+      FCopy.copy(APixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, APitch,
+                 console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, Pitch);
+    Finally
+      Unlock;
+      clipped_source.Free;
+      clipped_destination.Free;
+    End;
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create('failed to load pixels to console area', error);
+  End;
+End;
+
+Procedure TGDIConsole.Save(APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette);
+
+Begin
+  // todo...
+End;
+
+Procedure TGDIConsole.Save(APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette;
+                           Const ASource, ADestination : TPTCArea);
+
+Begin
+  // todo...
+End;
+
+Function TGDIConsole.Lock : Pointer;
+
+Begin
+  Result := FWin32DIB.Pixels; // todo...
+  FLocked := True;
+End;
+
+Procedure TGDIConsole.Unlock;
+
+Begin
+  FLocked := False;
+End;
+
+Procedure TGDIConsole.Clear;
+
+Begin
+  // todo...
+End;
+
+Procedure TGDIConsole.Clear(Const AColor : TPTCColor);
+
+Begin
+  // todo...
+End;
+
+Procedure TGDIConsole.Clear(Const AColor : TPTCColor;
+                            Const AArea : TPTCArea);
+
+Begin
+  // todo...
+End;
+
+Procedure TGDIConsole.Configure(Const AFileName : String);
+
+Var
+  F : Text;
+  S : String;
+
+Begin
+  AssignFile(F, AFileName);
+  {$I-}
+  Reset(F);
+  {$I+}
+  If IOResult <> 0 Then
+    Exit;
+  While Not EoF(F) Do
+  Begin
+    {$I-}
+    Readln(F, S);
+    {$I+}
+    If IOResult <> 0 Then
+      Break;
+    Option(S);
+  End;
+  CloseFile(F);
+End;
+
+Function TGDIConsole.Option(Const AOption : String) : Boolean;
+
+Begin
+  // todo...
+
+  Result := FCopy.Option(AOption);
+End;
+
+Procedure TGDIConsole.Palette(Const APalette : TPTCPalette);
+
+Begin
+  // todo...
+End;
+
+Procedure TGDIConsole.Clip(Const AArea : TPTCArea);
+
+Var
+  tmp : TPTCArea;
+
+Begin
+  CheckOpen('TGDIConsole.Clip(AArea)');
+
+  tmp := TPTCClipper.Clip(AArea, FArea);
+  Try
+    FClip.Assign(tmp);
+  Finally
+    tmp.Free;
+  End;
+End;
+
+Function TGDIConsole.Clip : TPTCArea;
+
+Begin
+  CheckOpen('TGDIConsole.Clip');
+  Result := FClip;
+End;
+
+Function TGDIConsole.Palette : TPTCPalette;
+
+Begin
+  CheckOpen('TGDIConsole.Palette');
+  Result := FPalette;
+End;
+
+Function TGDIConsole.Modes : PPTCMode;
+
+Begin
+  // todo...
+  Result := Nil;
+End;
+
+Procedure TGDIConsole.Flush;
+
+Begin
+  CheckOpen(    'TGDIConsole.Flush');
+  CheckUnlocked('TGDIConsole.Flush');
+
+  // todo...
+End;
+
+Procedure TGDIConsole.Finish;
+
+Begin
+  CheckOpen(    'TGDIConsole.Finish');
+  CheckUnlocked('TGDIConsole.Finish');
+
+  // todo...
+End;
+
+Procedure TGDIConsole.Update;
+
+Var
+  ClientRect : RECT;
+  DeviceContext : HDC;
+
+Begin
+  CheckOpen(    'TGDIConsole.Update');
+  CheckUnlocked('TGDIConsole.Update');
+
+  FWindow.Update;
+
+  DeviceContext := GetDC(FWindow.m_window);
+
+  If DeviceContext <> 0 Then
+  Begin
+    If GetClientRect(FWindow.m_window, @ClientRect) Then
+    Begin
+      StretchDIBits(DeviceContext,
+                    0, 0, ClientRect.right, ClientRect.bottom,
+                    0, 0, FWin32DIB.Width, FWin32DIB.Height,
+                    FWin32DIB.Pixels,
+                    FWin32DIB.BMI^,
+                    DIB_RGB_COLORS,
+                    SRCCOPY);
+    End;
+
+    ReleaseDC(FWindow.m_window, DeviceContext);
+  End;
+End;
+
+Procedure TGDIConsole.Update(Const AArea : TPTCArea);
+
+Begin
+  Update;
+End;
+
+Function TGDIConsole.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean;
+
+Begin
+  CheckOpen('TGDIConsole.NextEvent');
+//  CheckUnlocked('TGDIConsole.NextEvent');
+
+  FreeAndNil(AEvent);
+  Repeat
+    { update window }
+    FWindow.Update;
+
+    { try to find an event that matches the EventMask }
+    AEvent := FEventQueue.NextEvent(AEventMask);
+  Until (Not AWait) Or (AEvent <> Nil);
+  Result := AEvent <> Nil;
+End;
+
+Function TGDIConsole.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent;
+
+Begin
+  CheckOpen('TGDIConsole.PeekEvent');
+//  CheckUnlocked('TGDIConsole.PeekEvent');
+
+  Repeat
+    { update window }
+    FWindow.Update;
+
+    { try to find an event that matches the EventMask }
+    Result := FEventQueue.PeekEvent(AEventMask);
+  Until (Not AWait) Or (Result <> Nil);
+End;
+
+Function TGDIConsole.GetWidth : Integer;
+
+Begin
+  CheckOpen('TGDIConsole.GetWidth');
+  Result := FWin32DIB.Width;
+End;
+
+Function TGDIConsole.GetHeight : Integer;
+
+Begin
+  CheckOpen('TGDIConsole.GetHeight');
+  Result := FWin32DIB.Height;
+End;
+
+Function TGDIConsole.GetPitch : Integer;
+
+Begin
+  CheckOpen('TGDIConsole.GetPitch');
+  Result := FWin32DIB.Pitch;
+End;
+
+Function TGDIConsole.GetArea : TPTCArea;
+
+Begin
+  CheckOpen('TGDIConsole.GetArea');
+  Result := FArea;
+End;
+
+Function TGDIConsole.GetFormat : TPTCFormat;
+
+Begin
+  CheckOpen('TGDIConsole.GetFormat');
+  Result := FWin32DIB.Format;
+End;
+
+Function TGDIConsole.GetPages : Integer;
+
+Begin
+  CheckOpen('TGDIConsole.GetPages');
+  Result := 2;
+End;
+
+Function TGDIConsole.GetName : String;
+
+Begin
+  Result := 'GDI';
+End;
+
+Function TGDIConsole.GetTitle : String;
+
+Begin
+  CheckOpen('TGDIConsole.GetTitle');
+  Result := FTitle;
+End;
+
+Function TGDIConsole.GetInformation : String;
+
+Begin
+  CheckOpen('TGDIConsole.GetInformation');
+  Result := ''; // todo...
+End;
+
+Procedure TGDIConsole.CheckOpen(AMessage : String);
+
+Begin
+  If Not FOpen Then
+  Try
+    Raise TPTCError.Create('console is not open');
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create(AMessage, error);
+  End;
+End;
+
+Procedure TGDIConsole.CheckUnlocked(AMessage : String);
+
+Begin
+  If FLocked Then
+  Try
+    Raise TPTCError.Create('console is locked');
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create(AMessage, error);
+  End;
+End;

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

@@ -0,0 +1,17 @@
+Type
+  TWin32DIB = Class(TObject)
+  Private
+    FBitmapInfo : PBITMAPINFO;
+    FPixels : Pointer;
+    FFormat : TPTCFormat;
+    FWidth, FHeight, FPitch : Integer;
+  Public
+    Constructor Create(AWidth, AHeight : Integer);
+    Destructor Destroy; Override;
+    Property BMI : PBITMAPINFO Read FBitmapInfo;
+    Property Width : Integer Read FWidth;
+    Property Height : Integer Read FHeight;
+    Property Pitch : Integer Read FPitch;
+    Property Format : TPTCFormat Read FFormat;
+    Property Pixels : Pointer Read FPixels;
+  End;

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

@@ -0,0 +1,45 @@
+
+{TODO: create DIBs with the same color depth as the desktop}
+
+Constructor TWin32DIB.Create(AWidth, AHeight : Integer);
+
+Begin
+  FBitmapInfo := GetMem(SizeOf(BITMAPINFOHEADER) + 12);
+
+  FillChar(FBitmapInfo^.bmiHeader, SizeOf(BITMAPINFOHEADER), 0);
+  With FBitmapInfo^.bmiHeader Do
+  Begin
+    biSize := SizeOf(BITMAPINFOHEADER);
+    biWidth := AWidth;
+    biHeight := -AHeight;
+    biPlanes := 1;
+    biBitCount := 32;
+    biCompression := BI_BITFIELDS;
+    biSizeImage := 0;
+    biXPelsPerMeter := 0;
+    biYPelsPerMeter := 0;
+    biClrUsed := 0;
+    biClrImportant := 0;
+  End;
+
+  PDWord(@FBitmapInfo^.bmiColors)[0] := $FF0000;
+  PDWord(@FBitmapInfo^.bmiColors)[1] := $00FF00;
+  PDWord(@FBitmapInfo^.bmiColors)[2] := $0000FF;
+
+  FWidth := AWidth;
+  FHeight := AHeight;
+  FFormat := TPTCFormat.Create(32, $FF0000, $FF00, $FF);
+  FPitch := FWidth * 4;
+
+  FPixels := GetMem(AWidth * AHeight * 4);
+  FillChar(FPixels^, AWidth * AHeight * 4, 0);
+End;
+
+Destructor TWin32DIB.Destroy;
+
+Begin
+  FreeMem(FPixels);
+  FreeMem(FBitmapInfo);
+  FFormat.Free;
+  Inherited Destroy;
+End;

packages/extra/ptc/wince/base/wincekeyboardd.inc

@@ -0,0 +1,44 @@
+{
+    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 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.
+
+    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
+  TWinCEKeyboard = Class(TObject)
+  Private
+    { data }
+    FEventQueue : TEventQueue;
+
+    { flag data }
+    m_enabled : Boolean;
+
+    { modifiers }
+    m_alt : Boolean;
+    m_shift : Boolean;
+    m_control : Boolean;
+  Public
+    { setup }
+    Constructor Create(EventQueue : TEventQueue);
+
+    { window procedure }
+    Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT;
+
+    { control }
+    Procedure enable;
+    Procedure disable;
+  End;

packages/extra/ptc/wince/base/wincekeyboardi.inc

@@ -0,0 +1,138 @@
+{
+    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 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.
+
+    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 TWinCEKeyboard.Create(EventQueue : TEventQueue);
+
+Begin
+//  m_monitor := Nil;
+//  m_event := Nil;
+//  Inherited Create(window, thread);
+//  m_monitor := TWin32Monitor.Create;
+//  m_event := TWin32Event.Create;
+
+  { setup defaults }
+  m_alt := False;
+  m_shift := False;
+  m_control := False;
+
+  { setup data }
+  FEventQueue := EventQueue;
+//  m_multithreaded := multithreaded;
+
+  { enable buffering }
+  m_enabled := True;
+End;
+
+Procedure TWinCEKeyboard.enable;
+
+Begin
+  { enable buffering }
+  m_enabled := True;
+End;
+
+Procedure TWinCEKeyboard.disable;
+
+Begin
+  { disable buffering }
+  m_enabled := False;
+End;
+
+Function TWinCEKeyboard.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT;
+
+Var
+  i : Integer;
+  scancode : Integer;
+  KeyStateArray : Array[0..255] Of Byte;
+  AsciiBuf : Word;
+  press : Boolean;
+  uni : Integer;
+  tmp : Integer;
+
+Begin
+  WndProc := 0;
+  { check enabled flag }
+  If Not m_enabled Then
+    Exit;
+
+  { process key message }
+  If (message = WM_KEYDOWN) Or (message = WM_KEYUP) {Or ((message = WM_SYSKEYDOWN) And ((lParam And (1 Shl 29)) <> 0))} Then
+  Begin
+    If message = WM_KEYUP Then
+      press := False
+    Else
+      press := True;
+
+    { update modifiers }
+    If wParam = VK_MENU Then
+      { alt }
+      m_alt := press
+    Else
+      If wParam = VK_SHIFT Then
+        { shift }
+        m_shift := press
+      Else
+        If wParam = VK_CONTROL Then
+          { control }
+          m_control := press;
+
+    { enter monitor if multithreaded }
+(*    If m_multithreaded Then
+      m_monitor.enter;*)
+
+    uni := -1;
+
+(*    If GetKeyboardState(@KeyStateArray) Then
+    Begin
+      scancode := (lParam Shr 16) And $FF;
+      {todo: ToUnicode (Windows NT)}
+      tmp := ToAscii(wParam, scancode, @KeyStateArray, @AsciiBuf, 0);
+      If (tmp = 1) Or (tmp = 2) Then
+      Begin
+        If tmp = 2 Then
+        Begin
+//          Writeln('[', AsciiBuf, ']'); {???? todo: dead keys ????}
+        End
+        Else
+        Begin
+//          Write(Chr(AsciiBuf));
+          {todo: codepage -> unicode}
+          If AsciiBuf <= 126 Then
+            uni := AsciiBuf;
+        End;
+
+      End;
+    End;*)
+
+    { handle key repeat count }
+    For i := 1 To lParam And $FFFF Do
+      { create and insert key object }
+      FEventQueue.AddEvent(TPTCKeyEvent.Create(wParam, uni, m_alt, m_shift, m_control, press));
+
+    { check multithreaded flag }
+(*    If m_multithreaded Then
+    Begin
+      { set event }
+      m_event._set;
+
+      { leave monitor }
+      m_monitor.leave;
+    End;*)
+  End;
+End;

packages/extra/ptc/wince/base/wincemoused.inc

@@ -0,0 +1,55 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([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.
+
+    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
+  TWinCEMouse = Class(TObject)
+  Private
+    FEventQueue : TEventQueue;
+
+    FFullScreen : Boolean;
+
+    { the actual image area, inside the window (top left and bottom right corner) }
+    FWindowX1, FWindowY1, FWindowX2, FWindowY2 : Integer;
+
+    { console resolution
+      - mouse cursor position as seen by the user must always be in range:
+        [0..FConsoleWidth-1, 0..FConsoleHeight-1] }
+    FConsoleWidth, FConsoleHeight : Integer;
+
+    FPreviousMouseButtonState : TPTCMouseButtonState;
+    FPreviousMouseX, FPreviousMouseY : Integer; { for calculating the deltas }
+    FPreviousMousePositionSaved : Boolean; { true, if FPreviousMouseX,
+           FPreviousMouseY and FPreviousMouseButtonState contain valid values }
+
+    { flag data }
+    FEnabled : Boolean;
+  Public
+    { setup }
+    Constructor Create(EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer);
+
+    { window procedure }
+    Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT;
+
+    Procedure SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer);
+
+    { control }
+    Procedure enable;
+    Procedure disable;
+  End;

packages/extra/ptc/wince/base/wincemousei.inc

@@ -0,0 +1,174 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([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.
+
+    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 TWinCEMouse.Create(EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer);
+
+Begin
+  FEventQueue := EventQueue;
+
+  FFullScreen := FullScreen;
+  FConsoleWidth := ConsoleWidth;
+  FConsoleHeight := ConsoleHeight;
+
+  FPreviousMousePositionSaved := False;
+
+  { enable buffering }
+  FEnabled := True;
+End;
+
+Procedure TWinCEMouse.SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer);
+
+Begin
+  FWindowX1 := WindowX1;
+  FWindowY1 := WindowY1;
+  FWindowX2 := WindowX2;
+  FWindowY2 := WindowY2;
+End;
+
+Procedure TWinCEMouse.enable;
+
+Begin
+  { enable buffering }
+  FEnabled := True;
+End;
+
+Procedure TWinCEMouse.disable;
+
+Begin
+  { disable buffering }
+  FEnabled := False;
+End;
+
+Function TWinCEMouse.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT;
+
+Var
+  fwKeys : Integer;
+  xPos, yPos : Integer;
+  LButton, MButton, RButton : Boolean;
+  TranslatedXPos, TranslatedYPos : Integer;
+  PTCMouseButtonState : TPTCMouseButtonState;
+  WindowRect : RECT;
+
+  button : TPTCMouseButton;
+  before, after : Boolean;
+  cstate : TPTCMouseButtonState;
+
+Begin
+  Result := 0;
+  { check enabled flag }
+  If Not FEnabled Then
+    Exit;
+
+  If (message = WM_MOUSEMOVE) Or
+     (message = WM_LBUTTONDOWN) Or (message = WM_LBUTTONUP) Or (message = WM_LBUTTONDBLCLK) Or
+     (message = WM_MBUTTONDOWN) Or (message = WM_MBUTTONUP) Or (message = WM_MBUTTONDBLCLK) Or
+     (message = WM_RBUTTONDOWN) Or (message = WM_RBUTTONUP) Or (message = WM_RBUTTONDBLCLK) Then
+  Begin
+    fwKeys := wParam; {MK_LBUTTON or MK_MBUTTON or MK_RBUTTON or MK_CONTROL or MK_SHIFT}
+    xPos := lParam And $FFFF;
+    yPos := (lParam Shr 16) And $FFFF;
+
+    LButton := (fwKeys And MK_LBUTTON) <> 0;
+    MButton := (fwKeys And MK_MBUTTON) <> 0;
+    RButton := (fwKeys And MK_RBUTTON) <> 0;
+
+    If Not FFullScreen Then
+    Begin
+      GetClientRect(hWnd, WindowRect);
+
+      FWindowX1 := WindowRect.left;
+      FWindowY1 := WindowRect.top;
+      FWindowX2 := WindowRect.right - 1;
+      FWindowY2 := WindowRect.bottom - 1;
+    End;
+
+    If (xPos >= FWindowX1) And (yPos >= FWindowY1) And
+       (xPos <= FWindowX2) And (yPos <= FWindowY2) Then
+    Begin
+      If FWindowX2 <> FWindowX1 Then
+        TranslatedXPos := (xPos - FWindowX1) * (FConsoleWidth  - 1) Div (FWindowX2 - FWindowX1)
+      Else { avoid div by zero }
+        TranslatedXPos := 0;
+
+      If FWindowY2 <> FWindowY1 Then
+        TranslatedYPos := (yPos - FWindowY1) * (FConsoleHeight - 1) Div (FWindowY2 - FWindowY1)
+      Else { avoid div by zero }
+        TranslatedYPos := 0;
+
+      { Just in case... }
+      If TranslatedXPos < 0 Then
+        TranslatedXPos := 0;
+      If TranslatedYPos < 0 Then
+        TranslatedYPos := 0;
+      If TranslatedXPos >= FConsoleWidth Then
+        TranslatedXPos := FConsoleWidth - 1;
+      If TranslatedYPos >= FConsoleHeight Then
+        TranslatedYPos := FConsoleHeight - 1;
+
+      If Not LButton Then
+        PTCMouseButtonState := []
+      Else
+        PTCMouseButtonState := [PTCMouseButton1];
+
+      If RButton Then
+        PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
+
+      If MButton Then
+        PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
+
+      If Not FPreviousMousePositionSaved Then
+      Begin
+        FPreviousMouseX := TranslatedXPos; { first DeltaX will be 0 }
+        FPreviousMouseY := TranslatedYPos; { first DeltaY will be 0 }
+        FPreviousMouseButtonState := [];
+      End;
+
+      { movement? }
+      If (TranslatedXPos <> FPreviousMouseX) Or (TranslatedYPos <> FPreviousMouseY) Then
+        FEventQueue.AddEvent(TPTCMouseEvent.Create(TranslatedXPos, TranslatedYPos, TranslatedXPos - FPreviousMouseX, TranslatedYPos - FPreviousMouseY, FPreviousMouseButtonState));
+
+      { button presses/releases? }
+      cstate := FPreviousMouseButtonState;
+      For button := Low(button) To High(button) Do
+      Begin
+        before := button In FPreviousMouseButtonState;
+        after := button In PTCMouseButtonState;
+        If after And (Not before) Then
+        Begin
+          { button was pressed }
+          cstate := cstate + [button];
+          FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, True, button));
+        End
+        Else
+          If before And (Not after) Then
+          Begin
+            { button was released }
+            cstate := cstate - [button];
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, False, button));
+          End;
+      End;
+
+      FPreviousMouseX := TranslatedXPos;
+      FPreviousMouseY := TranslatedYPos;
+      FPreviousMouseButtonState := PTCMouseButtonState;
+      FPreviousMousePositionSaved := True;
+    End;
+  End;
+End;

packages/extra/ptc/wince/base/wincewindowd.inc

@@ -0,0 +1,21 @@
+Type
+  TWinCEWndProc = Function(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT Of Object;
+
+  TWinCEWindow = Class(TObject)
+  Private
+    FWindow : HWND;
+    FClassName : WideString;
+    FClassHInstance : HINST;
+  Public
+    Constructor Create(Const AClassName, ATitle : WideString;
+                       AExStyle, AStyle : DWord;
+                       AShow, AX, AY, AWidth, AHeight : Integer;
+                       AWndProc : TWinCEWndProc;
+                       AData : Pointer = Nil);
+    Destructor Destroy; Override;
+
+    Procedure Close;
+    Procedure Update;
+
+    Property WindowHandle : HWND Read FWindow;
+  End;

packages/extra/ptc/wince/base/wincewindowi.inc

@@ -0,0 +1,182 @@
+Type
+  PWndProcRegEntry = ^TWndProcRegEntry;
+  TWndProcRegEntry = Record
+    WindowHandle : HWND;
+    Handler : TWinCEWndProc;
+  End;
+
+ThreadVar
+  WndProcRegistry : Array Of TWndProcRegEntry;
+  WndProcRegistryCache : Integer;
+
+Procedure WndProcAdd(AWindowHandle : HWND; AHandler : TWinCEWndProc);
+
+Var
+  I : Integer;
+
+Begin
+  I := Length(WndProcRegistry);
+  SetLength(WndProcRegistry, I + 1);
+  WndProcRegistry[I].WindowHandle := AWindowHandle;
+  WndProcRegistry[I].Handler := AHandler;
+End;
+
+Procedure WndProcRemove(AWindowHandle : HWND);
+
+Var
+  I, J : Integer;
+
+Begin
+  J := 0;
+  For I := Low(WndProcRegistry) To High(WndProcRegistry) Do
+    If WndProcRegistry[I].WindowHandle <> AWindowHandle Then
+    Begin
+      WndProcRegistry[J] := WndProcRegistry[I];
+      Inc(J);
+    End;
+  SetLength(WndProcRegistry, J);
+End;
+
+Function WndProcFind(AWindowHandle : HWND) : TWinCEWndProc;
+
+Var
+  I : Integer;
+
+Begin
+  If (WndProcRegistryCache >= Low(WndProcRegistry)) And
+     (WndProcRegistryCache <= High(WndProcRegistry)) And
+     (WndProcRegistry[WndProcRegistryCache].WindowHandle = AWindowHandle) Then
+  Begin
+    Result := WndProcRegistry[WndProcRegistryCache].Handler;
+    Exit;
+  End;
+
+  For I := Low(WndProcRegistry) To High(WndProcRegistry) Do
+    If WndProcRegistry[I].WindowHandle = AWindowHandle Then
+    Begin
+      Result := WndProcRegistry[I].Handler;
+      WndProcRegistryCache := I;
+      Exit;
+    End;
+  Result := Nil;
+End;
+
+Function WinCEWindowProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT; CDecl;
+
+Var
+  Handler : TWinCEWndProc;
+
+Begin
+  Handler := WndProcFind(Ahwnd);
+  If Handler <> Nil Then
+    Result := Handler(Ahwnd, AuMsg, AwParam, AlParam)
+  Else
+    Result := DefWindowProcW(Ahwnd, AuMsg, AwParam, AlParam);
+End;
+
+Constructor TWinCEWindow.Create(Const AClassName, ATitle : WideString;
+                                AExStyle, AStyle : DWord;
+				AShow, AX, AY, AWidth, AHeight : Integer;
+                                AWndProc : TWinCEWndProc;
+				AData : Pointer = Nil);
+
+Var
+  ClassAtom : ATOM;
+  wc : WNDCLASSW;
+  ProgramInstance : HANDLE;
+  Rectangle : RECT;
+  X, Y, Width, Height : Integer;
+
+Begin
+  ProgramInstance := GetModuleHandleW(Nil);
+  If ProgramInstance = 0 Then
+    Raise TPTCError.Create('could not get module handle');
+
+  LOG('registering window class');
+  FillChar(wc, SizeOf(wc), 0);
+  wc.style := CS_DBLCLKS{ Or CS_HREDRAW Or CS_VREDRAW};
+  wc.lpfnWndProc := @WinCEWindowProc;
+  wc.cbClsExtra := 0;
+  wc.cbWndExtra := 0;
+  wc.hInstance := ProgramInstance;
+  wc.hIcon := 0; { not supported by WinCE }
+  wc.hCursor := 0;
+  wc.hbrBackground := 0;
+  wc.lpszMenuName := Nil;
+  wc.lpszClassName := PWideChar(AClassName);
+  ClassAtom := RegisterClassW(@wc);
+  If ClassAtom = 0 Then
+    Raise TPTCError.Create('could not register window class');
+  FClassName := AClassName;
+  FClassHInstance := wc.hInstance;
+
+  With Rectangle Do
+  Begin
+    left := 0;
+    top := 0;
+    right := AWidth;
+    bottom := AHeight;
+  End;
+  If Not AdjustWindowRectEx(@Rectangle, AStyle, False, AExStyle) Then
+    Raise TPTCError.Create('could not AdjustWindowRectEx');
+
+  X := AX;
+  Y := AY;
+  Width := Rectangle.right - Rectangle.left;
+  Height := Rectangle.bottom - Rectangle.top;
+
+  FWindow := CreateWindowExW(AExStyle,
+                             PWideChar(AClassName),
+			     PWideChar(ATitle),
+			     AStyle,
+			     X, Y, Width, Height,
+			     0, 0, 0,
+			     AData);
+  If (FWindow = 0) Or Not IsWindow(FWindow) Then
+    Raise TPTCError.Create('could not create window');
+  LOG('installing window message handler');
+  WndProcAdd(FWindow, AWndProc);
+  ShowWindow(FWindow, AShow);
+  If SetFocus(FWindow) = 0 Then
+    Raise TPTCError.Create('could not set focus to the new window');
+  If SetActiveWindow(FWindow) = 0 Then
+    Raise TPTCError.Create('could not set active window');
+  If Not SetForegroundWindow(FWindow) Then
+    Raise TPTCError.Create('could not set foreground window');
+  {...}
+End;
+
+Destructor TWinCEWindow.Destroy;
+
+Begin
+  Close;
+  Inherited Destroy;
+End;
+
+Procedure TWinCEWindow.Close;
+
+Begin
+  If (FWindow <> 0) And IsWindow(FWindow) Then
+  Begin
+    WndProcRemove(FWindow);
+    DestroyWindow(FWindow);
+  End;
+  FWindow := 0;
+
+  If FClassName <> '' Then
+    UnregisterClass(PWideChar(FClassName), FClassHInstance);
+  FClassName := '';
+End;
+
+Procedure TWinCEWindow.Update;
+
+Var
+  Message : MSG;
+
+Begin
+  While PeekMessage(@Message, FWindow, 0, 0, PM_REMOVE) Do
+  Begin
+    TranslateMessage(@Message);
+    DispatchMessage(@Message);
+  End;
+End;

packages/extra/ptc/wince/gapi/p_gx.pp

@@ -0,0 +1,96 @@
+Unit p_gx;
+
+{$MODE objfpc}
+
+{ convention is cdecl for WinCE API}
+{$calling cdecl}
+
+Interface
+
+Uses
+  Windows;
+
+Const
+  GXDLL = 'gx';
+
+Type
+  GXDisplayProperties = Record
+    cxWidth : DWord;
+    cyHeight : DWord;            // notice lack of 'th' in the word height.
+    cbxPitch : LONG;             // number of bytes to move right one x pixel - can be negative.
+    cbyPitch : LONG;             // number of bytes to move down one y pixel - can be negative.
+    cBPP : LONG;                 // # of bits in each pixel
+    ffFormat : DWord;            // format flags.
+  End;
+
+  GXKeyList = Record
+    vkUp : SHORT;             // key for up
+    ptUp : POINT;             // x,y position of key/button.  Not on screen but in screen coordinates.
+    vkDown : SHORT;
+    ptDown : POINT;
+    vkLeft : SHORT;
+    ptLeft : POINT;
+    vkRight : SHORT;
+    ptRight : POINT;
+    vkA : SHORT;
+    ptA : POINT;
+    vkB : SHORT;
+    ptB : POINT;
+    vkC : SHORT;
+    ptC : POINT;
+    vkStart : SHORT;
+    ptStart : POINT;
+  End;
+
+Function GXOpenDisplay(AhWnd : HWND; dwFlags : DWORD) : Integer; External GXDLL Name '?GXOpenDisplay@@YAHPAUHWND__@@K@Z';
+Function GXCloseDisplay : Integer; External GXDLL Name '?GXCloseDisplay@@YAHXZ';
+Function GXBeginDraw : Pointer; External GXDLL Name '?GXBeginDraw@@YAPAXXZ';
+Function GXEndDraw : Integer; External GXDLL Name '?GXEndDraw@@YAHXZ';
+Function GXOpenInput : Integer; External GXDLL Name '?GXOpenInput@@YAHXZ';
+Function GXCloseInput : Integer; External GXDLL Name '?GXCloseInput@@YAHXZ';
+Function GXGetDisplayProperties : GXDisplayProperties; External GXDLL Name '?GXGetDisplayProperties@@YA?AUGXDisplayProperties@@XZ';
+Function GXGetDefaultKeys(iOptions : Integer) : GXKeyList; External GXDLL Name '?GXGetDefaultKeys@@YA?AUGXKeyList@@H@Z';
+Function GXSuspend : Integer; External GXDLL Name '?GXSuspend@@YAHXZ';
+Function GXResume : Integer; External GXDLL Name '?GXResume@@YAHXZ';
+Function GXSetViewport(dwTop, dwHeight, dwReserved1, dwReserved2 : DWORD) : Integer; External GXDLL Name '?GXSetViewport@@YAHKKKK@Z';
+Function GXIsDisplayDRAMBuffer : BOOL; External GXDLL Name '?GXIsDisplayDRAMBuffer@@YAHXZ';
+
+
+// Although these flags can be unrelated they still
+// have unique values.
+
+Const
+  GX_FULLSCREEN    = $01;        // for OpenDisplay()
+  GX_NORMALKEYS    = $02;
+  GX_LANDSCAPEKEYS = $03;
+
+  kfLandscape      = $8;        // Screen is rotated 270 degrees
+  kfPalette        = $10;       // Pixel values are indexes into a palette
+  kfDirect         = $20;       // Pixel values contain actual level information
+  kfDirect555      = $40;       // 5 bits each for red, green and blue values in a pixel.
+  kfDirect565      = $80;       // 5 red bits, 6 green bits and 5 blue bits per pixel
+  kfDirect888      = $100;      // 8 bits each for red, green and blue values in a pixel.
+  kfDirect444      = $200;      // 4 red, 4 green, 4 blue
+  kfDirectInverted = $400;
+
+  GETRAWFRAMEBUFFER = $00020001;
+
+Type
+  RawFrameBufferInfo = Record
+    wFormat : WORD;
+    wBPP : WORD;
+    pFramePointer : Pointer;
+    cxStride : Integer;
+    cyStride : Integer;
+    cxPixels : Integer;
+    cyPixels : Integer;
+  End;
+
+Const
+  FORMAT_565   = 1;
+  FORMAT_555   = 2;
+  FORMAT_OTHER = 3;
+
+Implementation
+
+End.

packages/extra/ptc/wince/gapi/wincegapiconsoled.inc

@@ -0,0 +1,103 @@
+Type
+  TWinCEGAPIConsole = Class(TPTCBaseConsole)
+  Private
+    FWindow : TWinCEWindow;
+    FKeyboard : TWinCEKeyboard;
+    FMouse : TWinCEMouse;
+
+    FGXDisplayProperties : GXDisplayProperties;
+
+    FCopy : TPTCCopy;
+    FClear : TPTCClear;
+    FArea : TPTCArea;
+    FClip : TPTCArea;
+    FEventQueue : TEventQueue;
+    FModes : Array[0..1] Of TPTCMode;
+
+    FOpen : Boolean;
+    FLocked : Boolean;
+
+    FGXDisplayIsOpen : Boolean;
+
+    FTitle : String;
+
+    FDisplayWidth : Integer;
+    FDisplayHeight : Integer;
+    FDisplayPitch : Integer;
+    FDisplayFormat : TPTCFormat;
+
+    Function WndProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT;
+
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+    Function GetPitch : Integer; Override;
+    Function GetArea : TPTCArea; Override;
+    Function GetFormat : TPTCFormat; Override;
+    Function GetPages : Integer; Override;
+    Function GetName : String; Override;
+    Function GetTitle : String; Override;
+    Function GetInformation : String; Override;
+
+    Procedure CheckOpen(    AMessage : String);
+    Procedure CheckUnlocked(AMessage : String);
+  Public
+    Constructor Create; Override;
+    Destructor Destroy; Override;
+
+    Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat;
+                   APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; AWidth, AHeight : Integer;
+                   Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; Const AMode : TPTCMode;
+                   APages : Integer = 0); Overload; Override;
+    Procedure Close; Override;
+
+    Procedure Copy(Var ASurface : TPTCBaseSurface); Override;
+    Procedure Copy(Var ASurface : TPTCBaseSurface;
+                   Const ASource, ADestination : TPTCArea); Override;
+
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Override;
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Override;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Override;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Override;
+
+    Function Lock : Pointer; Override;
+    Procedure Unlock; Override;
+
+    Procedure Clear; Override;
+    Procedure Clear(Const AColor : TPTCColor); Override;
+    Procedure Clear(Const AColor : TPTCColor;
+                    Const AArea : TPTCArea); Override;
+
+    Procedure Configure(Const AFileName : String); Override;
+    Function Option(Const AOption : String) : Boolean; Override;
+
+    Procedure Palette(Const APalette : TPTCPalette); Override;
+    Procedure Clip(Const AArea : TPTCArea); Override;
+    Function Clip : TPTCArea; Override;
+    Function Palette : TPTCPalette; Override;
+    Function Modes : PPTCMode; Override;
+
+    Procedure Flush; Override;
+    Procedure Finish; Override;
+    Procedure Update; Override;
+    Procedure Update(Const AArea : TPTCArea); Override;
+
+    Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override;
+  End;

packages/extra/ptc/wince/gapi/wincegapiconsolei.inc

@@ -0,0 +1,559 @@
+Constructor TWinCEGAPIConsole.Create;
+
+Begin
+  Inherited Create;
+
+  FCopy := TPTCCopy.Create;
+  FClear := TPTCClear.Create;
+  FArea := TPTCArea.Create;
+  FClip := TPTCArea.Create;
+
+  LOG('getting display properties');
+  FGXDisplayProperties := GXGetDisplayProperties;
+  LOG('width='  + IntToStr(FGXDisplayProperties.cxWidth ));
+  LOG('height=' + IntToStr(FGXDisplayProperties.cyHeight));
+  LOG('xpitch=' + IntToStr(FGXDisplayProperties.cbxPitch));
+  LOG('ypitch=' + IntToStr(FGXDisplayProperties.cbyPitch));
+  LOG('BPP='    + IntToStr(FGXDisplayProperties.cBPP    ));
+  LOG('format=' + IntToStr(FGXDisplayProperties.ffFormat));
+
+  FDisplayWidth := FGXDisplayProperties.cxWidth;
+  FDisplayHeight := FGXDisplayProperties.cyHeight;
+  FDisplayPitch := FGXDisplayProperties.cbyPitch;
+//  FDisplayFormat := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+  FDisplayFormat := TPTCFormat.Create(16, $F800, $07E0, $001F); {hardcoded for now...}
+
+  FModes[0] := TPTCMode.Create(FDisplayWidth, FDisplayHeight, FDisplayFormat);
+  FModes[1] := TPTCMode.Create;
+End;
+
+Destructor TWinCEGAPIConsole.Destroy;
+
+Var
+  I : Integer;
+
+Begin
+  Close;
+
+  FCopy.Free;
+  FClear.Free;
+  FArea.Free;
+  FClip.Free;
+  FDisplayFormat.Free;
+
+  For I := Low(FModes) To High(FModes) Do
+    FModes[I].Free;
+
+  Inherited Destroy;
+End;
+
+Procedure TWinCEGAPIConsole.Open(Const ATitle : String; APages : Integer = 0);
+
+Begin
+  Open(ATitle, FDisplayFormat, APages);
+End;
+
+Procedure TWinCEGAPIConsole.Open(Const ATitle : String; Const AFormat : TPTCFormat;
+                                 APages : Integer = 0);
+
+Begin
+  Open(ATitle, FDisplayWidth, FDisplayHeight, AFormat, APages);
+End;
+
+Procedure TWinCEGAPIConsole.Open(Const ATitle : String; Const AMode : TPTCMode;
+                                 APages : Integer = 0);
+
+Begin
+  Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages);
+End;
+
+Procedure TWinCEGAPIConsole.Open(Const ATitle : String; AWidth, AHeight : Integer;
+                                 Const AFormat : TPTCFormat; APages : Integer = 0);
+
+Var
+  tmp : TPTCArea;
+
+Begin
+  LOG('TWinCEGAPIConsole.Open');
+
+  If FOpen Then
+    Close;
+
+  Try
+    LOG('creating window');
+    FWindow := TWinCEWindow.Create('PTC_GAPI_FULLSCREEN',
+                                   ATitle,
+                                   0,
+                                   WS_VISIBLE {Or WS_SYSMENU Or WS_CAPTION},
+                                   SW_SHOWNORMAL,
+                                   CW_USEDEFAULT, CW_USEDEFAULT,
+                                   FDisplayWidth, FDisplayHeight,
+				   @WndProc);
+    LOG('window created successfully');
+
+    LOG('opening display');
+    If GXOpenDisplay(FWindow.WindowHandle, GX_FULLSCREEN) <> 0 Then
+      FGXDisplayIsOpen := True {success!!!}
+    Else
+      Raise TPTCError.Create('could not open display');
+
+    tmp := TPTCArea.Create(0, 0, FDisplayWidth, FDisplayHeight);
+    Try
+      FArea.Assign(tmp);
+      FClip.Assign(tmp);
+    Finally
+      tmp.Free;
+    End;
+
+    FEventQueue := TEventQueue.Create;
+    FKeyboard := TWinCEKeyboard.Create(FEventQueue);
+    FMouse := TWinCEMouse.Create(FEventQueue, True, FDisplayWidth, FDisplayHeight);
+
+    If {m_primary.m_fullscreen}True Then
+      FMouse.SetWindowArea(0, 0, FDisplayWidth, FDisplayHeight);
+
+    FWindow.Update;
+
+    FOpen := True;
+  Except
+    On error : TObject Do
+    Begin
+      Close;
+      Raise;
+    End;
+  End;
+End;
+
+Procedure TWinCEGAPIConsole.Close;
+
+Begin
+  LOG('TWinCEGAPIConsole.Close');
+
+  If FGXDisplayIsOpen Then;
+    GXCloseDisplay;
+  FGXDisplayIsOpen := False;
+
+  FreeAndNil(FKeyboard);
+  FreeAndNil(FMouse);
+  FreeAndNil(FWindow);
+  FreeAndNil(FEventQueue);
+
+  FOpen := False;
+End;
+
+Procedure TWinCEGAPIConsole.Copy(Var ASurface : TPTCBaseSurface);
+
+Begin
+End;
+
+Procedure TWinCEGAPIConsole.Copy(Var ASurface : TPTCBaseSurface;
+                                 Const ASource, ADestination : TPTCArea);
+
+Begin
+End;
+
+Procedure TWinCEGAPIConsole.Load(Const APixels : Pointer;
+                                 AWidth, AHeight, APitch : Integer;
+                                 Const AFormat : TPTCFormat;
+                                 Const APalette : TPTCPalette);
+Var
+  Area_ : TPTCArea;
+  console_pixels : Pointer;
+
+Begin
+  CheckOpen(    'TWinCEGAPIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)');
+  CheckUnlocked('TWinCEGAPIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)');
+  If Clip.Equals(Area) Then
+  Begin
+    Try
+      console_pixels := Lock;
+      Try
+        FCopy.Request(AFormat, Format);
+        FCopy.Palette(APalette, Palette);
+        FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, console_pixels, 0, 0,
+                    Width, Height, Pitch);
+      Finally
+        Unlock;
+      End;
+    Except
+      On error : TPTCError Do
+        Raise TPTCError.Create('failed to load pixels to console', error);
+    End;
+  End
+  Else
+  Begin
+    Area_ := TPTCArea.Create(0, 0, width, height);
+    Try
+      Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, Area);
+    Finally
+      Area_.Free;
+    End;
+  End;
+End;
+
+Procedure TWinCEGAPIConsole.Load(Const APixels : Pointer;
+                                 AWidth, AHeight, APitch : Integer;
+                                 Const AFormat : TPTCFormat;
+                                 Const APalette : TPTCPalette;
+                                 Const ASource, ADestination : TPTCArea);
+Var
+  console_pixels : Pointer;
+  clipped_source, clipped_destination : TPTCArea;
+  tmp : TPTCArea;
+
+Begin
+  CheckOpen(    'TWinCEGAPIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)');
+  CheckUnlocked('TWinCEGAPIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)');
+  clipped_source := Nil;
+  clipped_destination := Nil;
+  Try
+    console_pixels := Lock;
+    Try
+      clipped_source := TPTCArea.Create;
+      clipped_destination := TPTCArea.Create;
+      tmp := TPTCArea.Create(0, 0, AWidth, AHeight);
+      Try
+        TPTCClipper.Clip(ASource, tmp, clipped_source, ADestination, Clip, clipped_destination);
+      Finally
+        tmp.Free;
+      End;
+      FCopy.request(AFormat, Format);
+      FCopy.palette(APalette, Palette);
+      FCopy.copy(APixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, APitch,
+                 console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, Pitch);
+    Finally
+      Unlock;
+      clipped_source.Free;
+      clipped_destination.Free;
+    End;
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create('failed to load pixels to console area', error);
+  End;
+End;
+
+Procedure TWinCEGAPIConsole.Save(APixels : Pointer;
+                                 AWidth, AHeight, APitch : Integer;
+                                 Const AFormat : TPTCFormat;
+                                 Const APalette : TPTCPalette);
+
+Begin
+End;
+
+Procedure TWinCEGAPIConsole.Save(APixels : Pointer;
+                                 AWidth, AHeight, APitch : Integer;
+                                 Const AFormat : TPTCFormat;
+                                 Const APalette : TPTCPalette;
+                                 Const ASource, ADestination : TPTCArea);
+
+Begin
+End;
+
+Function TWinCEGAPIConsole.Lock : Pointer;
+
+Begin
+  CheckUnlocked('display already locked');
+  Result := GXBeginDraw;
+
+  If Result = Nil Then
+    Raise TPTCError.Create('the display cannot be locked');
+
+  FLocked := True;
+End;
+
+Procedure TWinCEGAPIConsole.Unlock;
+
+Begin
+  If Not FLocked Then
+    Raise TPTCError.Create('display is not locked');
+
+  If GXEndDraw = 0 Then
+    Raise TPTCError.Create('could not unlock display');
+
+  FLocked := False;
+End;
+
+Procedure TWinCEGAPIConsole.Clear;
+
+Begin
+End;
+
+Procedure TWinCEGAPIConsole.Clear(Const AColor : TPTCColor);
+
+Begin
+End;
+
+Procedure TWinCEGAPIConsole.Clear(Const AColor : TPTCColor;
+                    Const AArea : TPTCArea);
+
+Begin
+End;
+
+Procedure TWinCEGAPIConsole.Configure(Const AFileName : String);
+
+Var
+  F : Text;
+  S : String;
+
+Begin
+  AssignFile(F, AFileName);
+  {$I-}
+  Reset(F);
+  {$I+}
+  If IOResult <> 0 Then
+    Exit;
+  While Not EoF(F) Do
+  Begin
+    {$I-}
+    Readln(F, S);
+    {$I+}
+    If IOResult <> 0 Then
+      Break;
+    Option(S);
+  End;
+  CloseFile(F);
+End;
+
+Function TWinCEGAPIConsole.Option(Const AOption : String) : Boolean;
+
+Begin
+  LOG('console option', AOption);
+
+  // todo...
+
+  Result := FCopy.Option(AOption);
+End;
+
+Procedure TWinCEGAPIConsole.Palette(Const APalette : TPTCPalette);
+
+Begin
+End;
+
+Procedure TWinCEGAPIConsole.Clip(Const AArea : TPTCArea);
+
+Var
+  tmp : TPTCArea;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.Clip(AArea)');
+
+  tmp := TPTCClipper.Clip(AArea, FArea);
+  Try
+    FClip.Assign(tmp);
+  Finally
+    tmp.Free;
+  End;
+End;
+
+Function TWinCEGAPIConsole.Clip : TPTCArea;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.Clip');
+  Result := FClip;
+End;
+
+Function TWinCEGAPIConsole.Palette : TPTCPalette;
+
+Begin
+End;
+
+Function TWinCEGAPIConsole.Modes : PPTCMode;
+
+Begin
+  Result := @FModes[0];
+End;
+
+Function TWinCEGAPIConsole.WndProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT;
+
+Begin
+  Case AuMsg Of
+  WM_CLOSE : Begin
+    LOG('TWinCEGAPIConsole.WndProc: WM_CLOSE');
+    Halt(0);
+  End;
+  WM_KILLFOCUS : Begin
+    LOG('TWinCEGAPIConsole.WndProc: WM_KILLFOCUS');
+    If FGXDisplayIsOpen Then
+      GXSuspend;
+    Result := 0;
+    Exit;
+  End;
+  WM_SETFOCUS : Begin
+    LOG('TWinCEGAPIConsole.WndProc: WM_SETFOCUS');
+    If FGXDisplayIsOpen Then
+      GXResume;
+    Result := 0;
+    Exit;
+  End;
+  WM_KEYDOWN, WM_KEYUP : Begin
+    If FKeyboard <> Nil Then
+      Result := FKeyboard.WndProc(Ahwnd, AuMsg, AwParam, AlParam)
+    Else
+      Result := 0;
+    Exit;
+  End;
+  WM_MOUSEMOVE,
+  WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK,
+  WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK,
+  WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK : Begin
+    If FMouse <> Nil Then
+      Result := FMouse.WndProc(Ahwnd, AuMsg, AwParam, AlParam)
+    Else
+      Result := 0;
+    Exit;
+  End;
+
+  Else
+    Result := DefWindowProcW(Ahwnd, AuMsg, AwParam, AlParam);
+  End;
+End;
+
+Procedure TWinCEGAPIConsole.Flush;
+
+Begin
+  CheckOpen    ('TWinCEGAPIConsole.Flush');
+  CheckUnlocked('TWinCEGAPIConsole.Flush');
+
+  Update;
+End;
+
+Procedure TWinCEGAPIConsole.Finish;
+
+Begin
+  CheckOpen    ('TWinCEGAPIConsole.Finish');
+  CheckUnlocked('TWinCEGAPIConsole.Finish');
+
+  Update;
+End;
+
+Procedure TWinCEGAPIConsole.Update;
+
+Begin
+  CheckOpen    ('TWinCEGAPIConsole.Update');
+  CheckUnlocked('TWinCEGAPIConsole.Update');
+
+  FWindow.Update;
+End;
+
+Procedure TWinCEGAPIConsole.Update(Const AArea : TPTCArea);
+
+Begin
+  Update;
+End;
+
+Function TWinCEGAPIConsole.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.NextEvent');
+//  CheckUnlocked('TWinCEGAPIConsole.NextEvent');
+
+  FreeAndNil(AEvent);
+  Repeat
+    { update window }
+    FWindow.Update;
+
+    { try to find an event that matches the EventMask }
+    AEvent := FEventQueue.NextEvent(AEventMask);
+  Until (Not AWait) Or (AEvent <> Nil);
+  Result := AEvent <> Nil;
+End;
+
+Function TWinCEGAPIConsole.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.PeekEvent');
+//  CheckUnlocked('TWinCEGAPIConsole.PeekEvent');
+
+  Repeat
+    { update window }
+    FWindow.Update;
+
+    { try to find an event that matches the EventMask }
+    Result := FEventQueue.PeekEvent(AEventMask);
+  Until (Not AWait) Or (Result <> Nil);
+End;
+
+Function TWinCEGAPIConsole.GetWidth : Integer;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.GetWidth');
+  Result := FDisplayWidth;
+End;
+
+Function TWinCEGAPIConsole.GetHeight : Integer;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.GetHeight');
+  Result := FDisplayHeight;
+End;
+
+Function TWinCEGAPIConsole.GetPitch : Integer;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.GetPitch');
+  Result := FDisplayPitch;
+End;
+
+Function TWinCEGAPIConsole.GetArea : TPTCArea;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.GetArea');
+  Result := FArea;
+End;
+
+Function TWinCEGAPIConsole.GetFormat : TPTCFormat;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.GetFormat');
+  Result := FDisplayFormat;
+End;
+
+Function TWinCEGAPIConsole.GetPages : Integer;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.GetPages');
+  Result := 1; {???}
+End;
+
+Function TWinCEGAPIConsole.GetName : String;
+
+Begin
+  Result := 'GAPI';
+End;
+
+Function TWinCEGAPIConsole.GetTitle : String;
+
+Begin
+  CheckOpen('TWinCEGAPIConsole.GetTitle');
+  Result := FTitle;
+End;
+
+Function TWinCEGAPIConsole.GetInformation : String;
+
+Begin
+  Result := ''; // todo...
+End;
+
+Procedure TWinCEGAPIConsole.CheckOpen(    AMessage : String);
+
+Begin
+  If Not FOpen Then
+  Try
+    Raise TPTCError.Create('console is not open');
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create(AMessage, error);
+  End;
+End;
+
+Procedure TWinCEGAPIConsole.CheckUnlocked(AMessage : String);
+
+Begin
+  If FLocked Then
+  Try
+    Raise TPTCError.Create('console is locked');
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create(AMessage, error);
+  End;
+End;

packages/extra/ptc/wince/gdi/wincebitmapinfod.inc

@@ -0,0 +1,17 @@
+Type
+  TWinCEBitmapInfo = Class(TObject)
+  Private
+    FBitmapInfo : PBITMAPINFO;
+//    FPixels : Pointer;
+    FFormat : TPTCFormat;
+    FWidth, FHeight, FPitch : Integer;
+  Public
+    Constructor Create(AWidth, AHeight : Integer);
+    Destructor Destroy; Override;
+    Property BMI : PBITMAPINFO Read FBitmapInfo;
+    Property Width : Integer Read FWidth;
+    Property Height : Integer Read FHeight;
+    Property Pitch : Integer Read FPitch;
+    Property Format : TPTCFormat Read FFormat;
+//    Property Pixels : Pointer Read FPixels;
+  End;

packages/extra/ptc/wince/gdi/wincebitmapinfoi.inc

@@ -0,0 +1,45 @@
+
+{TODO: create DIBs with the same color depth as the desktop}
+
+Constructor TWinCEBitmapInfo.Create(AWidth, AHeight : Integer);
+
+Begin
+  FBitmapInfo := GetMem(SizeOf(BITMAPINFOHEADER) + 12);
+
+  FillChar(FBitmapInfo^.bmiHeader, SizeOf(BITMAPINFOHEADER), 0);
+  With FBitmapInfo^.bmiHeader Do
+  Begin
+    biSize := SizeOf(BITMAPINFOHEADER);
+    biWidth := AWidth;
+    biHeight := -AHeight;
+    biPlanes := 1;
+    biBitCount := 32;
+    biCompression := BI_BITFIELDS;
+    biSizeImage := 0;
+    biXPelsPerMeter := 0;
+    biYPelsPerMeter := 0;
+    biClrUsed := 0;
+    biClrImportant := 0;
+  End;
+
+  PDWord(@FBitmapInfo^.bmiColors)[0] := $FF0000;
+  PDWord(@FBitmapInfo^.bmiColors)[1] := $00FF00;
+  PDWord(@FBitmapInfo^.bmiColors)[2] := $0000FF;
+
+  FWidth := AWidth;
+  FHeight := AHeight;
+  FFormat := TPTCFormat.Create(32, $FF0000, $FF00, $FF);
+  FPitch := FWidth * 4;
+
+//  FPixels := GetMem(AWidth * AHeight * 4);
+//  FillChar(FPixels^, AWidth * AHeight * 4, 0);
+End;
+
+Destructor TWinCEBitmapInfo.Destroy;
+
+Begin
+//  FreeMem(FPixels);
+  FreeMem(FBitmapInfo);
+  FFormat.Free;
+  Inherited Destroy;
+End;

packages/extra/ptc/wince/gdi/wincegdiconsoled.inc

@@ -0,0 +1,100 @@
+Type
+  TWinCEGDIConsole = Class(TPTCBaseConsole)
+  Private
+    FWindow : TWinCEWindow;
+    FBitmap : HBitmap;
+    FBitmapInfo : TWinCEBitmapInfo;
+    FBitmapPixels : Pointer;
+    FKeyboard : TWinCEKeyboard;
+    FMouse : TWinCEMouse;
+
+    FCopy : TPTCCopy;
+    FClear : TPTCClear;
+    FArea : TPTCArea;
+    FClip : TPTCArea;
+    FEventQueue : TEventQueue;
+
+    FOpen : Boolean;
+    FLocked : Boolean;
+
+    FTitle : String;
+
+    FDefaultWidth : Integer;
+    FDefaultHeight : Integer;
+    FDefaultFormat : TPTCFormat;
+
+    Function WndProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT;
+
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+    Function GetPitch : Integer; Override;
+    Function GetArea : TPTCArea; Override;
+    Function GetFormat : TPTCFormat; Override;
+    Function GetPages : Integer; Override;
+    Function GetName : String; Override;
+    Function GetTitle : String; Override;
+    Function GetInformation : String; Override;
+
+    Procedure CheckOpen(    AMessage : String);
+    Procedure CheckUnlocked(AMessage : String);
+  Public
+    Constructor Create; Override;
+    Destructor Destroy; Override;
+
+    Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat;
+                   APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; AWidth, AHeight : Integer;
+                   Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; Const AMode : TPTCMode;
+                   APages : Integer = 0); Overload; Override;
+    Procedure Close; Override;
+
+    Procedure Copy(Var ASurface : TPTCBaseSurface); Override;
+    Procedure Copy(Var ASurface : TPTCBaseSurface;
+                   Const ASource, ADestination : TPTCArea); Override;
+
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Override;
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Override;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Override;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Override;
+
+    Function Lock : Pointer; Override;
+    Procedure Unlock; Override;
+
+    Procedure Clear; Override;
+    Procedure Clear(Const AColor : TPTCColor); Override;
+    Procedure Clear(Const AColor : TPTCColor;
+                    Const AArea : TPTCArea); Override;
+
+    Procedure Configure(Const AFileName : String); Override;
+    Function Option(Const AOption : String) : Boolean; Override;
+
+    Procedure Palette(Const APalette : TPTCPalette); Override;
+    Procedure Clip(Const AArea : TPTCArea); Override;
+    Function Clip : TPTCArea; Override;
+    Function Palette : TPTCPalette; Override;
+    Function Modes : PPTCMode; Override;
+
+    Procedure Flush; Override;
+    Procedure Finish; Override;
+    Procedure Update; Override;
+    Procedure Update(Const AArea : TPTCArea); Override;
+
+    Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override;
+  End;

packages/extra/ptc/wince/gdi/wincegdiconsolei.inc

@@ -0,0 +1,565 @@
+Constructor TWinCEGDIConsole.Create;
+
+Begin
+  Inherited Create;
+
+  FDefaultWidth := 320;
+  FDefaultHeight := 200;
+  FDefaultFormat := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+
+  FCopy := TPTCCopy.Create;
+  FClear := TPTCClear.Create;
+  FArea := TPTCArea.Create;
+  FClip := TPTCArea.Create;
+End;
+
+Destructor TWinCEGDIConsole.Destroy;
+
+Begin
+  Close;
+
+  FWindow.Free;
+
+  FEventQueue.Free;
+  FCopy.Free;
+  FClear.Free;
+  FArea.Free;
+  FClip.Free;
+  FDefaultFormat.Free;
+
+  Inherited Destroy;
+End;
+
+Procedure TWinCEGDIConsole.Open(Const ATitle : String; APages : Integer = 0);
+
+Begin
+  Open(ATitle, FDefaultFormat, APages);
+End;
+
+Procedure TWinCEGDIConsole.Open(Const ATitle : String; Const AFormat : TPTCFormat;
+                                APages : Integer = 0);
+
+Begin
+  Open(ATitle, FDefaultWidth, FDefaultHeight, AFormat, APages);
+End;
+
+Procedure TWinCEGDIConsole.Open(Const ATitle : String; Const AMode : TPTCMode;
+                                APages : Integer = 0);
+
+Begin
+  Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages);
+End;
+
+Procedure TWinCEGDIConsole.Open(Const ATitle : String; AWidth, AHeight : Integer;
+                                Const AFormat : TPTCFormat; APages : Integer = 0);
+
+Var
+  DeviceContext : HDC;
+  tmp : TPTCArea;
+
+Begin
+  LOG('TWinCEGDIConsole.Open');
+
+  If FBitmap <> 0 Then
+  Begin
+    DeleteObject(FBitmap);
+    FBitmap := 0;
+  End;
+  FreeAndNil(FWindow);
+  FreeAndNil(FBitmapInfo);
+  FreeAndNil(FKeyboard);
+  FreeAndNil(FMouse);
+  FreeAndNil(FEventQueue);
+
+  LOG('creating window');
+  FWindow := TWinCEWindow.Create('PTC_GDI_WINDOWED_FIXED',
+                                 ATitle,
+                                 0,
+                                 WS_VISIBLE {Or WS_SYSMENU Or WS_CAPTION},
+                                 SW_SHOWNORMAL,
+                                 CW_USEDEFAULT, CW_USEDEFAULT,
+                                 AWidth, AHeight,
+				 @WndProc);
+  LOG('window created successfully');
+
+  FBitmapInfo := TWinCEBitmapInfo.Create(AWidth, AHeight);
+
+  LOG('trying to create a dib section');
+  DeviceContext := GetDC(FWindow.WindowHandle);
+  If DeviceContext = 0 Then
+    Raise TPTCError.Create('could not get device context of window');
+  FBitmap := CreateDIBSection(DeviceContext,
+                              FBitmapInfo.BMI^,
+                              DIB_RGB_COLORS,
+                              FBitmapPixels,
+                              0, 0);
+  ReleaseDC(FWindow.WindowHandle, DeviceContext);
+  If FBitmap = 0 Then
+    Raise TPTCError.Create('could not create dib section');
+
+  tmp := TPTCArea.Create(0, 0, AWidth, AHeight);
+  Try
+    FArea.Assign(tmp);
+    FClip.Assign(tmp);
+  Finally
+    tmp.Free;
+  End;
+
+  FEventQueue := TEventQueue.Create;
+  FKeyboard := TWinCEKeyboard.Create(FEventQueue);
+  FMouse := TWinCEMouse.Create(FEventQueue, False, AWidth, AHeight);
+
+  FWindow.Update;
+
+  {todo...}
+  FOpen := True;
+  LOG('console open succeeded');
+End;
+
+Procedure TWinCEGDIConsole.Close;
+
+Begin
+  LOG('TWinCEGDIConsole.Close');
+
+  FreeAndNil(FKeyboard);
+  FreeAndNil(FMouse);
+  FreeAndNil(FEventQueue);
+
+  FBitmapPixels := Nil; { just in case... }
+  FreeAndNil(FBitmapInfo);
+  If FBitmap <> 0 Then
+  Begin
+    DeleteObject(FBitmap);
+    FBitmap := 0;
+  End;
+  FreeAndNil(FWindow);
+
+  {todo...}
+
+  FOpen := False;
+End;
+
+Procedure TWinCEGDIConsole.Copy(Var ASurface : TPTCBaseSurface);
+
+Begin
+  {todo...}
+End;
+
+Procedure TWinCEGDIConsole.Copy(Var ASurface : TPTCBaseSurface;
+                                Const ASource, ADestination : TPTCArea);
+
+Begin
+  {todo...}
+End;
+
+Procedure TWinCEGDIConsole.Load(Const APixels : Pointer;
+                                AWidth, AHeight, APitch : Integer;
+                                Const AFormat : TPTCFormat;
+                                Const APalette : TPTCPalette);
+Var
+  Area_ : TPTCArea;
+  console_pixels : Pointer;
+
+Begin
+  CheckOpen(    'TWinCEGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)');
+  CheckUnlocked('TWinCEGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette)');
+  If Clip.Equals(Area) Then
+  Begin
+    Try
+      console_pixels := Lock;
+      Try
+        FCopy.Request(AFormat, Format);
+        FCopy.Palette(APalette, Palette);
+        FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, console_pixels, 0, 0,
+                    Width, Height, Pitch);
+      Finally
+        Unlock;
+      End;
+    Except
+      On error : TPTCError Do
+        Raise TPTCError.Create('failed to load pixels to console', error);
+    End;
+  End
+  Else
+  Begin
+    Area_ := TPTCArea.Create(0, 0, width, height);
+    Try
+      Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, Area);
+    Finally
+      Area_.Free;
+    End;
+  End;
+End;
+
+Procedure TWinCEGDIConsole.Load(Const APixels : Pointer;
+                                AWidth, AHeight, APitch : Integer;
+                                Const AFormat : TPTCFormat;
+                                Const APalette : TPTCPalette;
+                                Const ASource, ADestination : TPTCArea);
+Var
+  console_pixels : Pointer;
+  clipped_source, clipped_destination : TPTCArea;
+  tmp : TPTCArea;
+
+Begin
+  CheckOpen(    'TWinCEGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)');
+  CheckUnlocked('TWinCEGDIConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination)');
+  clipped_source := Nil;
+  clipped_destination := Nil;
+  Try
+    console_pixels := Lock;
+    Try
+      clipped_source := TPTCArea.Create;
+      clipped_destination := TPTCArea.Create;
+      tmp := TPTCArea.Create(0, 0, AWidth, AHeight);
+      Try
+        TPTCClipper.Clip(ASource, tmp, clipped_source, ADestination, Clip, clipped_destination);
+      Finally
+        tmp.Free;
+      End;
+      FCopy.request(AFormat, Format);
+      FCopy.palette(APalette, Palette);
+      FCopy.copy(APixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, APitch,
+                 console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, Pitch);
+    Finally
+      Unlock;
+      clipped_source.Free;
+      clipped_destination.Free;
+    End;
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create('failed to load pixels to console area', error);
+  End;
+End;
+
+Procedure TWinCEGDIConsole.Save(APixels : Pointer;
+                                AWidth, AHeight, APitch : Integer;
+                                Const AFormat : TPTCFormat;
+                                Const APalette : TPTCPalette);
+
+Begin
+  {todo...}
+End;
+
+Procedure TWinCEGDIConsole.Save(APixels : Pointer;
+                                AWidth, AHeight, APitch : Integer;
+                                Const AFormat : TPTCFormat;
+                                Const APalette : TPTCPalette;
+                                Const ASource, ADestination : TPTCArea);
+
+Begin
+  {todo...}
+End;
+
+Function TWinCEGDIConsole.Lock : Pointer;
+
+Begin
+  Result := FBitmapPixels; // todo...
+  FLocked := True;
+End;
+
+Procedure TWinCEGDIConsole.Unlock;
+
+Begin
+  FLocked := False;
+End;
+
+Procedure TWinCEGDIConsole.Clear;
+
+Begin
+  {todo...}
+End;
+
+Procedure TWinCEGDIConsole.Clear(Const AColor : TPTCColor);
+
+Begin
+  {todo...}
+End;
+
+Procedure TWinCEGDIConsole.Clear(Const AColor : TPTCColor;
+                                 Const AArea : TPTCArea);
+
+Begin
+  {todo...}
+End;
+
+Procedure TWinCEGDIConsole.Configure(Const AFileName : String);
+
+Var
+  F : Text;
+  S : String;
+
+Begin
+  AssignFile(F, AFileName);
+  {$I-}
+  Reset(F);
+  {$I+}
+  If IOResult <> 0 Then
+    Exit;
+  While Not EoF(F) Do
+  Begin
+    {$I-}
+    Readln(F, S);
+    {$I+}
+    If IOResult <> 0 Then
+      Break;
+    Option(S);
+  End;
+  CloseFile(F);
+End;
+
+Function TWinCEGDIConsole.Option(Const AOption : String) : Boolean;
+
+Begin
+  LOG('console option', AOption);
+
+  // todo...
+
+  Result := FCopy.Option(AOption);
+End;
+
+Procedure TWinCEGDIConsole.Palette(Const APalette : TPTCPalette);
+
+Begin
+  {todo...}
+End;
+
+Procedure TWinCEGDIConsole.Clip(Const AArea : TPTCArea);
+
+Var
+  tmp : TPTCArea;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.Clip(AArea)');
+
+  tmp := TPTCClipper.Clip(AArea, FArea);
+  Try
+    FClip.Assign(tmp);
+  Finally
+    tmp.Free;
+  End;
+End;
+
+Function TWinCEGDIConsole.Clip : TPTCArea;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.Clip');
+  Result := FClip;
+End;
+
+Function TWinCEGDIConsole.Palette : TPTCPalette;
+
+Begin
+  {todo...}
+End;
+
+Function TWinCEGDIConsole.Modes : PPTCMode;
+
+Begin
+  // todo...
+  Result := Nil;
+End;
+
+Procedure TWinCEGDIConsole.Flush;
+
+Begin
+  {todo...}
+End;
+
+Procedure TWinCEGDIConsole.Finish;
+
+Begin
+  {todo...}
+End;
+
+Function TWinCEGDIConsole.WndProc(Ahwnd : HWND; AuMsg : UINT; AwParam : WPARAM; AlParam : LPARAM) : LRESULT;
+
+Begin
+  Case AuMsg Of
+  WM_CLOSE : Begin
+    LOG('TWinCEGDIConsole.WndProc: WM_CLOSE');
+    Halt(0);
+  End;
+  WM_KEYDOWN, WM_KEYUP : Begin
+    If FKeyboard <> Nil Then
+      Result := FKeyboard.WndProc(Ahwnd, AuMsg, AwParam, AlParam)
+    Else
+      Result := 0;
+    Exit;
+  End;
+  WM_MOUSEMOVE,
+  WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK,
+  WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK,
+  WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK : Begin
+    If FMouse <> Nil Then
+      Result := FMouse.WndProc(Ahwnd, AuMsg, AwParam, AlParam)
+    Else
+      Result := 0;
+    Exit;
+  End;
+  Else
+    Result := DefWindowProcW(Ahwnd, AuMsg, AwParam, AlParam);
+  End;
+End;
+
+Procedure TWinCEGDIConsole.Update;
+
+Var
+  ClientRect : RECT;
+  DeviceContext, DeviceContext2 : HDC;
+
+Begin
+  CheckOpen(    'TWinCEGDIConsole.Update');
+  CheckUnlocked('TWinCEGDIConsole.Update');
+
+  FWindow.Update;
+
+  DeviceContext := GetDC(FWindow.WindowHandle);
+
+  If DeviceContext <> 0 Then
+  Begin
+    If GetClientRect(FWindow.WindowHandle, @ClientRect) Then
+    Begin
+      DeviceContext2 := CreateCompatibleDC(DeviceContext);
+      If DeviceContext2 <> 0 Then
+      Begin
+        SelectObject(DeviceContext2, FBitmap);
+
+	StretchBlt(DeviceContext,
+	           0, 0, ClientRect.right, ClientRect.bottom,
+		   DeviceContext2,
+		   0, 0, FBitmapInfo.Width, FBitmapInfo.Height,
+		   SRCCOPY);
+
+        DeleteDC(DeviceContext2);
+      End;
+    End;
+
+    ReleaseDC(FWindow.WindowHandle, DeviceContext);
+  End;
+End;
+
+Procedure TWinCEGDIConsole.Update(Const AArea : TPTCArea);
+
+Begin
+  {todo...}
+  Update;
+End;
+
+Function TWinCEGDIConsole.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.NextEvent');
+//  CheckUnlocked('TWinCEGDIConsole.NextEvent');
+
+  FreeAndNil(AEvent);
+  Repeat
+    { update window }
+    FWindow.Update;
+
+    { try to find an event that matches the EventMask }
+    AEvent := FEventQueue.NextEvent(AEventMask);
+  Until (Not AWait) Or (AEvent <> Nil);
+  Result := AEvent <> Nil;
+End;
+
+Function TWinCEGDIConsole.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.PeekEvent');
+//  CheckUnlocked('TWinCEGDIConsole.PeekEvent');
+
+  Repeat
+    { update window }
+    FWindow.Update;
+
+    { try to find an event that matches the EventMask }
+    Result := FEventQueue.PeekEvent(AEventMask);
+  Until (Not AWait) Or (Result <> Nil);
+End;
+
+Function TWinCEGDIConsole.GetWidth : Integer;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.GetWidth');
+  Result := FBitmapInfo.Width;
+End;
+
+Function TWinCEGDIConsole.GetHeight : Integer;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.GetHeight');
+  Result := FBitmapInfo.Height;
+End;
+
+Function TWinCEGDIConsole.GetPitch : Integer;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.GetPitch');
+  Result := FBitmapInfo.Pitch;
+End;
+
+Function TWinCEGDIConsole.GetFormat : TPTCFormat;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.GetFormat');
+  Result := FBitmapInfo.Format;
+End;
+
+Function TWinCEGDIConsole.GetArea : TPTCArea;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.GetArea');
+  Result := FArea;
+End;
+
+Function TWinCEGDIConsole.GetPages : Integer;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.GetPages');
+  Result := 2;
+End;
+
+Function TWinCEGDIConsole.GetName : String;
+
+Begin
+  Result := 'WinCE';
+End;
+
+Function TWinCEGDIConsole.GetTitle : String;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.GetTitle');
+  Result := FTitle;
+End;
+
+Function TWinCEGDIConsole.GetInformation : String;
+
+Begin
+  CheckOpen('TWinCEGDIConsole.GetInformation');
+  Result := ''; // todo...
+End;
+
+Procedure TWinCEGDIConsole.CheckOpen(AMessage : String);
+
+Begin
+  If Not FOpen Then
+  Try
+    Raise TPTCError.Create('console is not open');
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create(AMessage, error);
+  End;
+End;
+
+Procedure TWinCEGDIConsole.CheckUnlocked(AMessage : String);
+
+Begin
+  If FLocked Then
+  Try
+    Raise TPTCError.Create('console is locked');
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create(AMessage, error);
+  End;
+End;

packages/extra/ptc/wince/includes.inc

@@ -0,0 +1,13 @@
+{$INCLUDE base/wincewindowd.inc}
+{$INCLUDE base/wincekeyboardd.inc}
+{$INCLUDE base/wincemoused.inc}
+{$INCLUDE gdi/wincebitmapinfod.inc}
+{$INCLUDE gdi/wincegdiconsoled.inc}
+{$INCLUDE gapi/wincegapiconsoled.inc}
+
+{$INCLUDE base/wincewindowi.inc}
+{$INCLUDE base/wincekeyboardi.inc}
+{$INCLUDE base/wincemousei.inc}
+{$INCLUDE gdi/wincebitmapinfoi.inc}
+{$INCLUDE gdi/wincegdiconsolei.inc}
+{$INCLUDE gapi/wincegapiconsolei.inc}

packages/extra/ptc/x11/check.inc

@@ -20,8 +20,8 @@
 
 Procedure X11Check(result : TStatus);
 
-Var
-  ErrStr : String;
+{Var
+  ErrStr : String;}
 
 Begin
   {todo: fix X11 error handling}

packages/extra/ptc/x11/console.inc

@@ -1,418 +0,0 @@
-Constructor TX11Console.Create;
-
-Var
-  s : AnsiString;
-
-Begin
-  x11disp := Nil;
-  m_flags := 0;
-  FillChar(m_modes, SizeOf(m_modes), 0);
-  m_title := '';
-  
-  m_modes[0] := TPTCMode.Create;
-  
-  configure('/usr/share/ptc/ptc.conf');
-  s := fpgetenv('HOME');
-  If s = '' Then
-    s := '/';
-  If s[Length(s)] <> '/' Then
-    s := s + '/';
-  s := s + '.ptc.conf';
-  configure(s);
-End;
-
-Destructor TX11Console.Destroy;
-
-Var
-  I : Integer;
-
-Begin
-  close;
-  m_title := '';
-  FreeAndNil(x11disp);
-  For I := Low(m_modes) To High(m_modes) Do
-    FreeAndNil(m_modes[I]);
-  Inherited Destroy;
-End;
-
-Procedure TX11Console.configure(Const _file : String);
-
-Var
-  F : Text;
-  S : String;
-
-Begin
-  ASSignFile(F, _file);
-  {$I-}
-  Reset(F);
-  {$I+}
-  If IOResult <> 0 Then
-    Exit;
-  While Not EoF(F) Do
-  Begin
-    {$I-}
-    Readln(F, S);
-    {$I+}
-    If IOResult <> 0 Then
-      Break;
-    option(S);
-  End;
-  CloseFile(F);
-End;
-
-Function TX11Console.option(Const _option : String) : Boolean;
-
-Begin
-  option := True;
-  If _option = 'dga pedantic init' Then
-  Begin
-    m_flags := m_flags Or PTC_X11_PEDANTIC_DGA;
-    Exit;
-  End;
-  If _option = 'dga off' Then
-  Begin
-    m_flags := m_flags Or PTC_X11_NODGA;
-    Exit;
-  End;
-  If _option = 'leave window open' Then
-  Begin
-    m_flags := m_flags Or PTC_X11_LEAVE_WINDOW;
-    Exit;
-  End;
-  If _option = 'leave display open' Then
-  Begin
-    m_flags := m_flags Or PTC_X11_LEAVE_DISPLAY;
-    Exit;
-  End;
-  If x11disp <> Nil Then
-    option := x11disp.m_copy.option(_option)
-  Else
-    option := False;
-End;
-
-Function TX11Console.modes : PPTCMode;
-
-Begin
-  modes := @m_modes;
-End;
-
-{TODO: Find current pixel depth}
-Procedure TX11Console.open(Const _title : String; _pages : Integer);
-
-Var
-  tmp : TPTCFormat;
-
-Begin
-  setTitle(_title);
-  tmp := TPTCFormat.Create(32, $FF0000, $FF00, $FF);
-  Try
-    open(_title, tmp, _pages);
-  Finally
-    tmp.Free;
-  End;
-End;
-
-Procedure TX11Console.open(Const _title : String; Const _format : TPTCFormat;
-		           _pages : Integer);
-
-Begin
-  setTitle(_title);
-  open(_title, 640, 480, _format, _pages);
-End;
-
-Procedure TX11Console.open(Const _title : String; _width, _height : Integer;
-		           Const _format : TPTCFormat; _pages : Integer);
-
-Var
-  disp : PDisplay;
-  screen : Integer;
-
-Begin
-  close;
-  setTitle(_title);
-  
-  { Check if we can open an X display }
-  disp := XOpenDisplay(Nil);
-  If disp = Nil Then
-    Raise TPTCError.Create('Cannot open X display');
-  
-  { DefaultScreen should be fine }
-  screen := DefaultScreen(disp);
-  
-  FreeAndNil(x11disp);
-  
-  {ifndef HAVE_DGA}
-  
-  If (m_flags And PTC_X11_NODGA) = 0 Then
-  Begin
-    Try
-      x11disp := TX11DGADisplay.Create;
-      x11disp.flags(m_flags Or PTC_X11_LEAVE_DISPLAY);
-      x11disp.open(_title, _width, _height, _format, disp, screen);
-      x11disp.flags(m_flags);
-    Except
-      FreeAndNil(x11disp);
-    End;
-  End;
-  
-  If x11disp = Nil Then
-  Begin
-    x11disp := TX11WindowDisplay.Create;
-    x11disp.flags(m_flags);
-    x11disp.open(_title, _width, _height, _format, disp, screen);
-  End;
-End;
-
-Procedure TX11Console.open(Const _title : String; Const _mode : TPTCMode;
-		           _pages : Integer);
-
-Begin
-  setTitle(_title);
-End;
-
-Procedure TX11Console.close;
-
-Begin
-  FreeAndNil(x11disp);
-End;
-
-Procedure TX11Console.flush;
-
-Begin
-  update;
-End;
-
-Procedure TX11Console.finish;
-
-Begin
-  update;
-End;
-
-Procedure TX11Console.update;
-
-Begin
-  x11disp.update;
-End;
-
-Procedure TX11Console.update(Const _area : TPTCArea);
-
-Begin
-  x11disp.update(_area);
-End;
-
-Procedure TX11Console.internal_ReadKey(k : TPTCKey);
-
-Begin
-  x11disp.internal_ReadKey(k);
-End;
-
-Function TX11Console.internal_PeekKey(k : TPTCKey) : Boolean;
-
-Begin
-  Result := x11disp.internal_PeekKey(k);
-End;
-
-Procedure TX11Console.copy(Var surface : TPTCBaseSurface);
-
-Begin
-  {todo!...}
-End;
-
-Procedure TX11Console.copy(Var surface : TPTCBaseSurface;
-		           Const source, destination : TPTCArea);
-
-Begin
-  {todo!...}
-End;
-
-Function TX11Console.lock : Pointer;
-
-Begin
-  lock := x11disp.lock;
-End;
-
-Procedure TX11Console.unlock;
-
-Begin
-  x11disp.unlock;
-End;
-
-Procedure TX11Console.load(Const pixels : Pointer;
-		           _width, _height, _pitch : Integer;
-		           Const _format : TPTCFormat;
-		           Const _palette : TPTCPalette);
-
-Begin
-  x11disp.load(pixels, _width, _height, _pitch, _format, _palette);
-End;
-
-Procedure TX11Console.load(Const pixels : Pointer;
-		           _width, _height, _pitch : Integer;
-		           Const _format : TPTCFormat;
-		           Const _palette : TPTCPalette;
-		           Const source, destination : TPTCArea);
-
-Begin
-  x11disp.load(pixels, _width, _height, _pitch, _format, _palette, source, destination);
-End;
-
-Procedure TX11Console.save(pixels : Pointer;
-		           _width, _height, _pitch : Integer;
-		           Const _format : TPTCFormat;
-		           Const _palette : TPTCPalette);
-
-Begin
-  {todo!...}
-End;
-
-Procedure TX11Console.save(pixels : Pointer;
-		           _width, _height, _pitch : Integer;
-		           Const _format : TPTCFormat;
-		           Const _palette : TPTCPalette;
-		           Const source, destination : TPTCArea);
-
-Begin
-  {todo!...}
-End;
-
-Procedure TX11Console.clear;
-
-Var
-  tmp : TPTCColor;
-
-Begin
-  If format.direct Then
-    tmp := TPTCColor.Create(0, 0, 0, 0)
-  Else
-    tmp := TPTCColor.Create(0);
-  Try
-    clear(tmp);
-  Finally
-    tmp.Free;
-  End;
-End;
-
-Procedure TX11Console.clear(Const color : TPTCColor);
-
-Begin
-  x11disp.clear(color);
-End;
-
-Procedure TX11Console.clear(Const color : TPTCColor;
-		            Const _area : TPTCArea);
-
-Begin
-  x11disp.clear(color, _area);
-End;
-
-Procedure TX11Console.palette(Const _palette : TPTCPalette);
-
-Begin
-  x11disp.palette(_palette);
-End;
-
-Function TX11Console.palette : TPTCPalette;
-
-Begin
-  palette := x11disp.palette;
-End;
-
-Procedure TX11Console.clip(Const _area : TPTCArea);
-
-Begin
-  x11disp.clip(_area);
-End;
-
-Function TX11Console.width : Integer;
-
-Begin
-  width := x11disp.width;
-End;
-
-Function TX11Console.height : Integer;
-
-Begin
-  height := x11disp.height;
-End;
-
-Function TX11Console.pitch : Integer;
-
-Begin
-  pitch := x11disp.pitch;
-End;
-
-Function TX11Console.pages : Integer;
-
-Begin
-  pages := 1;
-End;
-
-Function TX11Console.area : TPTCArea;
-
-Begin
-  area := x11disp.area;
-End;
-
-Function TX11Console.clip : TPTCArea;
-
-Begin
-  clip := x11disp.clip;
-End;
-
-Function TX11Console.format : TPTCFormat;
-
-Begin
-  format := x11disp.format;
-End;
-
-Function TX11Console.name : String;
-
-Begin
-  name := 'X11';
-End;
-
-Function TX11Console.title : String;
-
-Begin
-  title := m_title;
-End;
-
-Function TX11Console.information : String;
-
-Var
-  s : String;
-
-Begin
-  If x11disp = Nil Then
-    Exit('PTC X11');
-  information := 'PTC X11, ';
-  If x11disp Is TX11WindowDisplay Then
-  Begin
-    If TX11WindowDisplay(x11disp).m_primary <> Nil Then
-    Begin
-    {$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-      If TX11WindowDisplay(x11disp).m_primary Is TX11SHMImage Then
-        information := information + 'windowed (MIT-Shm) mode'
-      Else
-    {$ENDIF HAVE_X11_EXTENSIONS_XSHM}
-        information := information + 'windowed (XImage) mode';
-    End
-    Else
-      information := information + 'windowed mode';
-  End
-  Else
-    information := information + 'direct graphics access (DGA) mode';
-  information := information + ', ';
-  Str(x11disp.width, s);
-  information := information + s + 'x';
-  Str(x11disp.height, s);
-  information := information + s + ', ';
-  Str(x11disp.format.bits, s);
-  information := information + s + ' bit';
-End;
-
-Procedure TX11Console.setTitle(_title : String);
-
-Begin
-  m_title := _title;
-End;

packages/extra/ptc/x11/consoled.inc

@@ -1,77 +0,0 @@
-Const
-  PTC_X11_NODGA = 1;
-  PTC_X11_LEAVE_DISPLAY = 2;
-  PTC_X11_LEAVE_WINDOW = 4;
-  PTC_X11_PEDANTIC_DGA = 8;
-  PTC_X11_DITHER = 16;
-
-Type
-  TX11Console = Class(TPTCBaseConsole)
-  Private
-    Procedure setTitle(_title : String);
-    x11disp : TX11Display;
-    m_title : String;
-    m_flags : LongInt;
-    m_modes : Array[0..255] Of TPTCMode;
-  Protected
-    Procedure internal_ReadKey(k : TPTCKey); Override;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Override;
-  Public
-    Constructor Create;
-    Destructor Destroy; Override;
-    Procedure configure(Const _file : String); Override;
-    Function option(Const _option : String) : Boolean; Override;
-    Function modes : PPTCMode; Override;
-    Procedure open(Const _title : String; _pages : Integer); Overload; Override;
-    Procedure open(Const _title : String; Const _format : TPTCFormat;
-		   _pages : Integer); Overload; Override;
-    Procedure open(Const _title : String; _width, _height : Integer;
-		   Const _format : TPTCFormat; _pages : Integer); Overload; Override;
-    Procedure open(Const _title : String; Const _mode : TPTCMode;
-		   _pages : Integer); Overload; Override;
-    Procedure close; Override;
-    Procedure flush; Override;
-    Procedure finish; Override;
-    Procedure update; Override;
-    Procedure update(Const _area : TPTCArea); Override;
-    Procedure copy(Var surface : TPTCBaseSurface); Override;
-    Procedure copy(Var surface : TPTCBaseSurface;
-		   Const source, destination : TPTCArea); Override;
-    Function lock : Pointer; Override;
-    Procedure unlock; Override;
-    Procedure load(Const pixels : Pointer;
-		   _width, _height, _pitch : Integer;
-		   Const _format : TPTCFormat;
-		   Const _palette : TPTCPalette); Override;
-    Procedure load(Const pixels : Pointer;
-		   _width, _height, _pitch : Integer;
-		   Const _format : TPTCFormat;
-		   Const _palette : TPTCPalette;
-		   Const source, destination : TPTCArea); Override;
-    Procedure save(pixels : Pointer;
-		   _width, _height, _pitch : Integer;
-		   Const _format : TPTCFormat;
-		   Const _palette : TPTCPalette); Override;
-    Procedure save(pixels : Pointer;
-		   _width, _height, _pitch : Integer;
-		   Const _format : TPTCFormat;
-		   Const _palette : TPTCPalette;
-		   Const source, destination : TPTCArea); Override;
-    Procedure clear; Override;
-    Procedure clear(Const color : TPTCColor); Override;
-    Procedure clear(Const color : TPTCColor;
-		    Const _area : TPTCArea); Override;
-    Procedure palette(Const _palette : TPTCPalette); Override;
-    Function palette : TPTCPalette; Override;
-    Procedure clip(Const _area : TPTCArea); Override;
-    Function width : Integer; Override;
-    Function height : Integer; Override;
-    Function pitch : Integer; Override;
-    Function pages : Integer; Override;
-    Function area : TPTCArea; Override;
-    Function clip : TPTCArea; Override;
-    Function format : TPTCFormat; Override;
-    Function name : String; Override;
-    Function title : String; Override;
-    Function information : String; Override;
-  End;

packages/extra/ptc/x11/display.inc

@@ -1,397 +0,0 @@
-{$INCLUDE xunikey.inc}
-
-Constructor TX11Display.Create;
-
-Begin
-  m_disp := Nil;
-  m_colours := Nil;
-  m_cmap := 0;
-  m_flags := 0;
-  m_width := 0;
-  m_height := 0;
-  m_functionkeys := Nil;
-  m_normalkeys := Nil;
-  m_copy := Nil;
-  m_clear := Nil;
-  m_palette := Nil;
-  m_clip := Nil;
-  m_area := Nil;
-  m_format := Nil;
-  
-  m_copy := TPTCCopy.Create;
-  m_clear := TPTCClear.Create;
-  m_palette := TPTCPalette.Create;
-  m_clip := TPTCArea.Create;
-  m_area := TPTCArea.Create;
-  m_format := TPTCFormat.Create;
-  
-  setKeyMapping;
-End;
-
-Destructor TX11Display.Destroy;
-
-Begin
-//  Writeln('lll1');
-  { Just close the display, everything else is done by the subclasses }
-  If (m_disp <> Nil) And ((m_flags And PTC_X11_LEAVE_DISPLAY) = 0) Then
-  Begin
-//    Writeln('lalalalala1');
-    XFlush(m_disp);
-//    Writeln('lalalalala2');
-    XCloseDisplay(m_disp);
-//    Writeln('lalalalala3');
-    m_disp := Nil;
-//    Writeln('lalalalala4');
-  End;
-//  Writeln('lll2');
-  FreeMemAndNil(m_normalkeys);
-  FreeMemAndNil(m_functionkeys);
-//  Writeln('lll3');
-  
-  m_copy.Free;
-  m_clear.Free;
-  m_palette.Free;
-  m_clip.Free;
-  m_area.Free;
-  m_format.Free;
-  
-  Inherited Destroy;
-End;
-
-Procedure TX11Display.load(Const pixels : Pointer; _width, _height, _pitch : Integer;
-                           Const _format : TPTCFormat; Const _palette : TPTCPalette);
-Var
-  Area_ : TPTCArea;
-  console_pixels : Pointer;
-
-Begin
-  If clip.Equals(area) Then
-  Begin
-    console_pixels := lock;
-    Try
-      Try
-	m_copy.request(_format, format);
-	m_copy.palette(_palette, palette);
-	m_copy.copy(pixels, 0, 0, _width, _height, _pitch, console_pixels, 0, 0,
-		    width, height, pitch);
-      Except
-	On error : TPTCError Do
-	Begin
-	  Raise TPTCError.Create('failed to load pixels to console', error);
-	End;
-      End;
-    Finally
-      unlock;
-    End;
-  End
-  Else
-  Begin
-    Area_ := TPTCArea.Create(0, 0, width, height);
-    Try
-      load(pixels, _width, _height, _pitch, _format, _palette, Area_, area);
-    Finally
-      Area_.Free;
-    End;
-  End;
-End;
-
-Procedure TX11Display.load(Const pixels : Pointer; _width, _height, _pitch : Integer;
-                           Const _format : TPTCFormat; Const _palette : TPTCPalette;
-                           Const source, destination : TPTCArea);
-Var
-  console_pixels : Pointer;
-  clipped_source, clipped_destination : TPTCArea;
-  tmp : TPTCArea;
-
-Begin
-  clipped_destination := Nil;
-  clipped_source := TPTCArea.Create;
-  Try
-    clipped_destination := TPTCArea.Create;
-    console_pixels := lock;
-    Try
-      Try
-	tmp := TPTCArea.Create(0, 0, _width, _height);
-	Try
-	  TPTCClipper.clip(source, tmp, clipped_source, destination, clip, clipped_destination);
-	Finally
-	  tmp.Free;
-	End;
-	m_copy.request(_format, format);
-	m_copy.palette(_palette, palette);
-	m_copy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch,
-		    console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, pitch);
-      Except
-	On error:TPTCError Do
-	Begin
-	  Raise TPTCError.Create('failed to load pixels to console area', error);
-	End;
-      End;
-    Finally
-      unlock;
-    End;
-  Finally
-    clipped_source.Free;
-    clipped_destination.Free;
-  End;
-End;
-
-Procedure TX11Display.save(pixels : Pointer; _width, _height, _pitch : Integer;
-                           Const _format : TPTCFormat; Const _palette : TPTCPalette);
-
-Begin
-End;
-
-Procedure TX11Display.save(pixels : Pointer; _width, _height, _pitch : Integer;
-                           Const _format : TPTCFormat; Const _palette : TPTCPalette;
-		           Const source, destination : TPTCArea);
-
-Begin
-End;
-
-Procedure TX11Display.clear(Const color : TPTCColor);
-
-Begin
-End;
-
-Procedure TX11Display.clear(Const color : TPTCColor; Const _area : TPTCArea);
-
-Begin
-End;
-
-Function TX11Display.palette : TPTCPalette;
-
-Begin
-  {...}
-  palette := m_palette;
-End;
-
-Procedure TX11Display.clip(Const _area : TPTCArea);
-
-Begin
-  m_clip.ASSign(_area);
-End;
-
-Function TX11Display.width : Integer;
-
-Begin
-  width := m_width;
-End;
-
-Function TX11Display.height : Integer;
-
-Begin
-  height := m_height;
-End;
-
-Function TX11Display.clip : TPTCArea;
-
-Begin
-  clip := m_clip;
-End;
-
-Function TX11Display.area : TPTCArea;
-
-Var
-  tmp : TPTCArea;
-
-Begin
-  tmp := TPTCArea.Create(0, 0, m_width, m_height);
-  Try
-    m_area.ASSign(tmp);
-  Finally
-    tmp.Free;
-  End;
-  area := m_area;
-End;
-
-Function TX11Display.format : TPTCFormat;
-
-Begin
-  format := m_format;
-End;
-
-Procedure TX11Display.flags(_flags : LongInt);
-
-Begin
-  m_flags := _flags;
-End;
-
-Function TX11Display.getX11Display : PDisplay;
-
-Begin
-  getX11Display := m_disp;
-End;
-
-Function TX11Display.getX11Screen : Integer;
-
-Begin
-  getX11Screen := m_screen;
-End;
-
-Function TX11Display.getFormat(Const _format : TPTCFormat) : TPTCFormat;
-
-Var
-  tmp_depth : Integer;
-  numfound : Integer;
-  i : Integer;
-  pfv : PXPixmapFormatValues;
-
-Begin
-  getFormat := Nil;
-  
-  { Check if our screen has the same format available. I hate how X }
-  { keeps bits_per_pixel and depth different }
-  tmp_depth := (PXPrivDisplay(m_disp))^.screens[m_screen].root_depth;
-  
-  pfv := XListPixmapFormats(m_disp, @numfound);
-  Try
-    For i := 0 To numfound - 1 Do
-    Begin
-      If pfv[i].depth = tmp_depth Then
-      Begin
-        tmp_depth := pfv[i].bits_per_pixel;
-      End;
-    End;
-  Finally
-    XFree(pfv);
-  End;
-  
-  If (tmp_depth = 8) And _format.indexed Then
-    getFormat := TPTCFormat.Create(8)
-  Else
-    If (tmp_depth = 8) And _format.direct Then
-      getFormat := TPTCFormat.Create(8, $E0, $1C, $03)
-    Else
-      getFormat := TPTCFormat.Create(tmp_depth,
-                                     (PXPrivDisplay(m_disp))^.screens[m_screen].root_visual^.red_mask,
-				     (PXPrivDisplay(m_disp))^.screens[m_screen].root_visual^.green_mask,
-				     (PXPrivDisplay(m_disp))^.screens[m_screen].root_visual^.blue_mask);
-End;
-
-Procedure TX11Display.setKeyMapping;
-
-Var
-  _I : Integer;
-
-Begin
-  FreeMemAndNil(m_functionkeys);
-  FreeMemAndNil(m_normalkeys);
-  m_functionkeys := GetMem(256 * SizeOf(Integer));
-  m_normalkeys := GetMem(256 * SizeOf(Integer));
-  
-  For _I := 0 To 255 Do
-  Begin
-    m_functionkeys[_I] := Integer(PTCKEY_UNDEFINED);
-    m_normalkeys[_I] := Integer(PTCKEY_UNDEFINED);
-  End;
-  
-  { Assign function key indices from X definitions }
-  m_functionkeys[$FF And XK_BackSpace] := Integer(PTCKEY_BACKSPACE);
-  m_functionkeys[$FF And XK_Tab] := Integer(PTCKEY_TAB);
-  m_functionkeys[$FF And XK_Clear] := Integer(PTCKEY_CLEAR);
-  m_functionkeys[$FF And XK_Return] := Integer(PTCKEY_ENTER);
-  m_functionkeys[$FF And XK_Pause] := Integer(PTCKEY_PAUSE);
-  m_functionkeys[$FF And XK_Scroll_Lock] := Integer(PTCKEY_SCROLLLOCK);
-  m_functionkeys[$FF And XK_Escape] := Integer(PTCKEY_ESCAPE);
-  m_functionkeys[$FF And XK_Delete] := Integer(PTCKEY_DELETE);
-
-  m_functionkeys[$FF And XK_Kanji] := Integer(PTCKEY_KANJI);
-  
-  m_functionkeys[$FF And XK_Home] := Integer(PTCKEY_HOME);
-  m_functionkeys[$FF And XK_Left] := Integer(PTCKEY_LEFT);
-  m_functionkeys[$FF And XK_Up] := Integer(PTCKEY_UP);
-  m_functionkeys[$FF And XK_Right] := Integer(PTCKEY_RIGHT);
-  m_functionkeys[$FF And XK_Down] := Integer(PTCKEY_DOWN);
-  m_functionkeys[$FF And XK_Page_Up] := Integer(PTCKEY_PAGEUP);
-  m_functionkeys[$FF And XK_Page_Down] := Integer(PTCKEY_PAGEDOWN);
-  m_functionkeys[$FF And XK_End] := Integer(PTCKEY_END);
-  
-  m_functionkeys[$FF And XK_Print] := Integer(PTCKEY_PRINTSCREEN);
-  m_functionkeys[$FF And XK_Insert] := Integer(PTCKEY_INSERT);
-  m_functionkeys[$FF And XK_Num_Lock] := Integer(PTCKEY_NUMLOCK);
-
-  m_functionkeys[$FF And XK_KP_0] := Integer(PTCKEY_NUMPAD0);
-  m_functionkeys[$FF And XK_KP_1] := Integer(PTCKEY_NUMPAD1);
-  m_functionkeys[$FF And XK_KP_2] := Integer(PTCKEY_NUMPAD2);
-  m_functionkeys[$FF And XK_KP_3] := Integer(PTCKEY_NUMPAD3);
-  m_functionkeys[$FF And XK_KP_4] := Integer(PTCKEY_NUMPAD4);
-  m_functionkeys[$FF And XK_KP_5] := Integer(PTCKEY_NUMPAD5);
-  m_functionkeys[$FF And XK_KP_6] := Integer(PTCKEY_NUMPAD6);
-  m_functionkeys[$FF And XK_KP_7] := Integer(PTCKEY_NUMPAD7);
-  m_functionkeys[$FF And XK_KP_8] := Integer(PTCKEY_NUMPAD8);
-  m_functionkeys[$FF And XK_KP_9] := Integer(PTCKEY_NUMPAD9);
-
-  m_functionkeys[$FF And XK_F1] := Integer(PTCKEY_F1);
-  m_functionkeys[$FF And XK_F2] := Integer(PTCKEY_F2);
-  m_functionkeys[$FF And XK_F3] := Integer(PTCKEY_F3);
-  m_functionkeys[$FF And XK_F4] := Integer(PTCKEY_F4);
-  m_functionkeys[$FF And XK_F5] := Integer(PTCKEY_F5);
-  m_functionkeys[$FF And XK_F6] := Integer(PTCKEY_F6);
-  m_functionkeys[$FF And XK_F7] := Integer(PTCKEY_F7);
-  m_functionkeys[$FF And XK_F8] := Integer(PTCKEY_F8);
-  m_functionkeys[$FF And XK_F9] := Integer(PTCKEY_F9);
-  m_functionkeys[$FF And XK_F10] := Integer(PTCKEY_F10);
-  m_functionkeys[$FF And XK_F11] := Integer(PTCKEY_F11);
-  m_functionkeys[$FF And XK_F12] := Integer(PTCKEY_F12);
-
-  m_functionkeys[$FF And XK_Shift_L] := Integer(PTCKEY_SHIFT);
-  m_functionkeys[$FF And XK_Shift_R] := Integer(PTCKEY_SHIFT);
-  m_functionkeys[$FF And XK_Control_L] := Integer(PTCKEY_CONTROL);
-  m_functionkeys[$FF And XK_Control_R] := Integer(PTCKEY_CONTROL);
-  m_functionkeys[$FF And XK_Caps_Lock] := Integer(PTCKEY_CAPSLOCK);
-  m_functionkeys[$FF And XK_Meta_L] := Integer(PTCKEY_META);
-  m_functionkeys[$FF And XK_Meta_R] := Integer(PTCKEY_META);
-  m_functionkeys[$FF And XK_Alt_L] := Integer(PTCKEY_ALT);
-  m_functionkeys[$FF And XK_Alt_R] := Integer(PTCKEY_ALT);
-
-  { Assign normal key indices }
-  m_normalkeys[$FF And XK_space] := Integer(PTCKEY_SPACE);
-  m_normalkeys[$FF And XK_comma] := Integer(PTCKEY_COMMA);
-  m_normalkeys[$FF And XK_minus] := Integer(PTCKEY_SUBTRACT);
-  m_normalkeys[$FF And XK_period] := Integer(PTCKEY_PERIOD);
-  m_normalkeys[$FF And XK_slash] := Integer(PTCKEY_SLASH);
-  m_normalkeys[$FF And XK_0] := Integer(PTCKEY_ZERO);
-  m_normalkeys[$FF And XK_1] := Integer(PTCKEY_ONE);
-  m_normalkeys[$FF And XK_2] := Integer(PTCKEY_TWO);
-  m_normalkeys[$FF And XK_3] := Integer(PTCKEY_THREE);
-  m_normalkeys[$FF And XK_4] := Integer(PTCKEY_FOUR);
-  m_normalkeys[$FF And XK_5] := Integer(PTCKEY_FIVE);
-  m_normalkeys[$FF And XK_6] := Integer(PTCKEY_SIX);
-  m_normalkeys[$FF And XK_7] := Integer(PTCKEY_SEVEN);
-  m_normalkeys[$FF And XK_8] := Integer(PTCKEY_EIGHT);
-  m_normalkeys[$FF And XK_9] := Integer(PTCKEY_NINE);
-  m_normalkeys[$FF And XK_semicolon] := Integer(PTCKEY_SEMICOLON);
-  m_normalkeys[$FF And XK_equal] := Integer(PTCKEY_EQUALS);
-
-  m_normalkeys[$FF And XK_bracketleft] := Integer(PTCKEY_OPENBRACKET);
-  m_normalkeys[$FF And XK_backslash] := Integer(PTCKEY_BACKSLASH);
-  m_normalkeys[$FF And XK_bracketright] := Integer(PTCKEY_CLOSEBRACKET);
-
-  m_normalkeys[$FF And XK_a] := Integer(PTCKEY_A);
-  m_normalkeys[$FF And XK_b] := Integer(PTCKEY_B);
-  m_normalkeys[$FF And XK_c] := Integer(PTCKEY_C);
-  m_normalkeys[$FF And XK_d] := Integer(PTCKEY_D);
-  m_normalkeys[$FF And XK_e] := Integer(PTCKEY_E);
-  m_normalkeys[$FF And XK_f] := Integer(PTCKEY_F);
-  m_normalkeys[$FF And XK_g] := Integer(PTCKEY_G);
-  m_normalkeys[$FF And XK_h] := Integer(PTCKEY_H);
-  m_normalkeys[$FF And XK_i] := Integer(PTCKEY_I);
-  m_normalkeys[$FF And XK_j] := Integer(PTCKEY_J);
-  m_normalkeys[$FF And XK_k] := Integer(PTCKEY_K);
-  m_normalkeys[$FF And XK_l] := Integer(PTCKEY_L);
-  m_normalkeys[$FF And XK_m] := Integer(PTCKEY_M);
-  m_normalkeys[$FF And XK_n] := Integer(PTCKEY_N);
-  m_normalkeys[$FF And XK_o] := Integer(PTCKEY_O);
-  m_normalkeys[$FF And XK_p] := Integer(PTCKEY_P);
-  m_normalkeys[$FF And XK_q] := Integer(PTCKEY_Q);
-  m_normalkeys[$FF And XK_r] := Integer(PTCKEY_R);
-  m_normalkeys[$FF And XK_s] := Integer(PTCKEY_S);
-  m_normalkeys[$FF And XK_t] := Integer(PTCKEY_T);
-  m_normalkeys[$FF And XK_u] := Integer(PTCKEY_U);
-  m_normalkeys[$FF And XK_v] := Integer(PTCKEY_V);
-  m_normalkeys[$FF And XK_w] := Integer(PTCKEY_W);
-  m_normalkeys[$FF And XK_x] := Integer(PTCKEY_X);
-  m_normalkeys[$FF And XK_y] := Integer(PTCKEY_Y);
-  m_normalkeys[$FF And XK_z] := Integer(PTCKEY_Z);
-End;

packages/extra/ptc/x11/displayd.inc

@@ -1,101 +0,0 @@
-Type
-  TX11Display = Class(TObject)
-  Protected
-    Procedure internal_ReadKey(k : TPTCKey); Virtual; Abstract;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Virtual; Abstract;
-    
-    Function getFormat(Const _format : TPTCFormat) : TPTCFormat;
-    
-    { initialise the keyboard mapping table }
-    Procedure setKeyMapping;
-    
-    { Conversion object }
-    m_copy : TPTCCopy;
-    m_clear : TPTCClear;
-    m_palette : TPTCPalette;
-    
-    m_area : TPTCArea;
-    m_clip : TPTCArea;
-    
-    m_flags : LongInt;
-    m_width, m_height : DWord;
-    m_format : TPTCFormat;
-    
-    m_disp : PDisplay;
-    m_screen : Integer;
-    
-    m_cmap : TColormap;
-    m_colours : PXColor;
-    
-    m_functionkeys : PInteger;
-    m_normalkeys : PInteger;
-    
-    {m_thread : pthread_t;}
-  Public
-    Constructor Create;
-    Destructor Destroy; Override;
-    
-    {checkDGA}
-    
-    Procedure open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer); Virtual; Abstract;
-    
-    { This will always return a windowed console. The first version
-      fills the whole window, the second one has a custom size }
-    Procedure open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat); Virtual; Abstract;
-    Procedure open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); Virtual; Abstract;
-
-    Procedure close; Virtual; Abstract;
-    
-    Procedure update; Virtual; Abstract;
-    Procedure update(Const _area : TPTCArea); Virtual; Abstract;
-    
-    Function lock : Pointer; Virtual; Abstract;
-    Procedure unlock; Virtual; Abstract;
-    
-    { load pixels to console }
-    Procedure load(Const pixels : Pointer; _width, _height, _pitch : Integer;
-                   Const _format : TPTCFormat; Const _palette : TPTCPalette); Virtual;
-    Procedure load(Const pixels : Pointer; _width, _height, _pitch : Integer;
-                   Const _format : TPTCFormat; Const _palette : TPTCPalette;
-		   Const source, destination : TPTCArea); Virtual;
-    
-    { save console pixels }
-    Procedure save(pixels : Pointer; _width, _height, _pitch : Integer;
-                   Const _format : TPTCFormat; Const _palette : TPTCPalette); Virtual;
-    Procedure save(pixels : Pointer; _width, _height, _pitch : Integer;
-                   Const _format : TPTCFormat; Const _palette : TPTCPalette;
-		   Const source, destination : TPTCArea); Virtual;
-    
-    { clear surface }
-    Procedure clear(Const color : TPTCColor); Virtual;
-    Procedure clear(Const color : TPTCColor; Const _area : TPTCArea); Virtual;
-    
-    { Console palette }
-    Procedure palette(Const _palette : TPTCPalette); Virtual; Abstract;
-    Function palette : TPTCPalette; Virtual;
-
-    { console clip area }
-    Procedure clip(Const _area : TPTCArea);
-    
-    { Data access }
-    Function width : Integer;
-    Function height : Integer;
-    Function pitch : Integer; Virtual; Abstract;
-    Function clip : TPTCArea;
-    Function area : TPTCArea;
-    Function format : TPTCFormat;
-    
-    { Set flags (only used internally now!) }
-    Procedure flags(_flags : LongInt);
-    
-    { X11 helper functions for your enjoyment }
-    
-    { return the display we are using }
-    Function getX11Display : PDisplay;
-    
-    { return the screen we are using }
-    Function getX11Screen : Integer;
-    
-    { return our window (0 if DGA) }
-    Function getX11Window : TWindow; Virtual; Abstract;
-  End;

packages/extra/ptc/x11/extensions.inc

@@ -0,0 +1,6 @@
+{ X11 extensions we want to enable at compile time }
+{$DEFINE ENABLE_X11_EXTENSION_XRANDR}
+{$DEFINE ENABLE_X11_EXTENSION_XF86VIDMODE}
+{$DEFINE ENABLE_X11_EXTENSION_XF86DGA1}
+{$DEFINE ENABLE_X11_EXTENSION_XF86DGA2}
+{$DEFINE ENABLE_X11_EXTENSION_XSHM}

packages/extra/ptc/x11/includes.inc

@@ -0,0 +1,16 @@
+{$INCLUDE x11modesd.inc}
+{$INCLUDE x11imaged.inc}
+{$INCLUDE x11displayd.inc}
+{$INCLUDE x11windowdisplayd.inc}
+{$INCLUDE x11dga1displayd.inc}
+{$INCLUDE x11dga2displayd.inc}
+{$INCLUDE x11consoled.inc}
+
+{$INCLUDE check.inc}
+{$INCLUDE x11modesi.inc}
+{$INCLUDE x11imagei.inc}
+{$INCLUDE x11displayi.inc}
+{$INCLUDE x11windowdisplayi.inc}
+{$INCLUDE x11dga1displayi.inc}
+{$INCLUDE x11dga2displayi.inc}
+{$INCLUDE x11consolei.inc}

packages/extra/ptc/x11/modesd.inc

@@ -0,0 +1,19 @@
+Type
+  TX11Modes = Class(TObject)
+  Private
+    FDisplay : PDisplay;
+    FScreen : cint;
+
+    FModeList : PPXF86VidModeModeInfo;
+    FModeListCount : cint;
+    FSavedMode : PXF86VidModeModeLine;
+    FSavedDotClock : cint;
+
+    Procedure GetModes;
+    Function FindNumberOfBestMode(width, height : Integer) : Integer;
+  Public
+    Constructor Create(display : PDisplay; screen : cint);
+    Destructor Destroy; Override;
+    Procedure SetBestMode(width, height : Integer);
+    Procedure RestorePreviousMode;
+  End;

packages/extra/ptc/x11/modesi.inc

@@ -0,0 +1,146 @@
+Constructor TX11Modes.Create(display : PDisplay; screen : Integer);
+
+Var
+  dummy1, dummy2 : cint;
+
+Begin
+  FSavedMode := Nil;
+  FSavedDotClock := 0;
+  FModeList := Nil;
+  FModeListCount := 0;
+
+  FDisplay := display;
+  FScreen := screen;
+
+  If Not XF86VidModeQueryExtension(FDisplay, @dummy1, @dummy2) Then
+    Raise TPTCError.Create('VidMode extension not available');
+End;
+
+Destructor TX11Modes.Destroy;
+
+Begin
+  If FSavedMode <> Nil Then
+  Begin
+    RestorePreviousMode;
+    If FSavedMode^.privsize <> 0 Then
+      XFree(FSavedMode^.c_private);
+    Dispose(FSavedMode);
+  End;
+
+  If FModeList <> Nil Then
+    XFree(FModeList);
+
+  Inherited Destroy;
+End;
+
+Procedure TX11Modes.GetModes;
+
+Begin
+  { If we have been called before, do nothing }
+  If FModeList <> Nil Then
+    Exit;
+
+  { Save previous mode }
+  New(FSavedMode);
+  FillChar(FSavedMode^, SizeOf(FSavedMode^), 0);
+  XF86VidModeGetModeLine(FDisplay, FScreen, @FSavedDotClock, FSavedMode);
+
+  { Get all available video modes }
+  XF86VidModeGetAllModeLines(FDisplay, FScreen, @FModeListCount, @FModeList);
+End;
+
+Function TX11Modes.FindNumberOfBestMode(width, height : Integer) : Integer;
+
+Var
+  min_diff : Integer;
+  d_x, d_y : Integer;
+  found_mode : Integer;
+  I : Integer;
+
+Begin
+  { Try an exact match }
+  For I := 0 To FModeListCount - 1 Do
+    If (FModeList[I]^.hdisplay = width) And (FModeList[I]^.vdisplay = height) Then
+      Exit(I);
+
+  { Try to find a mode that matches the width first }
+  For I := 0 To FModeListCount - 1 Do
+    If (FModeList[I]^.hdisplay = width) And (FModeList[I]^.vdisplay >= height) Then
+      Exit(I);
+
+  { Next try to match the height }
+  For I := 0 To FModeListCount - 1 Do
+    If (FModeList[I]^.hdisplay >= width) And (FModeList[I]^.vdisplay = height) Then
+      Exit(I);
+
+  { Finally, find the mode that is bigger than the requested one and makes }
+  { the least difference }
+  found_mode := -1;
+  min_diff := High(Integer);
+  For I := 0 To FModeListCount - 1 Do
+    If (FModeList[I]^.hdisplay >= width) And (FModeList[I]^.vdisplay >= height) Then
+    Begin
+      d_x := FModeList[I]^.hdisplay - width;
+      d_x *= d_x;
+      d_y := FModeList[I]^.vdisplay - height;
+      d_y *= d_y;
+      If (d_x + d_y) < min_diff Then
+      Begin
+        min_diff := d_x + d_y;
+        found_mode := I;
+      End;
+    End;
+
+  If found_mode <> -1 Then
+    Result := found_mode
+  Else
+    Raise TPTCError.Create('Cannot find matching DGA video mode');
+End;
+
+Procedure TX11Modes.SetBestMode(width, height : Integer);
+
+Var
+  BestMode : Integer;
+
+Begin
+  GetModes;
+
+  BestMode := FindNumberOfBestMode(width, height);
+  If Not XF86VidModeSwitchToMode(FDisplay, FScreen, FModeList[BestMode]) Then
+    Raise TPTCError.Create('Error switching to the requested video mode');
+
+  XWarpPointer(FDisplay, None, RootWindow(FDisplay, FScreen), 0, 0, 0, 0,
+               FModeList[BestMode]^.hdisplay Div 2,
+	       FModeList[BestMode]^.vdisplay Div 2);
+
+  If Not XF86VidModeSetViewPort(FDisplay, FScreen, 0, 0) Then
+    Raise TPTCError.Create('Error moving the viewport to the upper-left corner');
+End;
+
+Procedure TX11Modes.RestorePreviousMode;
+
+Var
+  ModeInfo : TXF86VidModeModeInfo;
+
+Begin
+  If FSavedMode <> Nil Then
+  Begin
+    {FSavedMode is a TXF86VidModeModeLine, but XF86VidModeSwitchToMode wants a
+                     TXF86VidModeModeInfo :}
+    FillChar(ModeInfo, SizeOf(ModeInfo), 0);
+    ModeInfo.dotclock := FSavedDotClock;
+    ModeInfo.hdisplay := FSavedMode^.hdisplay;
+    ModeInfo.hsyncstart := FSavedMode^.hsyncstart;
+    ModeInfo.hsyncend := FSavedMode^.hsyncend;
+    ModeInfo.htotal := FSavedMode^.htotal;
+    ModeInfo.vdisplay := FSavedMode^.vdisplay;
+    ModeInfo.vsyncstart := FSavedMode^.vsyncstart;
+    ModeInfo.vsyncend := FSavedMode^.vsyncend;
+    ModeInfo.vtotal := FSavedMode^.vtotal;
+    ModeInfo.flags := FSavedMode^.flags;
+    ModeInfo.privsize := FSavedMode^.privsize;
+    ModeInfo.c_private := FSavedMode^.c_private;
+    
+    XF86VidModeSwitchToMode(FDisplay, FScreen, @ModeInfo);
+  End;
+End;

packages/extra/ptc/x11/imaged.inc → packages/extra/ptc/x11/svnimaged.inc

@@ -15,7 +15,7 @@ Type
   End;
   TX11NormalImage = Class(TX11Image)
   Private
-    m_pixels : Pchar8;
+    m_pixels : PUint8;
   Public
     Constructor Create(display : PDisplay; screen, width, height : Integer; format : TPTCFormat);
     Destructor Destroy; Override;

packages/extra/ptc/x11/window.inc

@@ -1,392 +0,0 @@
-{$IFDEF XStringListToTextProperty_notyetimplemented_in_xutil_pp}
-Function XStringListToTextProperty(list : PPChar; count : Integer;
-                                   text_prop_return : PXTextProperty) : TStatus; CDecl; External;
-{$ENDIF}
-
-Constructor TX11WindowDisplay.Create;
-
-Begin
-  m_has_shm := False;
-  m_primary := Nil;
-  m_window := 0;
-  m_colours := Nil;
-  m_keypressed := False;
-  Inherited Create;
-//  XSHM_LoadLibrary;
-
-{$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-  m_has_shm := True;
-{$ENDIF HAVE_X11_EXTENSIONS_XSHM}
-End;
-
-Destructor TX11WindowDisplay.Destroy;
-
-Begin
-  close;
-//  XSHM_UnloadLibrary;
-  Inherited Destroy;
-End;
-
-Procedure TX11WindowDisplay.open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer);
-
-Var
-  tmpFormat : TPTCFormat;
-  xgcv : TXGCValues;
-  textprop : TXTextProperty;
-  e : TXEvent;
-  found : Boolean;
-  attr : TXSetWindowAttributes;
-  size_hints : PXSizeHints;
-  tmpArea : TPTCArea;
-  tmppchar : PChar;
-
-Begin
-  m_disp := disp;
-  m_screen := DefaultScreen(disp);
-  m_height := _height;
-  m_width := _width;
-  m_destx := 0;
-  m_desty := 0;
-  { Check if we have that colour depth available.. Easy as there is no
-    format conversion yet }
-  tmpFormat := Nil;
-  Try
-    tmpFormat := getFormat(_format);
-    m_format.ASSign(tmpFormat);
-  Finally
-    tmpFormat.Free;
-  End;
-  tmpFormat := Nil;
-  { Create a window }
-  m_window := XCreateSimpleWindow(m_disp, DefaultRootWindow(m_disp), 0, 0,
-                _width, _height, 0, BlackPixel(m_disp, DefaultScreen(m_disp)),
-		                    BlackPixel(m_disp, DefaultScreen(m_disp)));
-  { Register the delete atom }
-  m_atom_close := XInternAtom(m_disp, 'WM_DELETE_WINDOW', False);
-  X11Check(XSetWMProtocols(m_disp, m_window, @m_atom_close, 1), 'XSetWMProtocols');
-  { Get graphics context }
-  xgcv.graphics_exposures := False;
-  m_gc := XCreateGC(m_disp, m_window, GCGraphicsExposures, @xgcv);
-  If m_gc = Nil Then
-    Raise TPTCError.Create('can''t create graphics context');
-  { Set window title }
-  tmppchar := PChar(title);
-  X11Check(XStringListToTextProperty(@tmppchar, 1, @textprop), 'XStringListToTextProperty');
-  Try
-    XSetWMName(m_disp, m_window, @textprop);
-    XFlush(m_disp);
-  Finally
-    XFree(textprop.value);
-  End;
-  { Set normal hints }
-  size_hints := XAllocSizeHints;
-  Try
-    size_hints^.flags := PBaseSize;
-    size_hints^.base_width := _width;
-    size_hints^.base_height := _height;
-    XSetWMNormalHints(m_disp, m_window, size_hints);
-    XFlush(m_disp);
-  Finally
-    XFree(size_hints);
-  End;
-  { Map the window and wait for success }
-  XSelectInput(m_disp, m_window, StructureNotifyMask);
-  XMapRaised(m_disp, m_window);
-  Repeat
-    XNextEvent(disp, @e);
-    If e._type = MapNotify Then
-      Break;
-  Until False;
-  { Get keyboard input and sync }
-  XSelectInput(m_disp, m_window, KeyPressMask Or KeyReleaseMask Or
-                                 StructureNotifyMask Or
-				 ButtonPressMask Or ButtonReleaseMask Or
-				 PointerMotionMask);
-  XSync(m_disp, False);
-  { Create XImage using factory method }
-  m_primary := createImage(m_disp, m_screen, m_width, m_height, m_format);
-  
-  found := False;
-  Repeat
-    { Stupid loop. The key }
-    { events were causing }
-    { problems.. }
-    found := XCheckMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e);
-  Until Not found;
-  
-  attr.backing_store := Always;
-  XChangeWindowAttributes(m_disp, m_window, CWBackingStore, @attr);
-  
-  { Set clipping area }
-  tmpArea := TPTCArea.Create(0, 0, m_width, m_height);
-  Try
-    m_clip.ASSign(tmpArea);
-  Finally
-    tmpArea.Free;
-  End;
-  
-  { Installs the right colour map for 8 bit modes }
-  createColormap;
-
-  {ifdef PTHREADS...}
-End;
-
-Procedure TX11WindowDisplay.open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat);
-
-Begin
-End;
-
-Procedure TX11WindowDisplay.open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer);
-
-Begin
-End;
-
-Procedure TX11WindowDisplay.close;
-
-Begin
-  {pthreads?!}
-  If m_cmap <> 0 Then
-  Begin
-    XFreeColormap(m_disp, m_cmap);
-    m_cmap := 0;
-  End;
-  
-  { Destroy XImage and buffer }
-  FreeAndNil(m_primary);
-  FreeMemAndNil(m_colours);
-  
-  { Hide and destroy window }
-  If (m_window <> 0) And ((m_flags And PTC_X11_LEAVE_WINDOW) = 0) Then
-  Begin
-    XUnmapWindow(m_disp, m_window);
-    XSync(m_disp, False);
-    
-    XDestroyWindow(m_disp, m_window);
-  End;
-End;
-
-Procedure TX11WindowDisplay.update;
-
-Var
-  e : TXEvent;
-
-Begin
-  m_primary.put(m_window, m_gc, m_destx, m_desty);
-  {ifndef pthreads}
-  If XCheckTypedEvent(m_disp, ClientMessage, @e) Then
-  Begin
-    If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then
-      Halt(0);
-  End;
-  {endif}
-End;
-
-Procedure TX11WindowDisplay.update(Const _area : TPTCArea);
-
-Var
-  e : TXEvent;
-  updatearea : TPTCArea;
-  tmparea : TPTCArea;
-
-Begin
-  tmparea := TPTCArea.Create(0, 0, m_width, m_height);
-  Try
-    updatearea := TPTCClipper.clip(tmparea, _area);
-    Try
-      m_primary.put(m_window, m_gc, updatearea.left, updatearea.top,
-                    m_destx + updatearea.left, m_desty + updatearea.top,
-		    updatearea.width, updatearea.height);
-    Finally
-      updatearea.Free;
-    End;
-  Finally
-    tmparea.Free;
-  End;
-  
-  {ifndef pthreads}
-  If XCheckTypedEvent(m_disp, ClientMessage, @e) Then
-  Begin
-    If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then
-      Halt(0);
-  End;
-  {endif}
-End;
-
-Procedure TX11WindowDisplay.internal_ReadKey(k : TPTCKey);
-
-Var
-  e : TXEvent;
-  sym : TKeySym;
-  press : Boolean;
-  alt, shift, ctrl : Boolean;
-  uni : Integer;
-  tmpkey : TPTCKey;
-
-Begin
-  XMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e); { Blocks and waits }
-  If (e._type <> KeyPress) And (e._type <> KeyRelease) Then
-    Raise TPTCError.Create('XMaskEvent returned event <> KeyPress/KeyRelease');
-  
-{  XLookupString(@e.xkey, Nil, 0, @sym, Nil);}
-  sym := XLookupKeySym(@e.xkey, 0);
-  uni := X11ConvertKeySymToUnicode(sym);
-  alt := (e.xkey.state And Mod1Mask) <> 0;
-  shift := (e.xkey.state And ShiftMask) <> 0;
-  ctrl := (e.xkey.state And ControlMask) <> 0;
-  If e._type = KeyPress Then
-    press := True
-  Else
-    press := False;
-
-  tmpkey := Nil;
-  Try
-    Case sym Shr 8 Of
-      0 : tmpkey := TPTCKey.Create(m_normalkeys[sym And $FF], uni, alt, shift, ctrl, press);
-      $FF : tmpkey := TPTCKey.Create(m_functionkeys[sym And $FF], uni, alt, shift, ctrl, press);
-      Else
-        tmpkey := TPTCKey.Create;
-    End;
-    k.ASSign(tmpkey);
-  Finally
-    tmpkey.Free;
-  End;
-End;
-
-Function TX11WindowDisplay.internal_PeekKey(k : TPTCKey) : Boolean;
-
-Var
-  e : TXEvent;
-
-Begin
-  If XCheckMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e) Then
-  Begin
-    XPutBackEvent(m_disp, @e); { Simulate "normal" kbhit behaviour }
-    XPutBackEvent(m_disp, @e); { i.e. leave the buffer intact }
-    internal_ReadKey(k);
-    Result := True;
-  End
-  Else
-    Result := False;
-End;
-
-Function TX11WindowDisplay.lock : Pointer;
-
-Begin
-  lock := m_primary.lock;
-End;
-
-Procedure TX11WindowDisplay.unlock;
-
-Begin
-End;
-
-Procedure TX11WindowDisplay.palette(Const _palette : TPTCPalette);
-
-Var
-  pal : Pint32;
-  i : Integer;
-
-Begin
-  pal := _palette.data;
-  If Not m_format.indexed Then
-    Exit;
-  For i := 0 To 255 Do
-  Begin
-    m_colours[i].pixel := i;
-
-    m_colours[i].red := ((pal[i] Shr 16) And $FF) Shl 8;
-    m_colours[i].green := ((pal[i] Shr 8) And $FF) Shl 8;
-    m_colours[i].blue := (pal[i] And $FF) Shl 8;
-
-    Byte(m_colours[i].flags) := DoRed Or DoGreen Or DoBlue;
-  End;
-  XStoreColors(m_disp, m_cmap, m_colours, 256);
-End;
-
-Function TX11WindowDisplay.pitch : Integer;
-
-Begin
-  pitch := m_primary.pitch;
-End;
-
-Function TX11WindowDisplay.createImage(disp : PDisplay; screen, _width, _height : Integer;
-                                       _format : TPTCFormat) : TX11Image;
-
-{$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-Var
-  tmp : TX11Image;
-{$ENDIF}
-
-Begin
-  {todo: shm}
-  {$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-  If m_has_shm And XShmQueryExtension(disp) Then
-  Begin
-    Try
-      tmp := TX11SHMImage.Create(disp, screen, _width, _height, _format);
-    Except
-      On e : TPTCError Do
-        tmp := TX11NormalImage.Create(disp, screen, _width, _height, _format);
-    End;
-    createImage := tmp;
-  End
-  Else
-  {$ENDIF}
-  createImage := TX11NormalImage.Create(disp, screen, _width, _height, _format);
-End;
-
-Function TX11WindowDisplay.getX11Window : TWindow;
-
-Begin
-  getX11Window := m_window;
-End;
-
-Function TX11WindowDisplay.getX11GC : TGC;
-
-Begin
-  getX11GC := m_gc;
-End;
-
-Procedure TX11WindowDisplay.createColormap; { Register colour maps }
-
-Var
-  i : Integer;
-  r, g, b : Single;
-
-Begin
-  If m_format.bits = 8 Then
-  Begin
-    m_colours := GetMem(256 * SizeOf(TXColor));
-    If m_colours = Nil Then
-      Raise TPTCError.Create('Cannot allocate colour map cells');
-    m_cmap := XCreateColormap(m_disp, RootWindow(m_disp, m_screen),
-                              DefaultVisual(m_disp, m_screen), AllocAll);
-    If m_cmap = 0 Then
-      Raise TPTCError.Create('Cannot create colour map');
-    XInstallColormap(m_disp, m_cmap);
-    XSetWindowColormap(m_disp, m_window, m_cmap);
-  End
-  Else
-    m_cmap := 0;
-
-  { Set 332 palette, for now }
-  If (m_format.bits = 8) And m_format.direct Then
-  Begin
-    {Taken from PTC 0.72, i hope it's fine}
-    For i := 0 To 255 Do
-    Begin
-      r := ((i And $E0) Shr 5) * 255 / 7;
-      g := ((i And $1C) Shr 2) * 255 / 7;
-      b := (i And $03) * 255 / 3;
-      
-      m_colours[i].pixel := i;
-      
-      m_colours[i].red := Round(r) Shl 8;
-      m_colours[i].green := Round(g) Shl 8;
-      m_colours[i].blue := Round(b) Shl 8;
-      
-      Byte(m_colours[i].flags) := DoRed Or DoGreen Or DoBlue;
-    End;
-    XStoreColors(m_disp, m_cmap, m_colours, 256);
-  End;
-End;

packages/extra/ptc/x11/x11consoled.inc

@@ -0,0 +1,82 @@
+Type
+  TX11Console = Class(TPTCBaseConsole)
+  Private
+    FX11Display : TX11Display;
+    FTitle : String;
+    FFlags : TX11Flags;
+    FModes : Array Of TPTCMode;
+
+    Procedure UpdateCursor;
+
+    Function CreateDisplay : TX11Display; { Factory method }
+
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+    Function GetPitch : Integer; Override;
+    Function GetArea : TPTCArea; Override;
+    Function GetFormat : TPTCFormat; Override;
+    Function GetPages : Integer; Override;
+    Function GetName : String; Override;
+    Function GetTitle : String; Override;
+    Function GetInformation : String; Override;
+  Public
+    Constructor Create; Override;
+    Destructor Destroy; Override;
+
+    Procedure Open(Const ATitle : String; APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; Const AFormat : TPTCFormat;
+                   APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; AWidth, AHeight : Integer;
+                   Const AFormat : TPTCFormat; APages : Integer = 0); Overload; Override;
+    Procedure Open(Const ATitle : String; Const AMode : TPTCMode;
+                   APages : Integer = 0); Overload; Override;
+    Procedure Close; Override;
+
+    Procedure Copy(Var ASurface : TPTCBaseSurface); Override;
+    Procedure Copy(Var ASurface : TPTCBaseSurface;
+                   Const ASource, ADestination : TPTCArea); Override;
+
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Override;
+    Procedure Load(Const APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Override;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette); Override;
+    Procedure Save(APixels : Pointer;
+                   AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat;
+                   Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Override;
+
+    Function Lock : Pointer; Override;
+    Procedure Unlock; Override;
+
+    Procedure Clear; Override;
+    Procedure Clear(Const AColor : TPTCColor); Override;
+    Procedure Clear(Const AColor : TPTCColor;
+                    Const AArea : TPTCArea); Override;
+
+    Procedure Configure(Const AFileName : String); Override;
+    Function Option(Const AOption : String) : Boolean; Override;
+
+    Procedure Palette(Const APalette : TPTCPalette); Override;
+    Procedure Clip(Const AArea : TPTCArea); Override;
+    Function Clip : TPTCArea; Override;
+    Function Palette : TPTCPalette; Override;
+    Function Modes : PPTCMode; Override;
+
+    Procedure Flush; Override;
+    Procedure Finish; Override;
+    Procedure Update; Override;
+    Procedure Update(Const AArea : TPTCArea); Override;
+
+    Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override;
+  End;

packages/extra/ptc/x11/x11consolei.inc

@@ -0,0 +1,530 @@
+Constructor TX11Console.Create;
+
+Var
+  s : AnsiString;
+
+Begin
+  Inherited Create;
+
+  { default flags }
+  FFlags := [PTC_X11_TRY_XSHM, PTC_X11_TRY_XF86VIDMODE];
+
+  FTitle := '';
+
+  Configure('/usr/share/ptcpas/ptcpas.conf');
+  s := fpgetenv('HOME');
+  If s = '' Then
+    s := '/';
+  If s[Length(s)] <> '/' Then
+    s := s + '/';
+  s := s + '.ptcpas.conf';
+  Configure(s);
+End;
+
+Destructor TX11Console.Destroy;
+
+Var
+  I : Integer;
+
+Begin
+  Close;
+  FreeAndNil(FX11Display);
+  For I := Low(FModes) To High(FModes) Do
+    FreeAndNil(FModes[I]);
+  Inherited Destroy;
+End;
+
+Procedure TX11Console.Configure(Const AFileName : String);
+
+Var
+  F : Text;
+  S : String;
+
+Begin
+  AssignFile(F, AFileName);
+  {$I-}
+  Reset(F);
+  {$I+}
+  If IOResult <> 0 Then
+    Exit;
+  While Not EoF(F) Do
+  Begin
+    {$I-}
+    Readln(F, S);
+    {$I+}
+    If IOResult <> 0 Then
+      Break;
+    Option(S);
+  End;
+  CloseFile(F);
+End;
+
+Function TX11Console.Option(Const AOption : String) : Boolean;
+
+Begin
+  Result := True;
+  If AOption = 'default output' Then
+  Begin
+    { default is windowed for now }
+    FFlags := FFlags - [PTC_X11_FULLSCREEN];
+    Exit;
+  End;
+  If AOption = 'windowed output' Then
+  Begin
+    FFlags := FFlags - [PTC_X11_FULLSCREEN];
+    Exit;
+  End;
+  If AOption = 'fullscreen output' Then
+  Begin
+    FFlags := FFlags + [PTC_X11_FULLSCREEN];
+    Exit;
+  End;
+  If AOption = 'leave window open' Then
+  Begin
+    FFlags := FFlags + [PTC_X11_LEAVE_WINDOW];
+    Exit;
+  End;
+  If AOption = 'leave display open' Then
+  Begin
+    FFlags := FFlags + [PTC_X11_LEAVE_DISPLAY];
+    Exit;
+  End;
+  If AOption = 'dga' Then
+  Begin
+    FFlags := FFlags + [PTC_X11_TRY_DGA];
+    Exit;
+  End;
+  If AOption = 'dga off' Then
+  Begin
+    FFlags := FFlags - [PTC_X11_TRY_DGA];
+    Exit;
+  End;
+  If AOption = 'xf86vidmode' Then
+  Begin
+    FFlags := FFlags + [PTC_X11_TRY_XF86VIDMODE];
+    Exit;
+  End;
+  If AOption = 'xf86vidmode off' Then
+  Begin
+    FFlags := FFlags - [PTC_X11_TRY_XF86VIDMODE];
+    Exit;
+  End;
+  If AOption = 'xrandr' Then
+  Begin
+    FFlags := FFlags + [PTC_X11_TRY_XRANDR];
+    Exit;
+  End;
+  If AOption = 'xrandr off' Then
+  Begin
+    FFlags := FFlags - [PTC_X11_TRY_XRANDR];
+    Exit;
+  End;
+  If AOption = 'xshm' Then
+  Begin
+    FFlags := FFlags + [PTC_X11_TRY_XSHM];
+    Exit;
+  End;
+  If AOption = 'xshm off' Then
+  Begin
+    FFlags := FFlags - [PTC_X11_TRY_XSHM];
+    Exit;
+  End;
+  If AOption = 'default cursor' Then
+  Begin
+    FFlags := FFlags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE, PTC_X11_WINDOWED_CURSOR_INVISIBLE];
+    UpdateCursor;
+    Exit;
+  End;
+  If AOption = 'show cursor' Then
+  Begin
+    FFlags := (FFlags - [PTC_X11_WINDOWED_CURSOR_INVISIBLE]) + [PTC_X11_FULLSCREEN_CURSOR_VISIBLE];
+    UpdateCursor;
+    Exit;
+  End;
+  If AOption = 'hide cursor' Then
+  Begin
+    FFlags := (FFlags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE]) + [PTC_X11_WINDOWED_CURSOR_INVISIBLE];
+    UpdateCursor;
+    Exit;
+  End;
+  If AOption = 'enable logging' Then
+  Begin
+    LOG_enabled := True;
+    Result := True;
+    Exit;
+  End;
+  If AOption = 'disable logging' Then
+  Begin
+    LOG_enabled := False;
+    Result := True;
+    Exit;
+  End;
+
+  If Assigned(FX11Display) Then
+    Result := FX11Display.FCopy.Option(AOption)
+  Else
+    Result := False;
+End;
+
+Function TX11Console.Modes : PPTCMode;
+
+Var
+  I : Integer;
+
+Begin
+  For I := Low(FModes) To High(FModes) Do
+    FreeAndNil(FModes[I]);
+
+  If FX11Display = Nil Then
+    FX11Display := CreateDisplay;
+
+  FX11Display.GetModes(FModes);
+
+  Result := @FModes[0];
+End;
+
+{TODO: Find current pixel depth}
+Procedure TX11Console.Open(Const ATitle : String; APages : Integer = 0);
+
+Var
+  tmp : TPTCFormat;
+
+Begin
+  tmp := TPTCFormat.Create(32, $FF0000, $FF00, $FF);
+  Try
+    Open(ATitle, tmp, APages);
+  Finally
+    tmp.Free;
+  End;
+End;
+
+Procedure TX11Console.Open(Const ATitle : String; Const AFormat : TPTCFormat;
+                           APages : Integer = 0);
+
+Begin
+  Open(ATitle, 640, 480, AFormat, APages);
+End;
+
+Procedure TX11Console.Open(Const ATitle : String; Const AMode : TPTCMode;
+                           APages : Integer = 0);
+
+Begin
+  Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages);
+End;
+
+Function TX11Console.CreateDisplay : TX11Display;
+
+Var
+  display : PDisplay;
+  screen : Integer;
+
+Begin
+  { Check if we can open an X display }
+  display := XOpenDisplay(Nil);
+  If display = Nil Then
+    Raise TPTCError.Create('Cannot open X display');
+
+  { DefaultScreen should be fine }
+  screen := DefaultScreen(display);
+
+  {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2}
+  If PTC_X11_TRY_DGA In FFlags Then
+  Begin
+    Try
+      Result := TX11DGA2Display.Create(display, screen, FFlags + [PTC_X11_LEAVE_DISPLAY]);
+      Result.SetFlags(FFlags);
+      Exit;
+    Except
+      LOG('DGA 2.0 failed');
+    End;
+  End;
+  {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2}
+
+  {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1}
+  If PTC_X11_TRY_DGA In FFlags Then
+  Begin
+    Try
+      Result := TX11DGA1Display.Create(display, screen, FFlags + [PTC_X11_LEAVE_DISPLAY]);
+      Result.SetFlags(FFlags);
+    Except
+      LOG('DGA 1.0 failed');
+    End;
+  End;
+  {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1}
+
+  Result := TX11WindowDisplay.Create(display, screen, FFlags);
+End;
+
+Procedure TX11Console.Open(Const ATitle : String; AWidth, AHeight : Integer;
+                           Const AFormat : TPTCFormat; APages : Integer = 0);
+
+Begin
+  Close;
+  FTitle := ATitle;
+
+  If FX11Display = Nil Then
+    FX11Display := CreateDisplay;
+  FX11Display.Open(ATitle, AWidth, AHeight, AFormat);
+
+  UpdateCursor;
+End;
+
+Procedure TX11Console.Close;
+
+Begin
+  FreeAndNil(FX11Display);
+End;
+
+Procedure TX11Console.Flush;
+
+Begin
+  Update;
+End;
+
+Procedure TX11Console.Finish;
+
+Begin
+  Update;
+End;
+
+Procedure TX11Console.Update;
+
+Begin
+  FX11Display.Update;
+End;
+
+Procedure TX11Console.Update(Const AArea : TPTCArea);
+
+Begin
+  FX11Display.Update(AArea);
+End;
+
+Function TX11Console.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean;
+
+Begin
+  Result := FX11Display.NextEvent(AEvent, AWait, AEventMask);
+End;
+
+Function TX11Console.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent;
+
+Begin
+  Result := FX11Display.PeekEvent(AWait, AEventMask);
+End;
+
+Procedure TX11Console.Copy(Var ASurface : TPTCBaseSurface);
+
+Begin
+  {todo!...}
+End;
+
+Procedure TX11Console.Copy(Var ASurface : TPTCBaseSurface;
+                           Const ASource, ADestination : TPTCArea);
+
+Begin
+  {todo!...}
+End;
+
+Function TX11Console.Lock : Pointer;
+
+Begin
+  Result := FX11Display.Lock;
+End;
+
+Procedure TX11Console.Unlock;
+
+Begin
+  FX11Display.Unlock;
+End;
+
+Procedure TX11Console.Load(Const APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette);
+
+Begin
+  FX11Display.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette);
+End;
+
+Procedure TX11Console.Load(Const APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette;
+                           Const ASource, ADestination : TPTCArea);
+
+Begin
+  FX11Display.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination);
+End;
+
+Procedure TX11Console.Save(APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette);
+
+Begin
+  {todo!...}
+End;
+
+Procedure TX11Console.Save(APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette;
+                           Const ASource, ADestination : TPTCArea);
+
+Begin
+  {todo!...}
+End;
+
+Procedure TX11Console.Clear;
+
+Var
+  tmp : TPTCColor;
+
+Begin
+  If Format.Direct Then
+    tmp := TPTCColor.Create(0, 0, 0, 0)
+  Else
+    tmp := TPTCColor.Create(0);
+  Try
+    Clear(tmp);
+  Finally
+    tmp.Free;
+  End;
+End;
+
+Procedure TX11Console.Clear(Const AColor : TPTCColor);
+
+Begin
+  FX11Display.Clear(AColor);
+End;
+
+Procedure TX11Console.Clear(Const AColor : TPTCColor;
+                            Const AArea : TPTCArea);
+
+Begin
+  FX11Display.Clear(AColor, AArea);
+End;
+
+Procedure TX11Console.Palette(Const APalette : TPTCPalette);
+
+Begin
+  FX11Display.Palette(APalette);
+End;
+
+Function TX11Console.Palette : TPTCPalette;
+
+Begin
+  Result := FX11Display.Palette;
+End;
+
+Procedure TX11Console.Clip(Const AArea : TPTCArea);
+
+Begin
+  FX11Display.Clip(AArea);
+End;
+
+Function TX11Console.GetWidth : Integer;
+
+Begin
+  Result := FX11Display.Width;
+End;
+
+Function TX11Console.GetHeight : Integer;
+
+Begin
+  Result := FX11Display.Height;
+End;
+
+Function TX11Console.GetPitch : Integer;
+
+Begin
+  Result := FX11Display.Pitch;
+End;
+
+Function TX11Console.GetPages : Integer;
+
+Begin
+  Result := 2;
+End;
+
+Function TX11Console.GetArea : TPTCArea;
+
+Begin
+  Result := FX11Display.Area;
+End;
+
+Function TX11Console.Clip : TPTCArea;
+
+Begin
+  Result := FX11Display.Clip;
+End;
+
+Function TX11Console.GetFormat : TPTCFormat;
+
+Begin
+  Result := FX11Display.Format;
+End;
+
+Function TX11Console.GetName : String;
+
+Begin
+  Result := 'X11';
+End;
+
+Function TX11Console.GetTitle : String;
+
+Begin
+  Result := FTitle;
+End;
+
+Function TX11Console.GetInformation : String;
+
+Begin
+  If FX11Display = Nil Then
+    Exit('PTC X11');
+  Result := 'PTC X11, ';
+  If FX11Display.IsFullScreen Then
+    Result := Result + 'fullscreen '
+  Else
+    Result := Result + 'windowed ';
+
+  { TODO: use virtual methods, instead of "is" }
+  If FX11Display Is TX11WindowDisplay Then
+  Begin
+    If TX11WindowDisplay(FX11Display).FPrimary <> Nil Then
+      Result := Result + '(' + TX11WindowDisplay(FX11Display).FPrimary.Name + ') '
+    Else
+      Result := Result + '';
+  End
+  Else
+  Begin
+    {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2}
+    If FX11Display Is TX11DGA2Display Then
+      Result := Result + '(DGA) '
+    Else
+    {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2}
+    {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1}
+    If FX11Display Is TX11DGA1Display Then
+      Result := Result + '(DGA) '
+    Else
+    {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1}
+    Begin
+      {...}
+    End;
+  End;
+  Result := Result + 'mode, ' +
+            IntToStr(FX11Display.Width) + 'x' +
+            IntToStr(FX11Display.Height) + ', ' +
+            IntToStr(FX11Display.Format.Bits) + ' bit';
+End;
+
+Procedure TX11Console.UpdateCursor;
+
+Begin
+  If Assigned(FX11Display) Then
+  Begin
+    If FX11Display.IsFullScreen Then
+      FX11Display.SetCursor(PTC_X11_FULLSCREEN_CURSOR_VISIBLE In FFlags)
+    Else
+      FX11Display.SetCursor(Not (PTC_X11_WINDOWED_CURSOR_INVISIBLE In FFlags));
+  End;
+End;

packages/extra/ptc/x11/x11dga1displayd.inc

@@ -0,0 +1,45 @@
+{$IFDEF ENABLE_X11_EXTENSION_XF86DGA1}
+
+Type
+  TX11DGA1Display = Class(TX11Display)
+  Private
+    Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Override;
+
+    Procedure HandleEvents;
+
+    FModeInfo : PPXF86VidModeModeInfo;
+    FModeInfoNum : Integer;
+    FPreviousMode : Integer;
+
+    FDGAAddr : PByte;
+    FDGALineWidth : Integer;
+    FDGABankSize : Integer;
+    FDGAMemSize : Integer;
+    FDGAWidth, FDGAHeight : Integer;
+
+    { Coordinates of upper left frame corner }
+    FDestX, FDestY : Integer;
+
+    FInDirect, FInMode : Boolean;
+  Public
+    Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Override;
+    Destructor Destroy; Override;
+
+    Procedure Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); Override;
+    Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat); Override;
+    Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); Override;
+    Procedure Close; Override;
+    Procedure GetModes(Var AModes : TPTCModeDynArray); Override;
+    Procedure Update; Override;
+    Procedure Update(Const AArea : TPTCArea); Override;
+    Function Lock : Pointer; Override;
+    Procedure Unlock; Override;
+    Procedure Palette(Const APalette : TPTCPalette); Override;
+    Function GetPitch : Integer; Override;
+    Function GetX11Window : TWindow; Override;
+    Function IsFullScreen : Boolean; Override;
+    Procedure SetCursor(AVisible : Boolean); Override;
+  End;
+
+{$ENDIF ENABLE_X11_EXTENSION_XF86DGA1}

packages/extra/ptc/x11/x11dga1displayi.inc

@@ -0,0 +1,507 @@
+{$IFDEF ENABLE_X11_EXTENSION_XF86DGA1}
+
+Constructor TX11DGA1Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags);
+
+Var
+  dummy1, dummy2 : Integer;
+
+Begin
+  Inherited;
+
+  LOG('trying to create a DGA 1.0 display');
+
+  FInDirect := False;
+  FInMode := False;
+  FModeInfo := Nil;
+
+  { Check if we are root }
+  If fpgeteuid <> 0 Then
+    Raise TPTCError.Create('Have to be root to switch to DGA mode');
+
+  { Check if the DGA extension and VidMode extension can be used }
+  If Not XF86DGAQueryExtension(FDisplay, @dummy1, @dummy2) Then
+    Raise TPTCError.Create('DGA extension not available');
+  If Not XF86VidModeQueryExtension(FDisplay, @dummy1, @dummy2) Then
+    Raise TPTCError.Create('VidMode extension not available');
+End;
+
+Destructor TX11DGA1Display.Destroy;
+
+Begin
+  Close;
+  Inherited Destroy;
+End;
+
+Procedure TX11DGA1Display.Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat);
+
+Var
+  vml : PXF86VidModeModeLine;
+  dotclock : Integer;
+  i : Integer;
+  root : TWindow;
+  e : TXEvent;
+  found : Boolean;
+  tmpArea : TPTCArea;
+  r, g, b : Single;
+  found_mode : Integer;
+  min_diff : Integer;
+  d_x, d_y : Integer;
+
+Begin
+  FWidth := AWidth;
+  FHeight := AHeight;
+
+  { Get all availabe video modes }
+  XF86VidModeGetAllModeLines(FDisplay, FScreen, @FModeInfoNum, @FModeInfo);
+
+  FPreviousMode := -1;
+  { Save previous mode }
+  New(vml);
+  Try
+    XF86VidModeGetModeLine(FDisplay, FScreen, @dotclock, vml);
+    Try
+      For i := 0 To FModeInfoNum - 1 Do
+      Begin
+        If (vml^.hdisplay = FModeInfo[i]^.hdisplay) And
+           (vml^.vdisplay = FModeInfo[i]^.vdisplay) Then
+        Begin
+          FPreviousMode := i;
+          Break;
+        End;
+      End;
+    Finally
+      If vml^.privsize <> 0 Then
+        XFree(vml^.c_private);
+    End;
+  Finally
+    Dispose(vml);
+  End;
+  If FPreviousMode = -1 Then
+    Raise TPTCError.Create('Current mode not found in modelist?! Err, this shouldn''t happen :)');
+
+  { Find a video mode to set }
+
+  { Normal modesetting first, find exactly matching mode }
+  found_mode := -1;
+  For i := 0 To FModeInfoNum - 1 Do
+    If (FModeInfo[i]^.hdisplay = AWidth) And (FModeInfo[i]^.vdisplay = AHeight) Then
+    Begin
+      found_mode := i;
+      Break;
+    End;
+
+  { Try to find a mode that matches the width first }
+  If found_mode = -1 Then
+    For i := 0 To FModeInfoNum - 1 Do
+      If (FModeInfo[i]^.hdisplay = AWidth) And
+         (FModeInfo[i]^.vdisplay >= AHeight) Then
+      Begin
+        found_mode := i;
+        Break;
+      End;
+
+  { Next try to match the height }
+  If found_mode = -1 Then
+    For i := 0 To FModeInfoNum - 1 Do
+      If (FModeInfo[i]^.hdisplay >= AWidth) And
+         (FModeInfo[i]^.vdisplay = AHeight) Then
+      Begin
+        found_mode := i;
+        Break;
+      End;
+
+  If found_mode = -1 Then
+  Begin
+    { Finally, find the mode that is bigger than the requested one and makes }
+    { the least difference }
+    min_diff := 987654321;
+    For i := 0 To FModeInfoNum - 1 Do
+      If (FModeInfo[i]^.hdisplay >= AWidth) And (FModeInfo[i]^.vdisplay >= AHeight) Then
+      Begin
+        d_x := Sqr(FModeInfo[i]^.hdisplay - AWidth);
+        d_y := Sqr(FModeInfo[i]^.vdisplay - AHeight);
+        If (d_x + d_y) < min_diff Then
+        Begin
+          min_diff := d_x + d_y;
+          found_mode := i;
+        End;
+      End;
+  End;
+
+  If found_mode = -1 Then
+    Raise TPTCError.Create('Cannot find a video mode to use');
+
+  If Not XF86VidModeSwitchToMode(FDisplay, FScreen, FModeInfo[found_mode]) Then
+    Raise TPTCError.Create('Error switching to requested video mode');
+  FDestX := (FModeInfo[found_mode]^.hdisplay Div 2) - (AWidth Div 2);
+  FDestY := (FModeInfo[found_mode]^.vdisplay Div 2) - (AHeight Div 2);
+
+  XFlush(FDisplay);
+  FInMode := True;
+
+  { Check if the requested colour mode is available }
+  FFormat := GetX11Format(AFormat);
+
+  { Grab exclusive control over the keyboard and mouse }
+  root := XRootWindow(FDisplay, FScreen);
+  XGrabKeyboard(FDisplay, root, True, GrabModeAsync, GrabModeAsync, CurrentTime);
+  XGrabPointer(FDisplay, root, True, PointerMotionMask Or ButtonPressMask Or
+               ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None,
+               CurrentTime);
+  XFlush(FDisplay);
+
+  { Get Display information }
+  XF86DGAGetVideo(FDisplay, FScreen, @FDGAAddr, @FDGALineWidth,
+                  @FDGABankSize, @FDGAMemSize);
+
+  { Don't have to be root anymore }
+{  fpsetuid(fpgetuid);...}
+
+  XF86DGAGetViewPortSize(FDisplay, FScreen, @FDGAWidth, @FDGAHeight);
+
+  If XF86DGAForkApp(FScreen) <> 0 Then
+    Raise TPTCError.Create('cannot do safety fork');
+
+  If XF86DGADirectVideo(FDisplay, FScreen, XF86DGADirectGraphics Or
+      XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then
+    Raise TPTCError.Create('cannot switch to DGA mode');
+
+  FInDirect := True;
+  FillChar(FDGAAddr^, FDGALineWidth * FDGAHeight * (FFormat.Bits Div 8), 0);
+
+  XSelectInput(FDisplay, DefaultRootWindow(FDisplay),
+               KeyPressMask Or KeyReleaseMask);
+
+  XF86DGASetViewPort(FDisplay, FScreen, 0, 0); { Important.. sort of =) }
+
+  found := False;
+  Repeat
+    { Stupid loop. The key }
+    { events were causing }
+    { problems.. }
+    found := XCheckMaskEvent(FDisplay, KeyPressMask Or KeyReleaseMask, @e);
+  Until Not found;
+
+  { Create colour map in 8 bit mode }
+  If FFormat.Bits = 8 Then
+  Begin
+    FColours := GetMem(256 * SizeOf(TXColor));
+    If FColours = Nil Then
+      Raise TPTCError.Create('Cannot allocate colour map cells');
+    FCMap := XCreateColormap(FDisplay, RootWindow(FDisplay, FScreen),
+                             DefaultVisual(FDisplay, FScreen), AllocAll);
+    If FCMap = 0 Then
+      Raise TPTCError.Create('Cannot create colour map');
+  End
+  Else
+    FCMap := 0;
+
+  { Set 332 palette, for now }
+  If (FFormat.Bits = 8) And FFormat.Direct Then
+  Begin
+    {Taken from PTC 0.72, i hope it's fine}
+    For i := 0 To 255 Do
+    Begin
+      r := ((i And $E0) Shr 5) * 255 / 7;
+      g := ((i And $1C) Shr 2) * 255 / 7;
+      b := (i And $03) * 255 / 3;
+
+      FColours[i].pixel := i;
+
+      FColours[i].red := Round(r) Shl 8;
+      FColours[i].green := Round(g) Shl 8;
+      FColours[i].blue := Round(b) Shl 8;
+
+      Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue;
+    End;
+    XStoreColors(FDisplay, FCMap, FColours, 256);
+    XF86DGAInstallColormap(FDisplay, FScreen, FCMap);
+  End;
+
+  { Set clipping area }
+  tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight);
+  Try
+    FClip.Assign(tmpArea);
+  Finally
+    tmpArea.Free;
+  End;
+End;
+
+{ Not in DGA mode }
+Procedure TX11DGA1Display.Open(AWindow : TWindow; Const AFormat : TPTCFormat);
+
+Begin
+  If AWindow = 0 Then; { Prevent warnings }
+  If AFormat = Nil Then;
+End;
+
+Procedure TX11DGA1Display.Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer);
+
+Begin
+  If (AWindow = 0) Or
+     (AFormat = Nil) Or
+     (AX = 0) Or
+     (AY = 0) Or
+     (AWidth = 0) Or
+     (AHeight = 0) Then;
+End;
+
+Procedure TX11DGA1Display.Close;
+
+Begin
+  If FInDirect Then
+  Begin
+    FInDirect := False;
+    XF86DGADirectVideo(FDisplay, FScreen, 0);
+  End;
+
+  If FInMode Then
+  Begin
+    FInMode := False;
+    XF86VidModeSwitchToMode(FDisplay, FScreen, FModeInfo[FPreviousMode]);
+    XUngrabKeyboard(FDisplay, CurrentTime);
+    XUngrabPointer(FDisplay, CurrentTime);
+  End;
+
+  If FDisplay <> Nil Then
+    XFlush(FDisplay);
+
+  If FCMap <> 0 Then
+  Begin
+    XFreeColormap(FDisplay, FCMap);
+    FCMap := 0;
+  End;
+
+  FreeMemAndNil(FColours);
+
+  If FModeInfo <> Nil Then
+  Begin
+    XFree(FModeInfo);
+    FModeInfo := Nil;
+  End;
+End;
+
+Procedure TX11DGA1Display.GetModes(Var AModes : TPTCModeDynArray);
+
+Begin
+  SetLength(AModes, 1);
+  AModes[0] := TPTCMode.Create;
+  {todo...}
+End;
+
+Procedure TX11DGA1Display.Update;
+
+Begin
+End;
+
+Procedure TX11DGA1Display.Update(Const AArea : TPTCArea);
+
+Begin
+End;
+
+Procedure TX11DGA1Display.HandleEvents;
+
+Var
+  e : TXEvent;
+  NewFocus : Boolean;
+  NewFocusSpecified : Boolean;
+
+  Function UsefulEventsPending : Boolean;
+
+  Var
+    tmpEvent : TXEvent;
+
+  Begin
+    If XCheckTypedEvent(FDisplay, ClientMessage, @tmpEvent) Then
+    Begin
+      Result := True;
+      XPutBackEvent(FDisplay, @tmpEvent);
+      Exit;
+    End;
+
+    If XCheckMaskEvent(FDisplay, FocusChangeMask Or
+                       KeyPressMask Or KeyReleaseMask Or
+                       ButtonPressMask Or ButtonReleaseMask Or
+                       PointerMotionMask Or ExposureMask, @tmpEvent) Then
+    Begin
+      Result := True;
+      XPutBackEvent(FDisplay, @tmpEvent);
+      Exit;
+    End;
+
+    Result := False;
+  End;
+
+  Procedure HandleKeyEvent;
+
+  Var
+    sym : TKeySym;
+    sym_modded : TKeySym; { modifiers like shift are taken into account here }
+    press : Boolean;
+    alt, shift, ctrl : Boolean;
+    uni : Integer;
+    key : TPTCKeyEvent;
+    buf : Array[1..16] Of Char;
+
+  Begin
+    sym := XLookupKeySym(@e.xkey, 0);
+    XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil);
+    uni := X11ConvertKeySymToUnicode(sym_modded);
+    alt := (e.xkey.state And Mod1Mask) <> 0;
+    shift := (e.xkey.state And ShiftMask) <> 0;
+    ctrl := (e.xkey.state And ControlMask) <> 0;
+    If e._type = KeyPress Then
+      press := True
+    Else
+      press := False;
+
+    key := Nil;
+    Case sym Shr 8 Of
+      0 : key := TPTCKeyEvent.Create(FNormalKeys[sym And $FF], uni, alt, shift, ctrl, press);
+      $FF : key := TPTCKeyEvent.Create(FFunctionKeys[sym And $FF], uni, alt, shift, ctrl, press);
+      Else
+        key := TPTCKeyEvent.Create;
+    End;
+    FEventQueue.AddEvent(key);
+  End;
+
+Begin
+  NewFocusSpecified := False;
+  While UsefulEventsPending Do
+  Begin
+    XNextEvent(FDisplay, @e);
+    Case e._type Of
+      FocusIn : Begin
+        NewFocus := True;
+        NewFocusSpecified := True;
+      End;
+      FocusOut : Begin
+        NewFocus := False;
+        NewFocusSpecified := True;
+      End;
+      ClientMessage : Begin
+{        If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then
+          Halt(0);}
+      End;
+      Expose : Begin
+        {...}
+      End;
+      KeyPress, KeyRelease : HandleKeyEvent;
+      ButtonPress, ButtonRelease : Begin
+        {...}
+      End;
+      MotionNotify : Begin
+        {...}
+      End;
+    End;
+  End;
+//  HandleChangeFocus(NewFocus);
+End;
+
+Function TX11DGA1Display.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean;
+
+Var
+  tmpEvent : TXEvent;
+
+Begin
+  FreeAndNil(AEvent);
+  Repeat
+    { process all events from the X queue and put them on our FEventQueue }
+    HandleEvents;
+
+    { try to find an event that matches the EventMask }
+    AEvent := FEventQueue.NextEvent(AEventMask);
+
+    If AWait And (AEvent = Nil) Then
+    Begin
+      { if the X event queue is empty, block until an event is received }
+      XPeekEvent(FDisplay, @tmpEvent);
+    End;
+  Until (Not AWait) Or (AEvent <> Nil);
+  Result := AEvent <> Nil;
+End;
+
+Function TX11DGA1Display.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent;
+
+Var
+  tmpEvent : TXEvent;
+
+Begin
+  Repeat
+    { process all events from the X queue and put them on our FEventQueue }
+    HandleEvents;
+
+    { try to find an event that matches the EventMask }
+    Result := FEventQueue.PeekEvent(AEventMask);
+
+    If AWait And (Result = Nil) Then
+    Begin
+      { if the X event queue is empty, block until an event is received }
+      XPeekEvent(FDisplay, @tmpEvent);
+    End;
+  Until (Not AWait) Or (Result <> Nil);
+End;
+
+
+Function TX11DGA1Display.Lock : Pointer;
+
+Begin
+  Result := FDGAAddr + FDGALineWidth * FDestY * (FFormat.Bits Div 8) +
+                       FDestX * (FFormat.Bits Div 8);
+End;
+
+Procedure TX11DGA1Display.Unlock;
+
+Begin
+End;
+
+Procedure TX11DGA1Display.Palette(Const APalette : TPTCPalette);
+
+Var
+  pal : PUint32;
+  i : Integer;
+
+Begin
+  pal := APalette.data;
+  If Not FFormat.Indexed Then
+    Exit;
+  For i := 0 To 255 Do
+  Begin
+    FColours[i].pixel := i;
+
+    FColours[i].red := ((pal[i] Shr 16) And $FF) Shl 8;
+    FColours[i].green := ((pal[i] Shr 8) And $FF) Shl 8;
+    FColours[i].blue := (pal[i] And $FF) Shl 8;
+
+    Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue;
+  End;
+  XStoreColors(FDisplay, FCMap, FColours, 256);
+  XF86DGAInstallColormap(FDisplay, FScreen, FCMap);
+End;
+
+Function TX11DGA1Display.GetPitch : Integer;
+
+Begin
+  Result := FDGALineWidth * (FFormat.Bits Div 8);
+End;
+
+Function TX11DGA1Display.GetX11Window : TWindow;
+
+Begin
+  Result := DefaultRootWindow(FDisplay);
+End;
+
+Function TX11DGA1Display.IsFullScreen : Boolean;
+
+Begin
+  { DGA is always fullscreen }
+  Result := True;
+End;
+
+Procedure TX11DGA1Display.SetCursor(AVisible : Boolean);
+
+Begin
+  {nothing... raise exception if visible=true?}
+End;
+
+{$ENDIF ENABLE_X11_EXTENSION_XF86DGA1}

packages/extra/ptc/x11/x11dga2displayd.inc

@@ -0,0 +1,44 @@
+{$IFDEF ENABLE_X11_EXTENSION_XF86DGA2}
+
+Type
+  TX11DGA2Display = Class(TX11Display)
+  Private
+    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override;
+
+    Procedure HandleEvents;
+
+    { The list of available modes (todo: move to local vars in the open function) }
+    FXDGAModes : PXDGAMode;
+    FXDGAModesNum : cint;
+
+    { Holds the pointer to the framebuffer and all the other information for
+      the current mode (or nil, if a mode isn't open) }
+    FXDGADevice : PXDGADevice;
+
+    { Coordinates of upper left frame corner }
+    m_destx, m_desty : Integer;
+
+    FModeIsSet : Boolean;
+    FFramebufferIsOpen : Boolean;
+  Public
+    Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Override;
+    Destructor Destroy; Override;
+
+    Procedure open(title : String; _width, _height : Integer; Const _format : TPTCFormat); Override;
+    Procedure open(w : TWindow; Const _format : TPTCFormat); Override;
+    Procedure open(_window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); Override;
+    Procedure close; Override;
+    Procedure GetModes(Var AModes : TPTCModeDynArray); Override;
+    Procedure update; Override;
+    Procedure update(Const _area : TPTCArea); Override;
+    Function lock : Pointer; Override;
+    Procedure unlock; Override;
+    Procedure palette(Const _palette : TPTCPalette); Override;
+    Function GetPitch : Integer; Override;
+    Function getX11Window : TWindow; Override;
+    Function isFullScreen : Boolean; Override;
+    Procedure SetCursor(visible : Boolean); Override;
+  End;
+
+{$ENDIF ENABLE_X11_EXTENSION_XF86DGA2}

packages/extra/ptc/x11/x11dga2displayi.inc

@@ -0,0 +1,451 @@
+{$IFDEF ENABLE_X11_EXTENSION_XF86DGA2}
+
+Constructor TX11DGA2Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags);
+
+Var
+  dummy1, dummy2 : cint;
+
+Begin
+  Inherited;
+
+  LOG('trying to open a DGA 2.0 display');
+
+  { Check if the DGA extension can be used }
+  LOG('checking if the DGA extension can be used (XDGAQueryExtension)');
+  If Not XDGAQueryExtension(FDisplay, @dummy1, @dummy2) Then
+    Raise TPTCError.Create('DGA extension not available');
+End;
+
+Destructor TX11DGA2Display.Destroy;
+
+Begin
+  Close;
+  Inherited Destroy;
+End;
+
+Procedure TX11DGA2Display.open(title : String; _width, _height : Integer; Const _format : TPTCFormat);
+
+Var
+  vml : PXF86VidModeModeLine;
+  dotclock : Integer;
+  i : Integer;
+  found : Boolean;
+  root : TWindow;
+  e : TXEvent;
+  tmpArea : TPTCArea;
+  r, g, b : Single;
+  found_mode : Integer;
+  min_diff : Integer;
+  d_x, d_y : Integer;
+
+Begin
+  FWidth := _width;
+  FHeight := _height;
+
+  LOG('trying to open framebuffer (XDGAOpenFramebuffer)');
+  If Not XDGAOpenFramebuffer(FDisplay, FScreen) Then
+    Raise TPTCError.Create('Cannot open framebuffer - insufficient privileges?');
+  FFramebufferIsOpen := True;
+
+  { Get all availabe video modes }
+  LOG('querying available display modes (XDGAQueryModes)');
+  FXDGAModes := XDGAQueryModes(FDisplay, FScreen, @FXDGAModesNum);
+
+  LOG('number of display modes', FXDGAModesNum);
+
+  For I := 0 To FXDGAModesNum - 1 Do
+  Begin
+    LOG('mode#', I);
+    LOG('num', FXDGAModes[I].num);
+    LOG('name: ' + FXDGAModes[I].name);
+  End;
+
+  found_mode := 0; // todo: find a video mode
+
+  Raise TPTCError.Create('break! dga 2.0 code unfinished');
+
+  FXDGADevice := XDGASetMode(FDisplay, FScreen, found_mode);
+  If FXDGADevice = Nil Then
+    Raise TPTCError.Create('XDGASetMode failed (returned nil)');
+  If FXDGADevice^.data = Nil Then
+    Raise TPTCError.Create('The pointer to the framebuffer, returned by XDGA is nil?!');
+  FModeIsSet := True;
+
+  { Check if the requested colour mode is available }
+  FFormat := GetX11Format(_format);
+
+  { Grab exclusive control over the keyboard and mouse }
+{  root := XRootWindow(FDisplay, FScreen);
+  XGrabKeyboard(FDisplay, root, True, GrabModeAsync, GrabModeAsync, CurrentTime);
+  XGrabPointer(FDisplay, root, True, PointerMotionMask Or ButtonPressMask Or
+               ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None,
+               CurrentTime);}
+  XFlush(FDisplay);
+
+  { Get Display information }
+{  XF86DGAGetVideo(FDisplay, FScreen, @dga_addr, @dga_linewidth,
+                  @dga_banksize, @dga_memsize);}
+
+  { Don't have to be root anymore }
+{  setuid(getuid);...}
+
+//  XF86DGAGetViewPortSize(FDisplay, FScreen, @dga_width, @dga_height);
+
+{  If XF86DGAForkApp(FScreen) <> 0 Then
+    Raise TPTCError.Create('cannot do safety fork')
+  Else
+  Begin
+    If XF86DGADirectVideo(FDisplay, FScreen, XF86DGADirectGraphics Or
+      XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then
+      Raise TPTCError.Create('cannot switch to DGA mode');
+  End;}
+
+//  m_indirect := True;
+//  FillChar(dga_addr^, dga_linewidth * dga_height * (FFormat.bits Div 8), 0);
+
+  XSelectInput(FDisplay, DefaultRootWindow(FDisplay),
+               KeyPressMask Or KeyReleaseMask);
+
+  XF86DGASetViewPort(FDisplay, FScreen, 0, 0); { Important.. sort of =) }
+
+  found := False;
+  Repeat
+    { Stupid loop. The key }
+    { events were causing }
+    { problems.. }
+    found := XCheckMaskEvent(FDisplay, KeyPressMask Or KeyReleaseMask, @e);
+  Until Not found;
+
+  { Create colour map in 8 bit mode }
+  If FFormat.bits = 8 Then
+  Begin
+    FColours := GetMem(256 * SizeOf(TXColor));
+    If FColours = Nil Then
+      Raise TPTCError.Create('Cannot allocate colour map cells');
+    FCMap := XCreateColormap(FDisplay, RootWindow(FDisplay, FScreen),
+                              DefaultVisual(FDisplay, FScreen), AllocAll);
+    If FCMap = 0 Then
+      Raise TPTCError.Create('Cannot create colour map');
+  End
+  Else
+    FCMap := 0;
+
+  { Set 332 palette, for now }
+  If (FFormat.bits = 8) And FFormat.direct Then
+  Begin
+    {Taken from PTC 0.72, i hope it's fine}
+    For i := 0 To 255 Do
+    Begin
+      r := ((i And $E0) Shr 5) * 255 / 7;
+      g := ((i And $1C) Shr 2) * 255 / 7;
+      b := (i And $03) * 255 / 3;
+
+      FColours[i].pixel := i;
+
+      FColours[i].red := Round(r) Shl 8;
+      FColours[i].green := Round(g) Shl 8;
+      FColours[i].blue := Round(b) Shl 8;
+
+      Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue;
+    End;
+    XStoreColors(FDisplay, FCMap, FColours, 256);
+    XF86DGAInstallColormap(FDisplay, FScreen, FCMap);
+  End;
+
+  { Set clipping area }
+  tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight);
+  Try
+    FClip.Assign(tmpArea);
+  Finally
+    tmpArea.Free;
+  End;
+End;
+
+{ Not in DGA mode }
+Procedure TX11DGA2Display.open(w : TWindow; Const _format : TPTCFormat);
+
+Begin
+  If w = 0 Then; { Prevent warnings }
+  If _format = Nil Then;
+End;
+
+Procedure TX11DGA2Display.open(_window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer);
+
+Begin
+  If (_window = 0) Or (_format = Nil) Or (x = 0) Or
+     (y = 0) Or (w = 0) Or (h = 0) Then;
+End;
+
+Procedure TX11DGA2Display.close;
+
+Var
+  tmp : Pointer;
+
+Begin
+  If FModeIsSet Then
+  Begin
+    FModeIsSet := False;
+
+    { restore the original mode }
+    XDGASetMode(FDisplay, FScreen, 0); { returns PXDGADevice }
+{    XUngrabKeyboard(FDisplay, CurrentTime);
+    XUngrabPointer(FDisplay, CurrentTime);}
+  End;
+
+  If FFramebufferIsOpen Then
+  Begin
+    FFramebufferIsOpen := False;
+    XDGACloseFramebuffer(FDisplay, FScreen);
+  End;
+
+  If FDisplay <> Nil Then
+    XFlush(FDisplay);
+
+  If FCMap <> 0 Then
+  Begin
+    XFreeColormap(FDisplay, FCMap);
+    FCMap := 0;
+  End;
+
+  FreeMemAndNil(FColours);
+
+  If FXDGADevice <> Nil Then
+  Begin
+    tmp := FXDGADevice;
+    FXDGADevice := Nil;
+    XFree(tmp);
+  End;
+
+  If FXDGAModes <> Nil Then
+  Begin
+    tmp := FXDGAModes;
+    FXDGAModes := Nil;
+    XFree(tmp);
+  End;
+End;
+
+Procedure TX11DGA2Display.GetModes(Var AModes : TPTCModeDynArray);
+
+Begin
+  SetLength(AModes, 1);
+  AModes[0] := TPTCMode.Create;
+  {todo...}
+End;
+
+Procedure TX11DGA2Display.update;
+
+Begin
+End;
+
+Procedure TX11DGA2Display.update(Const _area : TPTCArea);
+
+Begin
+End;
+
+Procedure TX11DGA2Display.HandleEvents;
+
+Var
+  e : TXEvent;
+  NewFocus : Boolean;
+  NewFocusSpecified : Boolean;
+
+  Function UsefulEventsPending : Boolean;
+
+  Var
+    tmpEvent : TXEvent;
+
+  Begin
+    If XCheckTypedEvent(FDisplay, ClientMessage, @tmpEvent) Then
+    Begin
+      Result := True;
+      XPutBackEvent(FDisplay, @tmpEvent);
+      Exit;
+    End;
+
+    If XCheckMaskEvent(FDisplay, FocusChangeMask Or
+                       KeyPressMask Or KeyReleaseMask Or
+                       ButtonPressMask Or ButtonReleaseMask Or
+                       PointerMotionMask Or ExposureMask, @tmpEvent) Then
+    Begin
+      Result := True;
+      XPutBackEvent(FDisplay, @tmpEvent);
+      Exit;
+    End;
+
+    Result := False;
+  End;
+
+  Procedure HandleKeyEvent;
+
+  Var
+    sym : TKeySym;
+    sym_modded : TKeySym; { modifiers like shift are taken into account here }
+    press : Boolean;
+    alt, shift, ctrl : Boolean;
+    uni : Integer;
+    key : TPTCKeyEvent;
+    buf : Array[1..16] Of Char;
+
+  Begin
+    sym := XLookupKeySym(@e.xkey, 0);
+    XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil);
+    uni := X11ConvertKeySymToUnicode(sym_modded);
+    alt := (e.xkey.state And Mod1Mask) <> 0;
+    shift := (e.xkey.state And ShiftMask) <> 0;
+    ctrl := (e.xkey.state And ControlMask) <> 0;
+    If e._type = KeyPress Then
+      press := True
+    Else
+      press := False;
+
+    key := Nil;
+    Case sym Shr 8 Of
+      0 : key := TPTCKeyEvent.Create(FNormalKeys[sym And $FF], uni, alt, shift, ctrl, press);
+      $FF : key := TPTCKeyEvent.Create(FFunctionKeys[sym And $FF], uni, alt, shift, ctrl, press);
+      Else
+        key := TPTCKeyEvent.Create;
+    End;
+    FEventQueue.AddEvent(key);
+  End;
+
+Begin
+  NewFocusSpecified := False;
+  While UsefulEventsPending Do
+  Begin
+    XNextEvent(FDisplay, @e);
+    Case e._type Of
+      FocusIn : Begin
+        NewFocus := True;
+        NewFocusSpecified := True;
+      End;
+      FocusOut : Begin
+        NewFocus := False;
+        NewFocusSpecified := True;
+      End;
+      ClientMessage : Begin
+{        If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then
+          Halt(0);}
+      End;
+      Expose : Begin
+        {...}
+      End;
+      KeyPress, KeyRelease : HandleKeyEvent;
+      ButtonPress, ButtonRelease : Begin
+        {...}
+      End;
+      MotionNotify : Begin
+        {...}
+      End;
+    End;
+  End;
+//  HandleChangeFocus(NewFocus);
+End;
+
+Function TX11DGA2Display.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean;
+
+Var
+  tmpEvent : TXEvent;
+
+Begin
+  FreeAndNil(event);
+  Repeat
+    { process all events from the X queue and put them on our FEventQueue }
+    HandleEvents;
+
+    { try to find an event that matches the EventMask }
+    event := FEventQueue.NextEvent(EventMask);
+
+    If wait And (event = Nil) Then
+    Begin
+      { if the X event queue is empty, block until an event is received }
+      XPeekEvent(FDisplay, @tmpEvent);
+    End;
+  Until (Not Wait) Or (event <> Nil);
+  Result := event <> Nil;
+End;
+
+Function TX11DGA2Display.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent;
+
+Var
+  tmpEvent : TXEvent;
+
+Begin
+  Repeat
+    { process all events from the X queue and put them on our FEventQueue }
+    HandleEvents;
+
+    { try to find an event that matches the EventMask }
+    Result := FEventQueue.PeekEvent(EventMask);
+
+    If wait And (Result = Nil) Then
+    Begin
+      { if the X event queue is empty, block until an event is received }
+      XPeekEvent(FDisplay, @tmpEvent);
+    End;
+  Until (Not Wait) Or (Result <> Nil);
+End;
+
+
+Function TX11DGA2Display.lock : Pointer;
+
+Begin
+  lock := PByte(FXDGADevice^.data) +
+          FXDGADevice^.mode.bytesPerScanline * m_desty +
+          m_destx * (FXDGADevice^.mode.bitsPerPixel Div 8);
+End;
+
+Procedure TX11DGA2Display.unlock;
+
+Begin
+End;
+
+Procedure TX11DGA2Display.palette(Const _palette : TPTCPalette);
+
+Var
+  pal : PUint32;
+  i : Integer;
+
+Begin
+  pal := _palette.data;
+  If Not FFormat.indexed Then
+    Exit;
+  For i := 0 To 255 Do
+  Begin
+    FColours[i].pixel := i;
+
+    FColours[i].red := ((pal[i] Shr 16) And $FF) Shl 8;
+    FColours[i].green := ((pal[i] Shr 8) And $FF) Shl 8;
+    FColours[i].blue := (pal[i] And $FF) Shl 8;
+
+    Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue;
+  End;
+  XStoreColors(FDisplay, FCMap, FColours, 256);
+  XF86DGAInstallColormap(FDisplay, FScreen, FCMap);
+End;
+
+Function TX11DGA2Display.GetPitch : Integer;
+
+Begin
+  Result := FXDGADevice^.mode.bytesPerScanline;
+End;
+
+Function TX11DGA2Display.getX11Window : TWindow;
+
+Begin
+  Result := DefaultRootWindow(FDisplay);
+End;
+
+Function TX11DGA2Display.isFullScreen : Boolean;
+
+Begin
+  { DGA is always fullscreen }
+  Result := True;
+End;
+
+Procedure TX11DGA2Display.SetCursor(visible : Boolean);
+
+Begin
+  {nothing... raise exception if visible=true?}
+End;
+
+{$ENDIF ENABLE_X11_EXTENSION_XF86DGA2}

packages/extra/ptc/x11/dgadispd.inc → packages/extra/ptc/x11/x11dgadisplayd.inc

@@ -1,8 +1,10 @@
 Type
   TX11DGADisplay = Class(TX11Display)
   Private
-    Procedure internal_ReadKey(k : TPTCKey); Override;
-    Function internal_PeekKey(k : TPTCKey) : Boolean; Override;
+    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override;
+    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override;
+    
+    Procedure HandleEvents;
     
     modeinfo : PPXF86VidModeModeInfo;
     num_modeinfo : Integer;
@@ -33,4 +35,6 @@ Type
     Procedure palette(Const _palette : TPTCPalette); Override;
     Function pitch : Integer; Override;
     Function getX11Window : TWindow; Override;
+    Function isFullScreen : Boolean; Override;
+    Procedure SetCursor(visible : Boolean); Override;
   End;