+ Upgrade PTCPas to lastest svn revision.

git-svn-id: trunk@6913 -

.gitattributes

@@ -3162,14 +3162,10 @@ packages/extra/ptc/Makefile -text
 packages/extra/ptc/Makefile.fpc -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/baseconsoled.inc svneol=native#text/x-pascal
 packages/extra/ptc/baseconsolei.inc svneol=native#text/x-pascal
-packages/extra/ptc/basesurd.inc -text
-packages/extra/ptc/basesurface.inc svneol=native#text/x-pascal
 packages/extra/ptc/basesurfaced.inc svneol=native#text/x-pascal
-packages/extra/ptc/basesuri.inc -text
+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
@@ -3283,8 +3279,8 @@ 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.cfg -text
 packages/extra/ptc/ptc.pp -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
@@ -3293,47 +3289,73 @@ packages/extra/ptc/test/view.pp -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/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/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/extensions.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/includes.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/x11windowd.inc svneol=native#text/x-pascal
-packages/extra/ptc/x11/x11windowi.inc svneol=native#text/x-pascal
-packages/extra/ptc/x11/xunikey.inc -text
+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/x11windowdisplayd.inc svneol=native#text/x-pascal
+packages/extra/ptc/x11/x11windowdisplayi.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/basecond.inc

@@ -1,57 +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
-  TPTCBaseConsole=Class(TPTCBaseSurface)
-  Private
-    FReleaseEnabled : Boolean;
-  Public
-    Constructor Create;
-    Procedure configure(Const _file : String); Virtual; Abstract;
-    Function modes : PPTCMode; Virtual; Abstract;
-    Procedure open(Const _title : String; _pages : Integer = 0); Overload; Virtual; Abstract;
-    Procedure open(Const _title : String; Const _format : TPTCFormat;
-                   _pages : Integer = 0); Overload; Virtual; Abstract;
-    Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat; _pages : Integer = 0); Overload; Virtual; Abstract;
-    Procedure open(Const _title : String; Const _mode : TPTCMode;
-                   _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(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;
-  End;

packages/extra/ptc/baseconi.inc

@@ -1,88 +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
-}
-
-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 k : TPTCKeyEvent);
-
-Var
-  ev : TPTCEvent;
-
-Begin
-  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(Var k : TPTCKeyEvent) : Boolean;
-
-Begin
-  If KeyPressed Then
-  Begin
-    ReadKey(k);
-    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/baseconsoled.inc

@@ -22,36 +22,40 @@ 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;
-    Procedure configure(Const _file : String); Virtual; Abstract;
-    Function modes : PPTCMode; Virtual; Abstract;
-    Procedure open(Const _title : String; _pages : Integer = 0); Overload; Virtual; Abstract;
-    Procedure open(Const _title : String; Const _format : TPTCFormat;
-                   _pages : Integer = 0); Overload; Virtual; Abstract;
-    Procedure open(Const _title : String; _width, _height : Integer;
-                   Const _format : TPTCFormat; _pages : Integer = 0); Overload; Virtual; Abstract;
-    Procedure open(Const _title : String; Const _mode : TPTCMode;
-                   _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;
-    
+    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 event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Virtual; Abstract;
-    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract;
-    
+    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 k : TPTCKeyEvent) : Boolean;
-    Procedure ReadKey(Var k : TPTCKeyEvent);
+    Function PeekKey(Var AKey : TPTCKeyEvent) : Boolean;
+    Procedure ReadKey(Var AKey : 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 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

@@ -45,28 +45,28 @@ Begin
   End;
 End;
 
-Procedure TPTCBaseConsole.ReadKey(Var k : TPTCKeyEvent);
+Procedure TPTCBaseConsole.ReadKey(Var AKey : TPTCKeyEvent);
 
 Var
   ev : TPTCEvent;
 
 Begin
-  ev := k;
+  ev := AKey;
   Try
     Repeat
       NextEvent(ev, True, [PTCKeyEvent]);
     Until FReleaseEnabled Or (ev As TPTCKeyEvent).Press;
   Finally
-    k := ev As TPTCKeyEvent;
+    AKey := ev As TPTCKeyEvent;
   End;
 End;
 
-Function TPTCBaseConsole.PeekKey(Var k : TPTCKeyEvent) : Boolean;
+Function TPTCBaseConsole.PeekKey(Var AKey : TPTCKeyEvent) : Boolean;
 
 Begin
   If KeyPressed Then
   Begin
-    ReadKey(k);
+    ReadKey(AKey);
     Result := True;
   End
   Else

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

@@ -20,44 +20,48 @@
 
 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
-{    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;
+    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/ptc.pp

@@ -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
@@ -20,13 +20,22 @@
 
 {$MODE objfpc}
 {$MACRO ON}
-{$DEFINE PTC_LOGGING}
 {$UNDEF ENABLE_C_API}
 
 {$H+}
 
 {$IFDEF UNIX}
-{$DEFINE HAVE_X11_EXTENSIONS_XSHM}
+
+  { 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;
@@ -40,7 +49,6 @@ Uses
 
 Const
   PTCPAS_VERSION = 'PTCPas 0.99.7';
-{  PTC_WIN32_VERSION = 'OpenPTC Win32 1.0.18';}
 
 Type
   PUint8  = ^Uint8;
@@ -59,31 +67,8 @@ Type
   Sint16 = SmallInt;
   Sint32 = LongInt;
   Sint64 = Int64;
-  {to be deprecated}
-{  Pint32 = ^int32;
-  int32 = Uint32;
-  Pshort16 = ^short16;
-  short16 = Uint16;
-  Pchar8 = ^char8;
-  char8 = Uint8;}
-  {/to be deprecated}
-{$INCLUDE aread.inc}
-{$INCLUDE colord.inc}
-{$INCLUDE formatd.inc}
-{$INCLUDE eventd.inc}
-{$INCLUDE keyd.inc}
-{$INCLUDE moused.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}
+
+{$INCLUDE core/coreinterface.inc}
 
 {$IFNDEF FPDOC}
 
@@ -114,18 +99,32 @@ Uses
   textfx2, vesa, vga, cga, timeunit, crt, go32, mouse33h;
 {$ENDIF GO32V2}
 
-{$IFDEF WIN32}
+{$IFDEF Win32}
 Uses
-  Windows, DirectDraw;
-{$ENDIF WIN32}
+  Windows, p_ddraw;
+{$ENDIF Win32}
+
+{$IFDEF WinCE}
+Uses
+  Windows, p_gx;
+{$ENDIF WinCE}
 
 {$IFDEF UNIX}
 Uses
-  BaseUnix, Unix, ctypes, x, xlib, xutil, xatom, keysym,
-  xf86vmode, xf86dga,
-  {$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-  xshm, ipc;
-  {$ENDIF HAVE_X11_EXTENSIONS_XSHM}
+  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
@@ -153,46 +152,36 @@ Begin
     FreeMem(tmp);
 End;
 
-{$INCLUDE log.inc}
+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 core/log.inc}
 
 {$IFDEF WIN32}
 {$INCLUDE win32/base/cursor.inc}
 {$ENDIF WIN32}
 
-{$INCLUDE errori.inc}
-{$INCLUDE areai.inc}
-{$INCLUDE colori.inc}
-{$INCLUDE formati.inc}
-{$INCLUDE eventi.inc}
-{$INCLUDE keyi.inc}
-{$INCLUDE mousei.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 core/coreimplementation.inc}
 
 {$IFDEF GO32V2}
-{$INCLUDE dos/base/kbdd.inc}
-{$INCLUDE dos/base/moused.inc}
-{$INCLUDE dos/vesa/consoled.inc}
-{$INCLUDE dos/fakemode/consoled.inc}
-{$INCLUDE dos/textfx2/consoled.inc}
-{$INCLUDE dos/cga/consoled.inc}
-
-{$INCLUDE dos/base/kbd.inc}
-{$INCLUDE dos/base/mousei.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}
@@ -203,7 +192,9 @@ End;
 {$INCLUDE win32/directx/libraryd.inc}
 {$INCLUDE win32/directx/displayd.inc}
 {$INCLUDE win32/directx/primaryd.inc}
-{$INCLUDE win32/directx/consoled.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}
@@ -212,32 +203,25 @@ End;
 {$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/modesd.inc}
-{$INCLUDE x11/imaged.inc}
-{$INCLUDE x11/displayd.inc}
-{$INCLUDE x11/windowd.inc}
-{$INCLUDE x11/dgadispd.inc}
-{$INCLUDE x11/consoled.inc}
-
-{$INCLUDE x11/check.inc}
-{$INCLUDE x11/modesi.inc}
-{$INCLUDE x11/imagei.inc}
-{$INCLUDE x11/displayi.inc}
-{$INCLUDE x11/windowi.inc}
-{$INCLUDE x11/dgadispi.inc}
-{$INCLUDE x11/consolei.inc}
+{$INCLUDE x11/includes.inc}
 {$ENDIF UNIX}
 
-{$INCLUDE consolei.inc}
+{$INCLUDE core/consolei.inc}
 
 {$IFDEF ENABLE_C_API}
 {$INCLUDE c_api/except.pp}

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/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/basesurface.inc → packages/extra/ptc/wince/base/wincekeyboardd.inc

@@ -18,14 +18,27 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-{Constructor TPTCBaseSurface.Create;
+Type
+  TWinCEKeyboard = Class(TObject)
+  Private
+    { data }
+    FEventQueue : TEventQueue;
 
-Begin
-End;
-}
-{Destructor TPTCBaseSurface.Destroy;
+    { flag data }
+    m_enabled : Boolean;
 
-Begin
-  Inherited Destroy;
-End;
-}
+    { 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/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

@@ -1,19 +0,0 @@
-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

@@ -1,146 +0,0 @@
-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/svnimaged.inc

@@ -1,42 +0,0 @@
-Type
-  TX11Image = Class(TObject)
-  Protected
-    m_width, m_height : DWord;
-    m_disp : PDisplay;
-    m_image : PXImage;
-  Public
-    Constructor Create(display : PDisplay; screen, width, height : Integer; format : TPTCFormat);
-    Destructor Destroy; Override;
-    Procedure put(w : TWindow; gc : TGC; x, y : Integer); Virtual; Abstract;
-    Procedure put(w : TWindow; gc : TGC; sx, sy, dx, dy,
-                  width, height : Integer); Virtual; Abstract;
-    Function lock : Pointer; Virtual; Abstract;
-    Function pitch : Integer; Virtual; Abstract;
-  End;
-  TX11NormalImage = Class(TX11Image)
-  Private
-    m_pixels : PUint8;
-  Public
-    Constructor Create(display : PDisplay; screen, width, height : Integer; format : TPTCFormat);
-    Destructor Destroy; Override;
-    Procedure put(w : TWindow; gc : TGC; x, y : Integer); Override;
-    Procedure put(w : TWindow; gc : TGC; sx, sy, dx, dy,
-                  width, height : Integer); Override;
-    Function lock : Pointer; Override;
-    Function pitch : Integer; Override;
-  End;
-{$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-  TX11SHMImage = Class(TX11Image)
-  Public
-    Constructor Create(display : PDisplay; screen, width, height : Integer; format : TPTCFormat);
-    Destructor Destroy; Override;
-    Procedure put(w : TWindow; gc : TGC; x, y : Integer); Override;
-    Procedure put(w : TWindow; gc : TGC; sx, sy, dx, dy,
-                  width, height : Integer); Override;
-    Function lock : Pointer; Override;
-    Function pitch : Integer; Override;
-  Private
-    shminfo : TXShmSegmentInfo;
-    FShmAttached : Boolean;
-  End;
-{$ENDIF}

packages/extra/ptc/x11/svnimagei.inc

@@ -1,198 +0,0 @@
-
-{$WARNING this should be in the IPC unit!!!}
-Const
-{  IPC_CREAT = $200;
-  IPC_EXCL = $400;
-  IPC_NOWAIT = $800;}
-
-  IPC_PRIVATE = 0;
-
-Constructor TX11Image.Create(display : PDisplay; screen, width, height : Integer; format : TPTCFormat);
-
-Begin
-  m_width := width;
-  m_height := height;
-  m_disp := display;
-  m_image := Nil;
-End;
-
-Destructor TX11Image.Destroy;
-
-Begin
-  Inherited Destroy;
-End;
-
-Constructor TX11NormalImage.Create(display : PDisplay; screen, width, height : Integer; format : TPTCFormat);
-
-Var
-  xpad, xpitch : Integer;
-  tmp_m_pixels : PChar;
-
-Begin
-  { cerr << "Creating normal image" << endl << flush; }
-  m_image := Nil;
-  m_pixels := Nil;
-  Inherited Create(display, screen, width, height, format);
-  xpad := format.bits;
-  If format.bits = 24 Then
-    xpad := 32;
-  xpitch := width * format.bits Div 8;
-  Inc(xpitch, 3);
-  xpitch := xpitch And (Not 3);
-  m_pixels := GetMem(xpitch * height);
-  Pointer(tmp_m_pixels) := Pointer(m_pixels);
-  m_image := XCreateImage(display, DefaultVisual(display, screen),
-                          DefaultDepth(display, screen),
-			  ZPixmap, 0, tmp_m_pixels,
-			  width, height, xpad, 0);
-  If m_image = Nil Then
-    Raise TPTCError.Create('cannot create XImage');
-End;
-
-Destructor TX11NormalImage.Destroy;
-
-Begin
-  If m_image <> Nil Then
-  Begin
-    { Restore XImage's buffer pointer }
-    m_image^.data := Nil;
-    XDestroyImage(m_image);
-  End;
-  If m_pixels <> Nil Then
-    FreeMem(m_pixels);
-  Inherited Destroy;
-End;
-
-Procedure TX11NormalImage.put(w : TWindow; gc : TGC; x, y : Integer);
-
-Begin
-  XPutImage(m_disp, w, gc, m_image, 0, 0, x, y, m_width, m_height);
-  XSync(m_disp, False);
-End;
-
-Procedure TX11NormalImage.put(w : TWindow; gc : TGC; sx, sy, dx, dy,
-                    width, height : Integer);
-
-Begin
-  XPutImage(m_disp, w, gc, m_image, sx, sy, dx, dy, width, height);
-  XSync(m_disp, False);
-End;
-
-Function TX11NormalImage.lock : Pointer;
-
-Begin
-  lock := m_pixels;
-End;
-
-Function TX11NormalImage.pitch : Integer;
-
-Begin
-  pitch := m_image^.bytes_per_line;
-End;
-
-{$IFDEF HAVE_X11_EXTENSIONS_XSHM}
-
-Var
-  Fshm_error : Boolean;
-  Fshm_oldhandler : Function(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl;
-
-Function Fshm_errorhandler(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl;
-
-Begin
-  If xev^.error_code=BadAccess Then
-  Begin
-    Fshm_error := True;
-    Result := 0;
-  End
-  Else
-    Result := Fshm_oldhandler(disp, xev);
-End;
-
-Constructor TX11SHMImage.Create(display : PDisplay; screen, width, height : Integer; format : TPTCFormat);
-
-Begin
-  { cerr << "Creating SHM image" << endl << flush; }
-  shminfo.shmid := -1;
-  shminfo.shmaddr := Pointer(-1);
-  FShmAttached := False;
-  m_image := Nil;
-  Inherited Create(display, screen, width, height, format);
-  m_image := XShmCreateImage(display, DefaultVisual(display, screen),
-                             DefaultDepth(display, screen),
-			     ZPixmap, Nil, @shminfo, width, height);
-  If m_image = Nil Then
-    Raise TPTCError.Create('cannot create SHM image');
-
-  shminfo.shmid := shmget(IPC_PRIVATE, m_image^.bytes_per_line * m_image^.height,
-                          IPC_CREAT Or &777);
-  If shminfo.shmid = -1 Then
-    Raise TPTCError.Create('cannot get shared memory segment');
-  
-  shminfo.shmaddr := shmat(shminfo.shmid, Nil, 0);
-  shminfo.readOnly := False;
-  m_image^.data := shminfo.shmaddr;
-  
-  If Pointer(shminfo.shmaddr) = Pointer(-1) Then
-    Raise TPTCError.Create('cannot allocate shared memory');
-
-  // Try and attach the segment to the server. Bugfix: Have to catch
-  // bad access errors in case it runs over the net.
-  Fshm_error := False;
-  Fshm_oldhandler := XSetErrorHandler(@Fshm_errorhandler);
-  Try
-    If XShmAttach(display, @shminfo) = 0 Then
-      Raise TPTCError.Create('cannot attach shared memory segment to display');
-
-    XSync(display, False);
-    If Fshm_error Then
-      Raise TPTCError.Create('cannot attach shared memory segment to display');
-    FShmAttached := True;
-  Finally
-    XSetErrorHandler(Fshm_oldhandler);
-  End;
-End;
-
-Destructor TX11SHMImage.Destroy;
-
-Begin
-  If FShmAttached Then
-  Begin
-    XShmDetach(m_disp, @shminfo);
-    XSync(m_disp, False);
-  End;
-  If m_image <> Nil Then
-    XDestroyImage(m_image);
-  If Pointer(shminfo.shmaddr) <> Pointer(-1) Then
-    shmdt(shminfo.shmaddr);
-  If shminfo.shmid <> -1 Then
-    shmctl(shminfo.shmid, IPC_RMID, Nil);
-  Inherited Destroy;
-End;
-
-Procedure TX11SHMImage.put(w : TWindow; gc : TGC; x, y : Integer);
-
-Begin
-  XShmPutImage(m_disp, w, gc, m_image, 0, 0, x, y, m_width, m_height, False);
-  XSync(m_disp, False);
-End;
-
-Procedure TX11SHMImage.put(w : TWindow; gc : TGC; sx, sy, dx, dy,
-                    width, height : Integer);
-
-Begin
-  XShmPutImage(m_disp, w, gc, m_image, sx, sy, dx, dy, width, height, False);
-  XSync(m_disp, False);
-End;
-
-Function TX11SHMImage.lock : Pointer;
-
-Begin
-  lock := Pointer(shminfo.shmaddr);
-End;
-
-Function TX11SHMImage.pitch : Integer;
-
-Begin
-  pitch := m_image^.bytes_per_line;
-End;
-{$ENDIF}

packages/extra/ptc/x11/x11consoled.inc

@@ -1,70 +1,82 @@
 Type
   TX11Console = Class(TPTCBaseConsole)
   Private
-    Procedure setTitle(_title : String);
+    FX11Display : TX11Display;
+    FTitle : String;
+    FFlags : TX11Flags;
+    FModes : Array Of TPTCMode;
+
     Procedure UpdateCursor;
-    x11disp : TX11Display;
-    m_title : String;
-    m_flags : TX11Flags;
-    m_modes : Array[0..255] Of TPTCMode;
+
+    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;
+    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; 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;
-    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override;
-    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; 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

@@ -4,21 +4,21 @@ Var
   s : AnsiString;
 
 Begin
-  x11disp := Nil;
-  m_flags := [];
-  FillChar(m_modes, SizeOf(m_modes), 0);
-  m_title := '';
-  
-  m_modes[0] := TPTCMode.Create;
-  
-  configure('/usr/share/ptcpas/ptcpas.conf');
+  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);
+  Configure(s);
 End;
 
 Destructor TX11Console.Destroy;
@@ -27,22 +27,21 @@ Var
   I : Integer;
 
 Begin
-  close;
-  m_title := '';
-  FreeAndNil(x11disp);
-  For I := Low(m_modes) To High(m_modes) Do
-    FreeAndNil(m_modes[I]);
+  Close;
+  FreeAndNil(FX11Display);
+  For I := Low(FModes) To High(FModes) Do
+    FreeAndNil(FModes[I]);
   Inherited Destroy;
 End;
 
-Procedure TX11Console.configure(Const _file : String);
+Procedure TX11Console.Configure(Const AFileName : String);
 
 Var
   F : Text;
   S : String;
 
 Begin
-  ASSignFile(F, _file);
+  AssignFile(F, AFileName);
   {$I-}
   Reset(F);
   {$I+}
@@ -55,421 +54,477 @@ Begin
     {$I+}
     If IOResult <> 0 Then
       Break;
-    option(S);
+    Option(S);
   End;
   CloseFile(F);
 End;
 
-Function TX11Console.option(Const _option : String) : Boolean;
+Function TX11Console.Option(Const AOption : String) : Boolean;
 
 Begin
-  option := True;
-  If _option = 'default output' Then
+  Result := True;
+  If AOption = 'default output' Then
   Begin
     { default is windowed for now }
-    m_flags := m_flags - [PTC_X11_FULLSCREEN];
+    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 _option = 'windowed output' Then
+  If AOption = 'dga' Then
   Begin
-    m_flags := m_flags - [PTC_X11_FULLSCREEN];
+    FFlags := FFlags + [PTC_X11_TRY_DGA];
     Exit;
   End;
-  If _option = 'fullscreen output' Then
+  If AOption = 'dga off' Then
   Begin
-    m_flags := m_flags + [PTC_X11_FULLSCREEN];
+    FFlags := FFlags - [PTC_X11_TRY_DGA];
     Exit;
   End;
-  If _option = 'leave window open' Then
+  If AOption = 'xf86vidmode' Then
   Begin
-    m_flags := m_flags + [PTC_X11_LEAVE_WINDOW];
+    FFlags := FFlags + [PTC_X11_TRY_XF86VIDMODE];
     Exit;
   End;
-  If _option = 'leave display open' Then
+  If AOption = 'xf86vidmode off' Then
   Begin
-    m_flags := m_flags + [PTC_X11_LEAVE_DISPLAY];
+    FFlags := FFlags - [PTC_X11_TRY_XF86VIDMODE];
     Exit;
   End;
-  If _option = 'dga pedantic init' Then
+  If AOption = 'xrandr' Then
   Begin
-    m_flags := m_flags + [PTC_X11_PEDANTIC_DGA, PTC_X11_TRY_DGA];
+    FFlags := FFlags + [PTC_X11_TRY_XRANDR];
     Exit;
   End;
-  If _option = 'dga' Then
+  If AOption = 'xrandr off' Then
   Begin
-    m_flags := m_flags + [PTC_X11_TRY_DGA];
+    FFlags := FFlags - [PTC_X11_TRY_XRANDR];
     Exit;
   End;
-  If _option = 'dga off' Then
+  If AOption = 'xshm' Then
   Begin
-    m_flags := m_flags - [PTC_X11_TRY_DGA];
+    FFlags := FFlags + [PTC_X11_TRY_XSHM];
     Exit;
   End;
-  If _option = 'default cursor' Then
+  If AOption = 'xshm off' Then
   Begin
-    m_flags := m_flags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE, PTC_X11_WINDOWED_CURSOR_INVISIBLE];
+    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 _option = 'show cursor' Then
+  If AOption = 'show cursor' Then
   Begin
-    m_flags := (m_flags - [PTC_X11_WINDOWED_CURSOR_INVISIBLE]) + [PTC_X11_FULLSCREEN_CURSOR_VISIBLE];
+    FFlags := (FFlags - [PTC_X11_WINDOWED_CURSOR_INVISIBLE]) + [PTC_X11_FULLSCREEN_CURSOR_VISIBLE];
     UpdateCursor;
     Exit;
   End;
-  If _option = 'hide cursor' Then
+  If AOption = 'hide cursor' Then
   Begin
-    m_flags := (m_flags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE]) + [PTC_X11_WINDOWED_CURSOR_INVISIBLE];
+    FFlags := (FFlags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE]) + [PTC_X11_WINDOWED_CURSOR_INVISIBLE];
     UpdateCursor;
     Exit;
   End;
-  If x11disp <> Nil Then
-    option := x11disp.m_copy.option(_option)
+  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
-    option := False;
+    Result := False;
 End;
 
-Function TX11Console.modes : PPTCMode;
+Function TX11Console.Modes : PPTCMode;
+
+Var
+  I : Integer;
 
 Begin
-  modes := @m_modes;
+  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 _title : String; _pages : Integer);
+Procedure TX11Console.Open(Const ATitle : String; APages : Integer = 0);
 
 Var
   tmp : TPTCFormat;
 
 Begin
-  setTitle(_title);
   tmp := TPTCFormat.Create(32, $FF0000, $FF00, $FF);
   Try
-    open(_title, tmp, _pages);
+    Open(ATitle, tmp, APages);
   Finally
     tmp.Free;
   End;
 End;
 
-Procedure TX11Console.open(Const _title : String; Const _format : TPTCFormat;
-		           _pages : Integer);
+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
-  setTitle(_title);
-  open(_title, 640, 480, _format, _pages);
+  Open(ATitle, AMode.Width, AMode.Height, AMode.Format, APages);
 End;
 
-Procedure TX11Console.open(Const _title : String; _width, _height : Integer;
-		           Const _format : TPTCFormat; _pages : Integer);
+Function TX11Console.CreateDisplay : TX11Display;
 
 Var
-  disp : PDisplay;
+  display : PDisplay;
   screen : Integer;
 
 Begin
-  close;
-  setTitle(_title);
-  
   { Check if we can open an X display }
-  disp := XOpenDisplay(Nil);
-  If disp = Nil Then
+  display := XOpenDisplay(Nil);
+  If display = Nil Then
     Raise TPTCError.Create('Cannot open X display');
-  
+
   { DefaultScreen should be fine }
-  screen := DefaultScreen(disp);
-  
-  FreeAndNil(x11disp);
-  
-  {ifndef HAVE_DGA}
-  
-  If (PTC_X11_TRY_DGA In m_flags) Then
+  screen := DefaultScreen(display);
+
+  {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2}
+  If PTC_X11_TRY_DGA In FFlags Then
   Begin
     Try
-      x11disp := TX11DGADisplay.Create;
-      x11disp.flags(m_flags + [PTC_X11_LEAVE_DISPLAY]);
-      x11disp.open(_title, _width, _height, _format, disp, screen);
-      x11disp.flags(m_flags);
+      Result := TX11DGA2Display.Create(display, screen, FFlags + [PTC_X11_LEAVE_DISPLAY]);
+      Result.SetFlags(FFlags);
+      Exit;
     Except
-      FreeAndNil(x11disp);
+      LOG('DGA 2.0 failed');
     End;
   End;
-  
-  If x11disp = Nil Then
+  {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2}
+
+  {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1}
+  If PTC_X11_TRY_DGA In FFlags Then
   Begin
-    x11disp := TX11WindowDisplay.Create;
-    x11disp.flags(m_flags);
-    x11disp.open(_title, _width, _height, _format, disp, screen);
+    Try
+      Result := TX11DGA1Display.Create(display, screen, FFlags + [PTC_X11_LEAVE_DISPLAY]);
+      Result.SetFlags(FFlags);
+    Except
+      LOG('DGA 1.0 failed');
+    End;
   End;
-  
-  UpdateCursor;
+  {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1}
+
+  Result := TX11WindowDisplay.Create(display, screen, FFlags);
 End;
 
-Procedure TX11Console.open(Const _title : String; Const _mode : TPTCMode;
-		           _pages : Integer);
+Procedure TX11Console.Open(Const ATitle : String; AWidth, AHeight : Integer;
+                           Const AFormat : TPTCFormat; APages : Integer = 0);
 
 Begin
-  setTitle(_title);
+  Close;
+  FTitle := ATitle;
+
+  If FX11Display = Nil Then
+    FX11Display := CreateDisplay;
+  FX11Display.Open(ATitle, AWidth, AHeight, AFormat);
+
+  UpdateCursor;
 End;
 
-Procedure TX11Console.close;
+Procedure TX11Console.Close;
 
 Begin
-  FreeAndNil(x11disp);
+  FreeAndNil(FX11Display);
 End;
 
-Procedure TX11Console.flush;
+Procedure TX11Console.Flush;
 
 Begin
-  update;
+  Update;
 End;
 
-Procedure TX11Console.finish;
+Procedure TX11Console.Finish;
 
 Begin
-  update;
+  Update;
 End;
 
-Procedure TX11Console.update;
+Procedure TX11Console.Update;
 
 Begin
-  x11disp.update;
+  FX11Display.Update;
 End;
 
-Procedure TX11Console.update(Const _area : TPTCArea);
+Procedure TX11Console.Update(Const AArea : TPTCArea);
 
 Begin
-  x11disp.update(_area);
+  FX11Display.Update(AArea);
 End;
 
-Function TX11Console.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean;
+Function TX11Console.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean;
 
 Begin
-  Result := x11disp.NextEvent(event, wait, EventMask);
+  Result := FX11Display.NextEvent(AEvent, AWait, AEventMask);
 End;
 
-Function TX11Console.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent;
+Function TX11Console.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent;
 
 Begin
-  Result := x11disp.PeekEvent(wait, EventMask);
+  Result := FX11Display.PeekEvent(AWait, AEventMask);
 End;
 
-Procedure TX11Console.copy(Var surface : TPTCBaseSurface);
+Procedure TX11Console.Copy(Var ASurface : TPTCBaseSurface);
 
 Begin
   {todo!...}
 End;
 
-Procedure TX11Console.copy(Var surface : TPTCBaseSurface;
-		           Const source, destination : TPTCArea);
+Procedure TX11Console.Copy(Var ASurface : TPTCBaseSurface;
+                           Const ASource, ADestination : TPTCArea);
 
 Begin
   {todo!...}
 End;
 
-Function TX11Console.lock : Pointer;
+Function TX11Console.Lock : Pointer;
 
 Begin
-  lock := x11disp.lock;
+  Result := FX11Display.Lock;
 End;
 
-Procedure TX11Console.unlock;
+Procedure TX11Console.Unlock;
 
 Begin
-  x11disp.unlock;
+  FX11Display.Unlock;
 End;
 
-Procedure TX11Console.load(Const pixels : Pointer;
-		           _width, _height, _pitch : Integer;
-		           Const _format : TPTCFormat;
-		           Const _palette : TPTCPalette);
+Procedure TX11Console.Load(Const APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette);
 
 Begin
-  x11disp.load(pixels, _width, _height, _pitch, _format, _palette);
+  FX11Display.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette);
 End;
 
-Procedure TX11Console.load(Const pixels : Pointer;
-		           _width, _height, _pitch : Integer;
-		           Const _format : TPTCFormat;
-		           Const _palette : TPTCPalette;
-		           Const source, destination : TPTCArea);
+Procedure TX11Console.Load(Const APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette;
+                           Const ASource, ADestination : TPTCArea);
 
 Begin
-  x11disp.load(pixels, _width, _height, _pitch, _format, _palette, source, destination);
+  FX11Display.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, ASource, ADestination);
 End;
 
-Procedure TX11Console.save(pixels : Pointer;
-		           _width, _height, _pitch : Integer;
-		           Const _format : TPTCFormat;
-		           Const _palette : TPTCPalette);
+Procedure TX11Console.Save(APixels : Pointer;
+                           AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat;
+                           Const APalette : TPTCPalette);
 
 Begin
   {todo!...}
 End;
 
-Procedure TX11Console.save(pixels : Pointer;
-		           _width, _height, _pitch : Integer;
-		           Const _format : TPTCFormat;
-		           Const _palette : TPTCPalette;
-		           Const source, destination : TPTCArea);
+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;
+Procedure TX11Console.Clear;
 
 Var
   tmp : TPTCColor;
 
 Begin
-  If format.direct Then
+  If Format.Direct Then
     tmp := TPTCColor.Create(0, 0, 0, 0)
   Else
     tmp := TPTCColor.Create(0);
   Try
-    clear(tmp);
+    Clear(tmp);
   Finally
     tmp.Free;
   End;
 End;
 
-Procedure TX11Console.clear(Const color : TPTCColor);
+Procedure TX11Console.Clear(Const AColor : TPTCColor);
 
 Begin
-  x11disp.clear(color);
+  FX11Display.Clear(AColor);
 End;
 
-Procedure TX11Console.clear(Const color : TPTCColor;
-		            Const _area : TPTCArea);
+Procedure TX11Console.Clear(Const AColor : TPTCColor;
+                            Const AArea : TPTCArea);
 
 Begin
-  x11disp.clear(color, _area);
+  FX11Display.Clear(AColor, AArea);
 End;
 
-Procedure TX11Console.palette(Const _palette : TPTCPalette);
+Procedure TX11Console.Palette(Const APalette : TPTCPalette);
 
 Begin
-  x11disp.palette(_palette);
+  FX11Display.Palette(APalette);
 End;
 
-Function TX11Console.palette : TPTCPalette;
+Function TX11Console.Palette : TPTCPalette;
 
 Begin
-  palette := x11disp.palette;
+  Result := FX11Display.Palette;
 End;
 
-Procedure TX11Console.clip(Const _area : TPTCArea);
+Procedure TX11Console.Clip(Const AArea : TPTCArea);
 
 Begin
-  x11disp.clip(_area);
+  FX11Display.Clip(AArea);
 End;
 
-Function TX11Console.width : Integer;
+Function TX11Console.GetWidth : Integer;
 
 Begin
-  width := x11disp.width;
+  Result := FX11Display.Width;
 End;
 
-Function TX11Console.height : Integer;
+Function TX11Console.GetHeight : Integer;
 
 Begin
-  height := x11disp.height;
+  Result := FX11Display.Height;
 End;
 
-Function TX11Console.pitch : Integer;
+Function TX11Console.GetPitch : Integer;
 
 Begin
-  pitch := x11disp.pitch;
+  Result := FX11Display.Pitch;
 End;
 
-Function TX11Console.pages : Integer;
+Function TX11Console.GetPages : Integer;
 
 Begin
-  pages := 1;
+  Result := 2;
 End;
 
-Function TX11Console.area : TPTCArea;
+Function TX11Console.GetArea : TPTCArea;
 
 Begin
-  area := x11disp.area;
+  Result := FX11Display.Area;
 End;
 
-Function TX11Console.clip : TPTCArea;
+Function TX11Console.Clip : TPTCArea;
 
 Begin
-  clip := x11disp.clip;
+  Result := FX11Display.Clip;
 End;
 
-Function TX11Console.format : TPTCFormat;
+Function TX11Console.GetFormat : TPTCFormat;
 
 Begin
-  format := x11disp.format;
+  Result := FX11Display.Format;
 End;
 
-Function TX11Console.name : String;
+Function TX11Console.GetName : String;
 
 Begin
-  name := 'X11';
+  Result := 'X11';
 End;
 
-Function TX11Console.title : String;
+Function TX11Console.GetTitle : String;
 
 Begin
-  title := m_title;
+  Result := FTitle;
 End;
 
-Function TX11Console.information : String;
-
-Var
-  s : String;
+Function TX11Console.GetInformation : String;
 
 Begin
-  If x11disp = Nil Then
+  If FX11Display = Nil Then
     Exit('PTC X11');
-  information := 'PTC X11, ';
-  If x11disp.isFullScreen Then
-    information := information + 'fullscreen '
+  Result := 'PTC X11, ';
+  If FX11Display.IsFullScreen Then
+    Result := Result + 'fullscreen '
   Else
-    information := information + 'windowed ';
-  If x11disp Is TX11WindowDisplay Then
+    Result := Result + 'windowed ';
+
+  { TODO: use virtual methods, instead of "is" }
+  If FX11Display 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 + '(MIT-Shm) '
-      Else
-    {$ENDIF HAVE_X11_EXTENSIONS_XSHM}
-        information := information + '(XImage) ';
-    End
+    If TX11WindowDisplay(FX11Display).FPrimary <> Nil Then
+      Result := Result + '(' + TX11WindowDisplay(FX11Display).FPrimary.Name + ') '
     Else
-      information := information + '';
+      Result := Result + '';
   End
   Else
-    information := information + '(DGA) ';
-  information := information + 'mode, ';
-  Str(x11disp.width, s);
-  information := information + s + 'x';
-  Str(x11disp.height, s);
-  information := information + s + ', ';
-  Str(x11disp.format.bits, s);
-  information := information + s + ' bit';
+  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(x11disp) Then
+  If Assigned(FX11Display) Then
   Begin
-    If x11disp.isFullScreen Then
-      x11disp.SetCursor(PTC_X11_FULLSCREEN_CURSOR_VISIBLE In m_flags)
+    If FX11Display.IsFullScreen Then
+      FX11Display.SetCursor(PTC_X11_FULLSCREEN_CURSOR_VISIBLE In FFlags)
     Else
-      x11disp.SetCursor(Not (PTC_X11_WINDOWED_CURSOR_INVISIBLE In m_flags));
+      FX11Display.SetCursor(Not (PTC_X11_WINDOWED_CURSOR_INVISIBLE In FFlags));
   End;
 End;
-
-Procedure TX11Console.setTitle(_title : String);
-
-Begin
-  m_title := _title;
-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/x11displayd.inc

@@ -2,8 +2,10 @@ Type
   TX11FlagsEnum = (PTC_X11_FULLSCREEN,
                    PTC_X11_LEAVE_DISPLAY,
                    PTC_X11_LEAVE_WINDOW,
-		   PTC_X11_TRY_DGA,
-                   PTC_X11_PEDANTIC_DGA,
+                   PTC_X11_TRY_DGA,
+                   PTC_X11_TRY_XF86VIDMODE,
+                   PTC_X11_TRY_XRANDR,
+                   PTC_X11_TRY_XSHM,
                    PTC_X11_DITHER,
                    PTC_X11_FULLSCREEN_CURSOR_VISIBLE,
                    PTC_X11_WINDOWED_CURSOR_INVISIBLE);
@@ -12,108 +14,116 @@ Type
 Type
   TX11Display = Class(TObject)
   Protected
-    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Virtual; Abstract;
-    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract;
-    
-    Function getFormat(Const _format : TPTCFormat) : TPTCFormat;
-    
+    Function NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Virtual; Abstract;
+    Function PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Virtual; Abstract;
+
+    Function GetX11Format(Const AFormat : TPTCFormat) : TPTCFormat;
+
     { initialise the keyboard mapping table }
-    Procedure setKeyMapping;
-    
+    Procedure SetKeyMapping;
+
+    { Data access }
+    Function GetWidth : Integer;
+    Function GetHeight : Integer;
+    Function GetPitch : Integer; Virtual; Abstract;
+    Function GetFormat : TPTCFormat;
+    Function GetArea : TPTCArea;
+
     { Conversion object }
-    m_copy : TPTCCopy;
-    m_clear : TPTCClear;
-    m_palette : TPTCPalette;
-    
-    m_area : TPTCArea;
-    m_clip : TPTCArea;
-    
+    FCopy : TPTCCopy;
+    FClear : TPTCClear;
+    FPalette : TPTCPalette;
+
+    FArea : TPTCArea;
+    FClip : TPTCArea;
+
     FEventQueue : TEventQueue;
-    
-    m_flags : TX11Flags;
-    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;
-    
+
+    FFlags : TX11Flags;
+    FWidth, FHeight : DWord;
+    FFormat : TPTCFormat;
+
+    FDisplay : PDisplay;
+    FScreen : Integer;
+
+    FCMap : TColormap;
+    FColours : PXColor;
+
+    FFunctionKeys : PInteger;
+    FNormalKeys : PInteger;
+
     {m_thread : pthread_t;}
   Public
-    Constructor Create;
+    Constructor Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Virtual;
     Destructor Destroy; Override;
-    
-    {checkDGA}
-    
-    Procedure open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer); Virtual; Abstract;
-    
+
+    Procedure Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); 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;
-    
+    Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat); Virtual; Abstract;
+    Procedure Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); Virtual; Abstract;
+
+    Procedure Close; Virtual; Abstract;
+
+    Procedure Update; Virtual; Abstract;
+    Procedure Update(Const AArea : 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;
-    
+    Procedure Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat; Const APalette : TPTCPalette); Virtual;
+    Procedure Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat; Const APalette : TPTCPalette;
+                   Const ASource, ADestination : 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;
-    
+    Procedure Save(APixels : Pointer; AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat; Const APalette : TPTCPalette); Virtual;
+    Procedure Save(APixels : Pointer; AWidth, AHeight, APitch : Integer;
+                   Const AFormat : TPTCFormat; Const APalette : TPTCPalette;
+                   Const ASource, ADestination : TPTCArea); Virtual;
+
     { clear surface }
-    Procedure clear(Const color : TPTCColor); Virtual;
-    Procedure clear(Const color : TPTCColor; Const _area : TPTCArea); Virtual;
-    
+    Procedure Clear(Const AColor : TPTCColor); Virtual;
+    Procedure Clear(Const AColor : TPTCColor; Const AArea : TPTCArea); Virtual;
+
     { Console palette }
-    Procedure palette(Const _palette : TPTCPalette); Virtual; Abstract;
-    Function palette : TPTCPalette; Virtual;
+    Procedure Palette(Const APalette : TPTCPalette); Virtual; Abstract;
+    Function Palette : TPTCPalette; Virtual;
 
     { console clip area }
-    Procedure clip(Const _area : TPTCArea);
-    
+    Procedure Clip(Const AArea : TPTCArea);
+
     { cursor control }
-    Procedure SetCursor(visible : Boolean); Virtual; Abstract;
-    
+    Procedure SetCursor(AVisible : Boolean); Virtual; Abstract;
+
     { Data access }
-    Function width : Integer;
-    Function height : Integer;
-    Function pitch : Integer; Virtual; Abstract;
-    Function clip : TPTCArea;
-    Function area : TPTCArea;
-    Function format : TPTCFormat;
-    
-    Function isFullScreen : Boolean; Virtual; Abstract;
-    
+    Function Clip : TPTCArea;
+
+    Function IsFullScreen : Boolean; Virtual; Abstract;
+
     { Set flags (only used internally now!) }
-    Procedure flags(_flags : TX11Flags);
-    
+    Procedure SetFlags(AFlags : TX11Flags);
+
+    Procedure GetModes(Var AModes : TPTCModeDynArray); Virtual; Abstract;
+
     { X11 helper functions for your enjoyment }
-    
+
     { return the display we are using }
-    Function getX11Display : PDisplay;
-    
+    Function GetX11Display : PDisplay;
+
     { return the screen we are using }
-    Function getX11Screen : Integer;
-    
+    Function GetX11Screen : Integer;
+
     { return our window (0 if DGA) }
-    Function getX11Window : TWindow; Virtual; Abstract;
+    Function GetX11Window : TWindow; 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/x11/x11displayi.inc

@@ -1,231 +1,213 @@
 {$INCLUDE xunikey.inc}
 
-Constructor TX11Display.Create;
+Constructor TX11Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags);
 
 Begin
-  m_disp := Nil;
-  m_colours := Nil;
-  m_cmap := 0;
-  m_flags := [];
-  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;
-  FEventQueue := 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;
+  FFlags := AFlags;
+
+  FDisplay := ADisplay;
+  FScreen := AScreen;
+
+  FCopy := TPTCCopy.Create;
+  FClear := TPTCClear.Create;
+  FPalette := TPTCPalette.Create;
+  FClip := TPTCArea.Create;
+  FArea := TPTCArea.Create;
+  FFormat := TPTCFormat.Create;
   FEventQueue := TEventQueue.Create;
-  
-  setKeyMapping;
+
+  SetKeyMapping;
 End;
 
 Destructor TX11Display.Destroy;
 
 Begin
   { Just close the display, everything else is done by the subclasses }
-  If (m_disp <> Nil) And (Not (PTC_X11_LEAVE_DISPLAY In m_flags)) Then
+  If (FDisplay <> Nil) And (Not (PTC_X11_LEAVE_DISPLAY In FFlags)) Then
   Begin
-    XFlush(m_disp);
-    XCloseDisplay(m_disp);
-    m_disp := Nil;
+    XFlush(FDisplay);
+    XCloseDisplay(FDisplay);
+    FDisplay := Nil;
   End;
-  FreeMemAndNil(m_normalkeys);
-  FreeMemAndNil(m_functionkeys);
-  
-  m_copy.Free;
-  m_clear.Free;
-  m_palette.Free;
-  m_clip.Free;
-  m_area.Free;
-  m_format.Free;
+  FreeMemAndNil(FNormalKeys);
+  FreeMemAndNil(FFunctionKeys);
+
+  FCopy.Free;
+  FClear.Free;
+  FPalette.Free;
+  FClip.Free;
+  FArea.Free;
+  FFormat.Free;
   FEventQueue.Free;
-  
+
   Inherited Destroy;
 End;
 
-Procedure TX11Display.load(Const pixels : Pointer; _width, _height, _pitch : Integer;
-                           Const _format : TPTCFormat; Const _palette : TPTCPalette);
+Procedure TX11Display.Load(Const APixels : Pointer; AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat; Const APalette : TPTCPalette);
 Var
   Area_ : TPTCArea;
   console_pixels : Pointer;
 
 Begin
-  If clip.Equals(area) Then
+  If Clip.Equals(Area) Then
   Begin
-    console_pixels := lock;
     Try
+      console_pixels := Lock;
       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;
+        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;
-    Finally
-      unlock;
+    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(pixels, _width, _height, _pitch, _format, _palette, Area_, area);
+      Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, 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);
+Procedure TX11Display.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
+  clipped_source := Nil;
   clipped_destination := Nil;
-  clipped_source := TPTCArea.Create;
   Try
-    clipped_destination := TPTCArea.Create;
-    console_pixels := lock;
+    console_pixels := Lock;
     Try
+      clipped_source := TPTCArea.Create;
+      clipped_destination := TPTCArea.Create;
+      tmp := TPTCArea.Create(0, 0, AWidth, AHeight);
       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;
+        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;
+      Unlock;
+      clipped_source.Free;
+      clipped_destination.Free;
     End;
-  Finally
-    clipped_source.Free;
-    clipped_destination.Free;
+  Except
+    On error : TPTCError Do
+      Raise TPTCError.Create('failed to load pixels to console area', error);
   End;
 End;
 
-Procedure TX11Display.save(pixels : Pointer; _width, _height, _pitch : Integer;
-                           Const _format : TPTCFormat; Const _palette : TPTCPalette);
+Procedure TX11Display.Save(APixels : Pointer; AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat; Const APalette : TPTCPalette);
 
 Begin
 End;
 
-Procedure TX11Display.save(pixels : Pointer; _width, _height, _pitch : Integer;
-                           Const _format : TPTCFormat; Const _palette : TPTCPalette;
-		           Const source, destination : TPTCArea);
+Procedure TX11Display.Save(APixels : Pointer; AWidth, AHeight, APitch : Integer;
+                           Const AFormat : TPTCFormat; Const APalette : TPTCPalette;
+                           Const ASource, ADestination : TPTCArea);
 
 Begin
 End;
 
-Procedure TX11Display.clear(Const color : TPTCColor);
+Procedure TX11Display.Clear(Const AColor : TPTCColor);
 
 Begin
 End;
 
-Procedure TX11Display.clear(Const color : TPTCColor; Const _area : TPTCArea);
+Procedure TX11Display.Clear(Const AColor : TPTCColor; Const AArea : TPTCArea);
 
 Begin
 End;
 
-Function TX11Display.palette : TPTCPalette;
+Function TX11Display.Palette : TPTCPalette;
 
 Begin
-  {...}
-  palette := m_palette;
+  Result := FPalette;
 End;
 
-Procedure TX11Display.clip(Const _area : TPTCArea);
+Procedure TX11Display.Clip(Const AArea : TPTCArea);
 
 Begin
-  m_clip.ASSign(_area);
+  FClip.Assign(AArea);
 End;
 
-Function TX11Display.width : Integer;
+Function TX11Display.GetWidth : Integer;
 
 Begin
-  width := m_width;
+  Result := FWidth;
 End;
 
-Function TX11Display.height : Integer;
+Function TX11Display.GetHeight : Integer;
 
 Begin
-  height := m_height;
+  Result := FHeight;
 End;
 
-Function TX11Display.clip : TPTCArea;
+Function TX11Display.Clip : TPTCArea;
 
 Begin
-  clip := m_clip;
+  Result := FClip;
 End;
 
-Function TX11Display.area : TPTCArea;
+Function TX11Display.GetArea : TPTCArea;
 
 Var
   tmp : TPTCArea;
 
 Begin
-  tmp := TPTCArea.Create(0, 0, m_width, m_height);
+  tmp := TPTCArea.Create(0, 0, FWidth, FHeight);
   Try
-    m_area.ASSign(tmp);
+    FArea.Assign(tmp);
   Finally
     tmp.Free;
   End;
-  area := m_area;
+  Result := FArea;
 End;
 
-Function TX11Display.format : TPTCFormat;
+Function TX11Display.GetFormat : TPTCFormat;
 
 Begin
-  format := m_format;
+  Result := FFormat;
 End;
 
-Procedure TX11Display.flags(_flags : TX11Flags);
+Procedure TX11Display.SetFlags(AFlags : TX11Flags);
 
 Begin
-  m_flags := _flags;
+  FFlags := AFlags;
 End;
 
-Function TX11Display.getX11Display : PDisplay;
+Function TX11Display.GetX11Display : PDisplay;
 
 Begin
-  getX11Display := m_disp;
+  Result := FDisplay;
 End;
 
-Function TX11Display.getX11Screen : Integer;
+Function TX11Display.GetX11Screen : Integer;
 
 Begin
-  getX11Screen := m_screen;
+  Result := FScreen;
 End;
 
-Function TX11Display.getFormat(Const _format : TPTCFormat) : TPTCFormat;
+Function TX11Display.GetX11Format(Const AFormat : TPTCFormat) : TPTCFormat;
 
 Var
   tmp_depth : Integer;
@@ -234,160 +216,161 @@ Var
   pfv : PXPixmapFormatValues;
 
 Begin
-  getFormat := Nil;
-  
+  Result := 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);
+  tmp_depth := DisplayPlanes(FDisplay, FScreen);
+
+  pfv := XListPixmapFormats(FDisplay, @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;
+        Break;
       End;
     End;
   Finally
     XFree(pfv);
   End;
-  
-  If (tmp_depth = 8) And _format.indexed Then
-    getFormat := TPTCFormat.Create(8)
+
+  If (tmp_depth = 8) And AFormat.Indexed Then
+    Result := TPTCFormat.Create(8)
   Else
-    If (tmp_depth = 8) And _format.direct Then
-      getFormat := TPTCFormat.Create(8, $E0, $1C, $03)
+    If (tmp_depth = 8) And AFormat.Direct Then
+      Result := 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);
+      Result := TPTCFormat.Create(tmp_depth,
+                                 DefaultVisual(FDisplay, FScreen)^.red_mask,
+                                 DefaultVisual(FDisplay, FScreen)^.green_mask,
+                                 DefaultVisual(FDisplay, FScreen)^.blue_mask);
 End;
 
-Procedure TX11Display.setKeyMapping;
+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));
-  
+  FreeMemAndNil(FFunctionKeys);
+  FreeMemAndNil(FNormalKeys);
+  FFunctionKeys := GetMem(256 * SizeOf(Integer));
+  FNormalKeys := GetMem(256 * SizeOf(Integer));
+
   For _I := 0 To 255 Do
   Begin
-    m_functionkeys[_I] := Integer(PTCKEY_UNDEFINED);
-    m_normalkeys[_I] := Integer(PTCKEY_UNDEFINED);
+    FFunctionKeys[_I] := Integer(PTCKEY_UNDEFINED);
+    FNormalKeys[_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);
+  FFunctionKeys[$FF And XK_BackSpace] := Integer(PTCKEY_BACKSPACE);
+  FFunctionKeys[$FF And XK_Tab] := Integer(PTCKEY_TAB);
+  FFunctionKeys[$FF And XK_Clear] := Integer(PTCKEY_CLEAR);
+  FFunctionKeys[$FF And XK_Return] := Integer(PTCKEY_ENTER);
+  FFunctionKeys[$FF And XK_Pause] := Integer(PTCKEY_PAUSE);
+  FFunctionKeys[$FF And XK_Scroll_Lock] := Integer(PTCKEY_SCROLLLOCK);
+  FFunctionKeys[$FF And XK_Escape] := Integer(PTCKEY_ESCAPE);
+  FFunctionKeys[$FF And XK_Delete] := Integer(PTCKEY_DELETE);
+
+  FFunctionKeys[$FF And XK_Kanji] := Integer(PTCKEY_KANJI);
+
+  FFunctionKeys[$FF And XK_Home] := Integer(PTCKEY_HOME);
+  FFunctionKeys[$FF And XK_Left] := Integer(PTCKEY_LEFT);
+  FFunctionKeys[$FF And XK_Up] := Integer(PTCKEY_UP);
+  FFunctionKeys[$FF And XK_Right] := Integer(PTCKEY_RIGHT);
+  FFunctionKeys[$FF And XK_Down] := Integer(PTCKEY_DOWN);
+  FFunctionKeys[$FF And XK_Page_Up] := Integer(PTCKEY_PAGEUP);
+  FFunctionKeys[$FF And XK_Page_Down] := Integer(PTCKEY_PAGEDOWN);
+  FFunctionKeys[$FF And XK_End] := Integer(PTCKEY_END);
+
+  FFunctionKeys[$FF And XK_Print] := Integer(PTCKEY_PRINTSCREEN);
+  FFunctionKeys[$FF And XK_Insert] := Integer(PTCKEY_INSERT);
+  FFunctionKeys[$FF And XK_Num_Lock] := Integer(PTCKEY_NUMLOCK);
+
+  FFunctionKeys[$FF And XK_KP_0] := Integer(PTCKEY_NUMPAD0);
+  FFunctionKeys[$FF And XK_KP_1] := Integer(PTCKEY_NUMPAD1);
+  FFunctionKeys[$FF And XK_KP_2] := Integer(PTCKEY_NUMPAD2);
+  FFunctionKeys[$FF And XK_KP_3] := Integer(PTCKEY_NUMPAD3);
+  FFunctionKeys[$FF And XK_KP_4] := Integer(PTCKEY_NUMPAD4);
+  FFunctionKeys[$FF And XK_KP_5] := Integer(PTCKEY_NUMPAD5);
+  FFunctionKeys[$FF And XK_KP_6] := Integer(PTCKEY_NUMPAD6);
+  FFunctionKeys[$FF And XK_KP_7] := Integer(PTCKEY_NUMPAD7);
+  FFunctionKeys[$FF And XK_KP_8] := Integer(PTCKEY_NUMPAD8);
+  FFunctionKeys[$FF And XK_KP_9] := Integer(PTCKEY_NUMPAD9);
+
+  FFunctionKeys[$FF And XK_F1] := Integer(PTCKEY_F1);
+  FFunctionKeys[$FF And XK_F2] := Integer(PTCKEY_F2);
+  FFunctionKeys[$FF And XK_F3] := Integer(PTCKEY_F3);
+  FFunctionKeys[$FF And XK_F4] := Integer(PTCKEY_F4);
+  FFunctionKeys[$FF And XK_F5] := Integer(PTCKEY_F5);
+  FFunctionKeys[$FF And XK_F6] := Integer(PTCKEY_F6);
+  FFunctionKeys[$FF And XK_F7] := Integer(PTCKEY_F7);
+  FFunctionKeys[$FF And XK_F8] := Integer(PTCKEY_F8);
+  FFunctionKeys[$FF And XK_F9] := Integer(PTCKEY_F9);
+  FFunctionKeys[$FF And XK_F10] := Integer(PTCKEY_F10);
+  FFunctionKeys[$FF And XK_F11] := Integer(PTCKEY_F11);
+  FFunctionKeys[$FF And XK_F12] := Integer(PTCKEY_F12);
+
+  FFunctionKeys[$FF And XK_Shift_L] := Integer(PTCKEY_SHIFT);
+  FFunctionKeys[$FF And XK_Shift_R] := Integer(PTCKEY_SHIFT);
+  FFunctionKeys[$FF And XK_Control_L] := Integer(PTCKEY_CONTROL);
+  FFunctionKeys[$FF And XK_Control_R] := Integer(PTCKEY_CONTROL);
+  FFunctionKeys[$FF And XK_Caps_Lock] := Integer(PTCKEY_CAPSLOCK);
+  FFunctionKeys[$FF And XK_Meta_L] := Integer(PTCKEY_META);
+  FFunctionKeys[$FF And XK_Meta_R] := Integer(PTCKEY_META);
+  FFunctionKeys[$FF And XK_Alt_L] := Integer(PTCKEY_ALT);
+  FFunctionKeys[$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);
+  FNormalKeys[$FF And XK_space] := Integer(PTCKEY_SPACE);
+  FNormalKeys[$FF And XK_comma] := Integer(PTCKEY_COMMA);
+  FNormalKeys[$FF And XK_minus] := Integer(PTCKEY_SUBTRACT);
+  FNormalKeys[$FF And XK_period] := Integer(PTCKEY_PERIOD);
+  FNormalKeys[$FF And XK_slash] := Integer(PTCKEY_SLASH);
+  FNormalKeys[$FF And XK_0] := Integer(PTCKEY_ZERO);
+  FNormalKeys[$FF And XK_1] := Integer(PTCKEY_ONE);
+  FNormalKeys[$FF And XK_2] := Integer(PTCKEY_TWO);
+  FNormalKeys[$FF And XK_3] := Integer(PTCKEY_THREE);
+  FNormalKeys[$FF And XK_4] := Integer(PTCKEY_FOUR);
+  FNormalKeys[$FF And XK_5] := Integer(PTCKEY_FIVE);
+  FNormalKeys[$FF And XK_6] := Integer(PTCKEY_SIX);
+  FNormalKeys[$FF And XK_7] := Integer(PTCKEY_SEVEN);
+  FNormalKeys[$FF And XK_8] := Integer(PTCKEY_EIGHT);
+  FNormalKeys[$FF And XK_9] := Integer(PTCKEY_NINE);
+  FNormalKeys[$FF And XK_semicolon] := Integer(PTCKEY_SEMICOLON);
+  FNormalKeys[$FF And XK_equal] := Integer(PTCKEY_EQUALS);
+
+  FNormalKeys[$FF And XK_bracketleft] := Integer(PTCKEY_OPENBRACKET);
+  FNormalKeys[$FF And XK_backslash] := Integer(PTCKEY_BACKSLASH);
+  FNormalKeys[$FF And XK_bracketright] := Integer(PTCKEY_CLOSEBRACKET);
+
+  FNormalKeys[$FF And XK_a] := Integer(PTCKEY_A);
+  FNormalKeys[$FF And XK_b] := Integer(PTCKEY_B);
+  FNormalKeys[$FF And XK_c] := Integer(PTCKEY_C);
+  FNormalKeys[$FF And XK_d] := Integer(PTCKEY_D);
+  FNormalKeys[$FF And XK_e] := Integer(PTCKEY_E);
+  FNormalKeys[$FF And XK_f] := Integer(PTCKEY_F);
+  FNormalKeys[$FF And XK_g] := Integer(PTCKEY_G);
+  FNormalKeys[$FF And XK_h] := Integer(PTCKEY_H);
+  FNormalKeys[$FF And XK_i] := Integer(PTCKEY_I);
+  FNormalKeys[$FF And XK_j] := Integer(PTCKEY_J);
+  FNormalKeys[$FF And XK_k] := Integer(PTCKEY_K);
+  FNormalKeys[$FF And XK_l] := Integer(PTCKEY_L);
+  FNormalKeys[$FF And XK_m] := Integer(PTCKEY_M);
+  FNormalKeys[$FF And XK_n] := Integer(PTCKEY_N);
+  FNormalKeys[$FF And XK_o] := Integer(PTCKEY_O);
+  FNormalKeys[$FF And XK_p] := Integer(PTCKEY_P);
+  FNormalKeys[$FF And XK_q] := Integer(PTCKEY_Q);
+  FNormalKeys[$FF And XK_r] := Integer(PTCKEY_R);
+  FNormalKeys[$FF And XK_s] := Integer(PTCKEY_S);
+  FNormalKeys[$FF And XK_t] := Integer(PTCKEY_T);
+  FNormalKeys[$FF And XK_u] := Integer(PTCKEY_U);
+  FNormalKeys[$FF And XK_v] := Integer(PTCKEY_V);
+  FNormalKeys[$FF And XK_w] := Integer(PTCKEY_W);
+  FNormalKeys[$FF And XK_x] := Integer(PTCKEY_X);
+  FNormalKeys[$FF And XK_y] := Integer(PTCKEY_Y);
+  FNormalKeys[$FF And XK_z] := Integer(PTCKEY_Z);
 End;

packages/extra/ptc/x11/x11imaged.inc

@@ -0,0 +1,46 @@
+Type
+  TX11Image = Class(TObject)
+  Protected
+    FWidth, FHeight : Integer;
+    FDisplay : PDisplay;
+    FImage : PXImage;
+  Public
+    Constructor Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); Virtual;
+    Procedure Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); Virtual; Abstract;
+    Procedure Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY,
+                  AWidth, AHeight : Integer); Virtual; Abstract;
+    Function Lock : Pointer; Virtual; Abstract;
+    Function Pitch : Integer; Virtual; Abstract;
+    Function Name : String; Virtual; Abstract;
+  End;
+
+  TX11NormalImage = Class(TX11Image)
+  Private
+    FPixels : PUint8;
+  Public
+    Constructor Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); Override;
+    Destructor Destroy; Override;
+    Procedure Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); Override;
+    Procedure Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY,
+                  AWidth, AHeight : Integer); Override;
+    Function Lock : Pointer; Override;
+    Function Pitch : Integer; Override;
+    Function Name : String; Override;
+  End;
+
+{$IFDEF ENABLE_X11_EXTENSION_XSHM}
+  TX11ShmImage = Class(TX11Image)
+  Private
+    FShmInfo : TXShmSegmentInfo;
+    FShmAttached : Boolean;
+  Public
+    Constructor Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat); Override;
+    Destructor Destroy; Override;
+    Procedure Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer); Override;
+    Procedure Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY,
+                  AWidth, AHeight : Integer); Override;
+    Function Lock : Pointer; Override;
+    Function Pitch : Integer; Override;
+    Function Name : String; Override;
+  End;
+{$ENDIF ENABLE_X11_EXTENSION_XSHM}

packages/extra/ptc/x11/x11imagei.inc

@@ -0,0 +1,197 @@
+Const
+{$WARNING this belongs to the ipc unit}
+  IPC_PRIVATE = 0;
+
+Constructor TX11Image.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat);
+
+Begin
+  FWidth := AWidth;
+  FHeight := AHeight;
+  FDisplay := ADisplay;
+End;
+
+Constructor TX11NormalImage.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat);
+
+Var
+  xpad, xpitch : Integer;
+  tmp_FPixels : PChar;
+
+Begin
+  Inherited;
+
+  xpad := AFormat.Bits;
+  If AFormat.Bits = 24 Then
+    xpad := 32;
+  xpitch := AWidth * AFormat.Bits Div 8;
+  Inc(xpitch, 3);
+  xpitch := xpitch And (Not 3);
+  FPixels := GetMem(xpitch * AHeight);
+  Pointer(tmp_FPixels) := Pointer(FPixels);
+  FImage := XCreateImage(ADisplay, DefaultVisual(ADisplay, AScreen),
+                         DefaultDepth(ADisplay, AScreen),
+                         ZPixmap, 0, tmp_FPixels,
+                         AWidth, AHeight, xpad, 0);
+  If FImage = Nil Then
+    Raise TPTCError.Create('cannot create XImage');
+End;
+
+Destructor TX11NormalImage.Destroy;
+
+Begin
+  If FImage <> Nil Then
+  Begin
+    { Restore XImage's buffer pointer }
+    FImage^.data := Nil;
+    XDestroyImage(FImage);
+  End;
+
+  If FPixels <> Nil Then
+    FreeMem(FPixels);
+
+  Inherited Destroy;
+End;
+
+Procedure TX11NormalImage.Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer);
+
+Begin
+  XPutImage(FDisplay, AWindow, AGC, FImage, 0, 0, AX, AY, FWidth, FHeight);
+  XSync(FDisplay, False);
+End;
+
+Procedure TX11NormalImage.Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY,
+                    AWidth, AHeight : Integer);
+
+Begin
+  XPutImage(FDisplay, AWindow, AGC, FImage, ASX, ASY, ADX, ADY, AWidth, AHeight);
+  XSync(FDisplay, False);
+End;
+
+Function TX11NormalImage.Lock : Pointer;
+
+Begin
+  Result := FPixels;
+End;
+
+Function TX11NormalImage.Pitch : Integer;
+
+Begin
+  Result := FImage^.bytes_per_line;
+End;
+
+Function TX11NormalImage.Name : String;
+
+Begin
+  Result := 'XImage';
+End;
+
+{$IFDEF ENABLE_X11_EXTENSION_XSHM}
+
+Var
+  Fshm_error : Boolean;
+  Fshm_oldhandler : Function(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl;
+
+Function Fshm_errorhandler(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl;
+
+Begin
+  If xev^.error_code=BadAccess Then
+  Begin
+    Fshm_error := True;
+    Result := 0;
+  End
+  Else
+    Result := Fshm_oldhandler(disp, xev);
+End;
+
+Constructor TX11ShmImage.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat);
+
+Begin
+  Inherited;
+
+  FShmInfo.shmid := -1;
+  FShmInfo.shmaddr := Pointer(-1);
+  FImage := XShmCreateImage(ADisplay, DefaultVisual(ADisplay, AScreen),
+                            DefaultDepth(ADisplay, AScreen),
+                            ZPixmap, Nil, @FShmInfo, AWidth, AHeight);
+  If FImage = Nil Then
+    Raise TPTCError.Create('cannot create SHM image');
+
+  FShmInfo.shmid := shmget(IPC_PRIVATE, FImage^.bytes_per_line * FImage^.height,
+                           IPC_CREAT Or &777);
+  If FShmInfo.shmid = -1 Then
+    Raise TPTCError.Create('cannot get shared memory segment');
+
+  FShmInfo.shmaddr := shmat(FShmInfo.shmid, Nil, 0);
+  FShmInfo.readOnly := False;
+  FImage^.data := FShmInfo.shmaddr;
+
+  If Pointer(FShmInfo.shmaddr) = Pointer(-1) Then
+    Raise TPTCError.Create('cannot allocate shared memory');
+
+  // Try and attach the segment to the server. Bugfix: Have to catch
+  // bad access errors in case it runs over the net.
+  Fshm_error := False;
+  Fshm_oldhandler := XSetErrorHandler(@Fshm_errorhandler);
+  Try
+    If XShmAttach(ADisplay, @FShmInfo) = 0 Then
+      Raise TPTCError.Create('cannot attach shared memory segment to display');
+
+    XSync(ADisplay, False);
+    If Fshm_error Then
+      Raise TPTCError.Create('cannot attach shared memory segment to display');
+    FShmAttached := True;
+  Finally
+    XSetErrorHandler(Fshm_oldhandler);
+  End;
+End;
+
+Destructor TX11ShmImage.Destroy;
+
+Begin
+  If FShmAttached Then
+  Begin
+    XShmDetach(FDisplay, @FShmInfo);
+    XSync(FDisplay, False);
+  End;
+  If FImage <> Nil Then
+    XDestroyImage(FImage);
+  If Pointer(FShmInfo.shmaddr) <> Pointer(-1) Then
+    shmdt(FShmInfo.shmaddr);
+  If FShmInfo.shmid <> -1 Then
+    shmctl(FShmInfo.shmid, IPC_RMID, Nil);
+
+  Inherited Destroy;
+End;
+
+Procedure TX11ShmImage.Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer);
+
+Begin
+  XShmPutImage(FDisplay, AWindow, AGC, FImage, 0, 0, AX, AY, FWidth, FHeight, False);
+  XSync(FDisplay, False);
+End;
+
+Procedure TX11ShmImage.Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY,
+                    AWidth, AHeight : Integer);
+
+Begin
+  XShmPutImage(FDisplay, AWindow, AGC, FImage, ASX, ASY, ADX, ADY, FWidth, FHeight, False);
+  XSync(FDisplay, False);
+End;
+
+Function TX11ShmImage.Lock : Pointer;
+
+Begin
+  Result := Pointer(FShmInfo.shmaddr);
+End;
+
+Function TX11ShmImage.Pitch : Integer;
+
+Begin
+  Result := FImage^.bytes_per_line;
+End;
+
+Function TX11ShmImage.Name : String;
+
+Begin
+  Result := 'MIT-Shm';
+End;
+{$ENDIF ENABLE_X11_EXTENSION_XSHM}

packages/extra/ptc/x11/x11modesd.inc

@@ -0,0 +1,69 @@
+Type
+  TX11Modes = Class(TObject)
+  Private
+    FDisplay : PDisplay;
+    FScreen : cint;
+  Protected
+    Function GetWidth : Integer; Virtual; Abstract;
+    Function GetHeight : Integer; Virtual; Abstract;
+  Public
+    Constructor Create(ADisplay : PDisplay; AScreen : cint); Virtual;
+    Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Virtual; Abstract;
+    Procedure SetBestMode(AWidth, AHeight : Integer); Virtual; Abstract;
+    Procedure RestorePreviousMode; Virtual; Abstract;
+    Property Width : Integer Read GetWidth;
+    Property Height : Integer Read GetHeight;
+  End;
+
+  TX11ModesNoModeSwitching = Class(TX11Modes)
+  Private
+    FWidth, FHeight : Integer;
+  Protected
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+  Public
+    Constructor Create(ADisplay : PDisplay; AScreen : cint); Override;
+    Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Override;
+    Procedure SetBestMode(AWidth, AHeight : Integer); Override;
+    Procedure RestorePreviousMode; Override;
+  End;
+
+{$IFDEF ENABLE_X11_EXTENSION_XRANDR}
+  TX11ModesXrandr = Class(TX11Modes)
+  Private
+    FRoot : TWindow;
+    FXRRConfig : PXRRScreenConfiguration;
+  Protected
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+  Public
+    Constructor Create(ADisplay : PDisplay; AScreen : cint); Override;
+    Destructor Destroy; Override;
+    Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Override;
+    Procedure SetBestMode(AWidth, AHeight : Integer); Override;
+    Procedure RestorePreviousMode; Override;
+  End;
+{$ENDIF ENABLE_X11_EXTENSION_XRANDR}
+
+{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE}
+  TX11ModesXF86VidMode = Class(TX11Modes)
+  Private
+    FModeList : PPXF86VidModeModeInfo;
+    FModeListCount : cint;
+    FSavedMode : PXF86VidModeModeLine;
+    FSavedDotClock : cint;
+    FWidth, FHeight : Integer;
+
+    Procedure RetrieveModeList;
+    Function FindNumberOfBestMode(AWidth, AHeight : Integer) : Integer;
+  Protected
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+  Public
+    Constructor Create(ADisplay : PDisplay; AScreen : cint); Override;
+    Destructor Destroy; Override;
+    Procedure GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat); Override;
+    Procedure SetBestMode(AWidth, AHeight : Integer); Override;
+    Procedure RestorePreviousMode; Override;
+  End;
+{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE}

packages/extra/ptc/x11/x11modesi.inc

@@ -0,0 +1,291 @@
+Constructor TX11Modes.Create(ADisplay : PDisplay; AScreen : cint);
+
+Begin
+  FDisplay := ADisplay;
+  FScreen := AScreen;
+End;
+
+Constructor TX11ModesNoModeSwitching.Create(ADisplay : PDisplay; AScreen : cint);
+
+Begin
+  Inherited;
+
+  FWidth := DisplayWidth(FDisplay, FScreen);
+  FHeight := DisplayHeight(FDisplay, FScreen);
+End;
+
+Procedure TX11ModesNoModeSwitching.GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat);
+
+Begin
+  SetLength(AModes, 2);
+  AModes[0] := TPTCMode.Create(FWidth,
+                               FHeight,
+                               ACurrentDesktopFormat);
+  AModes[1] := TPTCMode.Create;
+End;
+
+Procedure TX11ModesNoModeSwitching.SetBestMode(AWidth, AHeight : Integer);
+
+Begin
+  FWidth := DisplayWidth(FDisplay, FScreen);
+  FHeight := DisplayHeight(FDisplay, FScreen);
+End;
+
+Procedure TX11ModesNoModeSwitching.RestorePreviousMode;
+
+Begin
+  { do nothing }
+End;
+
+Function TX11ModesNoModeSwitching.GetWidth : Integer;
+
+Begin
+  Result := FWidth;
+End;
+
+Function TX11ModesNoModeSwitching.GetHeight : Integer;
+
+Begin
+  Result := FHeight;
+End;
+
+{$IFDEF ENABLE_X11_EXTENSION_XRANDR}
+Constructor TX11ModesXrandr.Create(ADisplay : PDisplay; AScreen : cint);
+
+Var
+  dummy1, dummy2 : cint;
+  Major, Minor : cint;
+
+Begin
+  Inherited;
+
+  If Not XRRQueryExtension(FDisplay, @dummy1, @dummy2) Then
+    Raise TPTCError.Create('Xrandr extension not available');
+
+  XRRQueryVersion(FDisplay, @Major, @Minor); // todo: check
+  LOG('Xrandr version: ' + IntToStr(Major) + '.' + IntToStr(Minor));
+
+  FRoot := RootWindow(FDisplay, FScreen);
+
+  FXRRConfig := XRRGetScreenInfo(FDisplay, FRoot);
+  If FXRRConfig = Nil Then
+    Raise TPTCError.Create('XRRGetScreenInfo failed');
+
+  Raise TPTCError.Create('Xrandr mode switcher is not yet implemented...');
+End;
+
+Destructor TX11ModesXrandr.Destroy;
+
+Begin
+  If FXRRConfig <> Nil Then
+    XRRFreeScreenConfigInfo(FXRRConfig);
+
+  Inherited;
+End;
+
+Procedure TX11ModesXrandr.GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat);
+
+Begin
+  {...}
+End;
+
+Procedure TX11ModesXrandr.SetBestMode(AWidth, AHeight : Integer);
+
+Begin
+  {todo...}
+End;
+
+Procedure TX11ModesXrandr.RestorePreviousMode;
+
+Begin
+  {todo...}
+End;
+
+Function TX11ModesXrandr.GetWidth : Integer;
+
+Begin
+  // todo...
+End;
+
+Function TX11ModesXrandr.GetHeight : Integer;
+
+Begin
+  // todo...
+End;
+{$ENDIF ENABLE_X11_EXTENSION_XRANDR}
+
+{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE}
+Constructor TX11ModesXF86VidMode.Create(ADisplay : PDisplay; AScreen : Integer);
+
+Var
+  dummy1, dummy2 : cint;
+
+Begin
+  Inherited;
+
+  FSavedMode := Nil;
+  FSavedDotClock := 0;
+  FModeList := Nil;
+  FModeListCount := 0;
+
+  If Not XF86VidModeQueryExtension(FDisplay, @dummy1, @dummy2) Then
+    Raise TPTCError.Create('VidMode extension not available');
+End;
+
+Destructor TX11ModesXF86VidMode.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;
+
+{todo: move the saving of the previous mode to a separate function...}
+Procedure TX11ModesXF86VidMode.RetrieveModeList;
+
+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;
+
+Procedure TX11ModesXF86VidMode.GetModes(Var AModes : TPTCModeDynArray; ACurrentDesktopFormat : TPTCFormat);
+
+Var
+  I : Integer;
+
+Begin
+  RetrieveModeList;
+
+  SetLength(AModes, FModeListCount + 1);
+  AModes[FModeListCount] := TPTCMode.Create;
+  For I := 0 To FModeListCount - 1 Do
+    AModes[I] := TPTCMode.Create(FModeList[I]^.hdisplay, FModeList[I]^.vdisplay, ACurrentDesktopFormat);
+End;
+
+Function TX11ModesXF86VidMode.FindNumberOfBestMode(AWidth, AHeight : 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 = AWidth) And (FModeList[I]^.vdisplay = AHeight) Then
+      Exit(I);
+
+  { Try to find a mode that matches the width first }
+  For I := 0 To FModeListCount - 1 Do
+    If (FModeList[I]^.hdisplay = AWidth) And (FModeList[I]^.vdisplay >= AHeight) Then
+      Exit(I);
+
+  { Next try to match the height }
+  For I := 0 To FModeListCount - 1 Do
+    If (FModeList[I]^.hdisplay >= AWidth) And (FModeList[I]^.vdisplay = AHeight) 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 >= AWidth) And (FModeList[I]^.vdisplay >= AHeight) Then
+    Begin
+      d_x := Sqr(FModeList[I]^.hdisplay - AWidth);
+      d_y := Sqr(FModeList[I]^.vdisplay - AHeight);
+      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 video mode');
+End;
+
+Procedure TX11ModesXF86VidMode.SetBestMode(AWidth, AHeight : Integer);
+
+Var
+  BestMode : Integer;
+
+Begin
+  RetrieveModeList;
+
+  BestMode := FindNumberOfBestMode(AWidth, AHeight);
+  If Not XF86VidModeSwitchToMode(FDisplay, FScreen, FModeList[BestMode]) Then
+    Raise TPTCError.Create('Error switching to the requested video mode');
+
+  FWidth := FModeList[BestMode]^.hdisplay;
+  FHeight := FModeList[BestMode]^.vdisplay;
+
+  XWarpPointer(FDisplay, None, RootWindow(FDisplay, FScreen), 0, 0, 0, 0,
+               FWidth Div 2,
+               FHeight Div 2);
+
+  If Not XF86VidModeSetViewPort(FDisplay, FScreen, 0, 0) Then
+    Raise TPTCError.Create('Error moving the viewport to the upper-left corner');
+End;
+
+Procedure TX11ModesXF86VidMode.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;
+
+Function TX11ModesXF86VidMode.GetWidth : Integer;
+
+Begin
+  Result := FWidth;
+End;
+
+Function TX11ModesXF86VidMode.GetHeight : Integer;
+
+Begin
+  Result := FHeight;
+End;
+{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE}

packages/extra/ptc/x11/x11windowd.inc

@@ -1,53 +0,0 @@
-Type
-  TX11WindowDisplay = 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 EnterFullScreen;
-    Procedure LeaveFullScreen;
-    Procedure internal_ShowCursor(visible : Boolean);
-    Procedure HandleChangeFocus(NewFocus : Boolean);
-    Procedure HandleEvents;
-    Function createImage(disp : PDisplay; screen, _width, _height : Integer;
-                         _format : TPTCFormat) : TX11Image; { Factory method }
-    Procedure createColormap; { Register colour maps }
-    {eventHandler}
-    m_has_shm : Boolean;
-    m_window : TWindow;
-    m_primary : TX11Image;
-    m_destx, m_desty : Integer;
-    m_gc : TGC;
-    m_atom_close : TAtom; { X Atom for close window button }
-    m_keypressed : Boolean; { Key pressed since the last call to key() ? }
-{    m_keylast : TPTCKeyEvent;} { Last key pressed (scancode) }
-    FCursorVisible : Boolean;
-    FX11InvisibleCursor : TCursor; { Blank cursor }
-    FFullScreen : Boolean; { Keeps a snapshot of the PTC_X11_FULLSCREEN option
-                             taken at the time 'open' was called }
-    FFocus : Boolean;
-    FModeSwitcher : TX11Modes;
-    
-    FPreviousMouseButtonState : TPTCMouseButtonState;
-    FPreviousMouseX, FPreviousMouseY : Integer; { for calculating the deltas }
-    FPreviousMousePositionSaved : Boolean; { true, if FPreviousMouseX,
-           FPreviousMouseY and FPreviousMouseButtonState contain valid values }
-  Public
-    Constructor Create;
-    Destructor Destroy; Override;
-    
-    Procedure open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer); Override;
-    Procedure open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat); Override;
-    Procedure open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); Override;
-    Procedure close; Override;
-    Procedure update; Override;
-    Procedure update(Const _area : TPTCArea); Override;
-    Function lock : Pointer; Override;
-    Procedure unlock; Override;
-    Procedure palette(Const _palette : TPTCPalette); Override;
-    Function pitch : Integer; Override;
-    Function getX11Window : TWindow; Override;
-    Function getX11GC : TGC; Virtual;
-    Function isFullScreen : Boolean; Override;
-    Procedure SetCursor(visible : Boolean); Override;
-  End;

packages/extra/ptc/x11/x11windowdisplayd.inc

@@ -0,0 +1,52 @@
+Type
+  TX11WindowDisplay = 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 EnterFullScreen;
+    Procedure LeaveFullScreen;
+    Procedure internal_ShowCursor(AVisible : Boolean);
+    Procedure HandleChangeFocus(ANewFocus : Boolean);
+    Procedure HandleEvents;
+    Function CreateImage(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer;
+                         AFormat : TPTCFormat) : TX11Image; { Factory method }
+    Function CreateModeSwitcher : TX11Modes; { Factory method }
+    Procedure CreateColormap; { Register colour maps }
+    {eventHandler}
+    FWindow : TWindow;
+    FPrimary : TX11Image;
+    FDestX, FDestY : Integer;
+    FGC : TGC;
+    FAtomClose : TAtom; { X Atom for close window button }
+    FCursorVisible : Boolean;
+    FX11InvisibleCursor : TCursor; { Blank cursor }
+    FFullScreen : Boolean; { Keeps a snapshot of the PTC_X11_FULLSCREEN option
+                             taken at the time 'open' was called }
+    FFocus : Boolean;
+    FModeSwitcher : TX11Modes;
+
+    FPreviousMouseButtonState : TPTCMouseButtonState;
+    FPreviousMouseX, FPreviousMouseY : Integer; { for calculating the deltas }
+    FPreviousMousePositionSaved : Boolean; { true, if FPreviousMouseX,
+           FPreviousMouseY and FPreviousMouseButtonState contain valid values }
+  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 Update; Override;
+    Procedure Update(Const AArea : TPTCArea); Override;
+    Function Lock : Pointer; Override;
+    Procedure Unlock; Override;
+    Procedure GetModes(Var AModes : TPTCModeDynArray); Override;
+    Procedure Palette(Const APalette : TPTCPalette); Override;
+    Function GetPitch : Integer; Override;
+    Function GetX11Window : TWindow; Override;
+    Function GetX11GC : TGC; Virtual;
+    Function IsFullScreen : Boolean; Override;
+    Procedure SetCursor(AVisible : Boolean); Override;
+  End;

packages/extra/ptc/x11/x11windowdisplayi.inc

@@ -0,0 +1,738 @@
+Constructor TX11WindowDisplay.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags);
+
+Begin
+  Inherited;
+  FFocus := True;
+  FX11InvisibleCursor := None;
+  FCursorVisible := True;
+End;
+
+Destructor TX11WindowDisplay.Destroy;
+
+Begin
+  Close;
+  Inherited Destroy;
+End;
+
+Procedure TX11WindowDisplay.Open(ATitle : AnsiString; AWidth, AHeight : Integer; Const AFormat : TPTCFormat);
+
+Var
+  tmpFormat : TPTCFormat;
+  xgcv : TXGCValues;
+  textprop : TXTextProperty;
+  e : TXEvent;
+  found : Boolean;
+  attr : TXSetWindowAttributes;
+  size_hints : PXSizeHints;
+  tmpArea : TPTCArea;
+  tmppchar : PChar;
+  tmpArrayOfCLong : Array[1..1] Of clong;
+  tmpPixmap : TPixmap;
+  BlackColor : TXColor;
+  BlankCursorData : Array[1..8] Of Byte = (0, 0, 0, 0, 0, 0, 0, 0);
+
+Begin
+  FHeight := AHeight;
+  FWidth := AWidth;
+  FDestX := 0;
+  FDestY := 0;
+
+  FFullScreen := PTC_X11_FULLSCREEN In FFlags;
+
+  FFocus := True;
+
+  FPreviousMousePositionSaved := False;
+
+  FillChar(BlackColor, SizeOf(BlackColor), 0);
+  BlackColor.red := 0;
+  BlackColor.green := 0;
+  BlackColor.blue := 0;
+
+  { Create the mode switcher object }
+  If (FModeSwitcher = Nil) And FFullScreen Then
+    FModeSwitcher := CreateModeSwitcher;
+
+  { Create the invisible cursor }
+  tmpPixmap := XCreateBitmapFromData(FDisplay, RootWindow(FDisplay, FScreen), @BlankCursorData, 8, 8);
+  Try
+    FX11InvisibleCursor := XCreatePixmapCursor(FDisplay, tmpPixmap, tmpPixmap, @BlackColor, @BlackColor, 0, 0);
+  Finally
+    If tmpPixmap <> None Then
+      XFreePixmap(FDisplay, tmpPixmap);
+  End;
+
+  { Check if we have that colour depth available.. Easy as there is no
+    format conversion yet }
+  tmpFormat := Nil;
+  Try
+    tmpFormat := GetX11Format(AFormat);
+    FFormat.Assign(tmpFormat);
+  Finally
+    tmpFormat.Free;
+  End;
+  tmpFormat := Nil;
+
+  { Create a window }
+  FWindow := XCreateSimpleWindow(FDisplay, RootWindow(FDisplay, FScreen), 0, 0,
+                AWidth, AHeight, 0, BlackPixel(FDisplay, FScreen),
+                                    BlackPixel(FDisplay, FScreen));
+  { Register the delete atom }
+  FAtomClose := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', False);
+  X11Check(XSetWMProtocols(FDisplay, FWindow, @FAtomClose, 1), 'XSetWMProtocols');
+  { Get graphics context }
+  xgcv.graphics_exposures := False;
+  FGC := XCreateGC(FDisplay, FWindow, GCGraphicsExposures, @xgcv);
+  If FGC = Nil Then
+    Raise TPTCError.Create('can''t create graphics context');
+  { Set window title }
+  tmppchar := PChar(ATitle);
+  X11Check(XStringListToTextProperty(@tmppchar, 1, @textprop), 'XStringListToTextProperty');
+  Try
+    XSetWMName(FDisplay, FWindow, @textprop);
+    XFlush(FDisplay);
+  Finally
+    XFree(textprop.value);
+  End;
+
+  { Set normal hints }
+  size_hints := XAllocSizeHints;
+  Try
+    size_hints^.flags := PMinSize Or PBaseSize;
+    size_hints^.min_width := AWidth;
+    size_hints^.min_height := AHeight;
+    size_hints^.base_width := AWidth;
+    size_hints^.base_height := AHeight;
+    If FFullScreen Then
+    Begin
+      size_hints^.flags := size_hints^.flags Or PWinGravity;
+      size_hints^.win_gravity := StaticGravity;
+    End
+    Else
+    Begin
+      { not fullscreen - add maxsize limit=minsize, i.e. make window not resizable }
+      size_hints^.flags := size_hints^.flags Or PMaxSize;
+      size_hints^.max_width := AWidth;
+      size_hints^.max_height := AHeight;
+    End;
+    XSetWMNormalHints(FDisplay, FWindow, size_hints);
+    XFlush(FDisplay);
+  Finally
+    XFree(size_hints);
+  End;
+
+  { Set the _NET_WM_STATE property }
+  If FFullScreen Then
+  Begin
+    tmpArrayOfCLong[1] := XInternAtom(FDisplay, '_NET_WM_STATE_FULLSCREEN', False);
+
+    XChangeProperty(FDisplay, FWindow,
+                    XInternAtom(FDisplay, '_NET_WM_STATE', False),
+                    XA_ATOM,
+                    32, PropModeReplace, @tmpArrayOfCLong, 1);
+  End;
+
+  { Map the window and wait for success }
+  XSelectInput(FDisplay, FWindow, StructureNotifyMask);
+  XMapRaised(FDisplay, FWindow);
+  Repeat
+    XNextEvent(FDisplay, @e);
+    If e._type = MapNotify Then
+      Break;
+  Until False;
+  { Get keyboard input and sync }
+  XSelectInput(FDisplay, FWindow, KeyPressMask Or KeyReleaseMask Or
+                                  StructureNotifyMask Or FocusChangeMask Or
+                                  ButtonPressMask Or ButtonReleaseMask Or
+                                  PointerMotionMask);
+  XSync(FDisplay, False);
+  { Create XImage using factory method }
+  FPrimary := CreateImage(FDisplay, FScreen, FWidth, FHeight, FFormat);
+
+  found := False;
+  Repeat
+    { Stupid loop. The key }
+    { events were causing }
+    { problems.. }
+    found := XCheckMaskEvent(FDisplay, KeyPressMask Or KeyReleaseMask, @e);
+  Until Not found;
+
+  attr.backing_store := Always;
+  XChangeWindowAttributes(FDisplay, FWindow, CWBackingStore, @attr);
+
+  { Set clipping area }
+  tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight);
+  Try
+    FClip.Assign(tmpArea);
+  Finally
+    tmpArea.Free;
+  End;
+
+  { Installs the right colour map for 8 bit modes }
+  CreateColormap;
+
+  If FFullScreen Then
+    EnterFullScreen;
+End;
+
+Procedure TX11WindowDisplay.Open(AWindow : TWindow; Const AFormat : TPTCFormat);
+
+Begin
+End;
+
+Procedure TX11WindowDisplay.Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer);
+
+Begin
+End;
+
+Procedure TX11WindowDisplay.Close;
+
+Begin
+  FreeAndNil(FModeSwitcher);
+
+  {pthreads?!}
+  If FCMap <> 0 Then
+  Begin
+    XFreeColormap(FDisplay, FCMap);
+    FCMap := 0;
+  End;
+
+  { Destroy XImage and buffer }
+  FreeAndNil(FPrimary);
+  FreeMemAndNil(FColours);
+
+  { Hide and destroy window }
+  If (FWindow <> 0) And (Not (PTC_X11_LEAVE_WINDOW In FFlags)) Then
+  Begin
+    XUnmapWindow(FDisplay, FWindow);
+    XSync(FDisplay, False);
+
+    XDestroyWindow(FDisplay, FWindow);
+  End;
+
+  { Free the invisible cursor }
+  If FX11InvisibleCursor <> None Then
+  Begin
+    XFreeCursor(FDisplay, FX11InvisibleCursor);
+    FX11InvisibleCursor := None;
+  End;
+End;
+
+Procedure TX11WindowDisplay.internal_ShowCursor(AVisible : Boolean);
+
+Var
+  attr : TXSetWindowAttributes;
+
+Begin
+  If AVisible Then
+    attr.cursor := None { Use the normal cursor }
+  Else
+    attr.cursor := FX11InvisibleCursor; { Set the invisible cursor }
+
+  XChangeWindowAttributes(FDisplay, FWindow, CWCursor, @attr);
+End;
+
+Procedure TX11WindowDisplay.SetCursor(AVisible : Boolean);
+
+Begin
+  FCursorVisible := AVisible;
+
+  If FFocus Then
+    internal_ShowCursor(FCursorVisible);
+End;
+
+Procedure TX11WindowDisplay.EnterFullScreen;
+
+Begin
+  { Try to switch mode }
+  If Assigned(FModeSwitcher) Then
+    FModeSwitcher.SetBestMode(FWidth, FHeight);
+
+  XSync(FDisplay, False);
+
+  { Center the image }
+  FDestX := FModeSwitcher.Width Div 2 - FWidth Div 2;
+  FDestY := FModeSwitcher.Height Div 2 - FHeight Div 2;
+End;
+
+Procedure TX11WindowDisplay.LeaveFullScreen;
+
+Begin
+  { Restore previous mode }
+  If Assigned(FModeSwitcher) Then
+    FModeSwitcher.RestorePreviousMode;
+
+  XSync(FDisplay, False);
+End;
+
+Procedure TX11WindowDisplay.HandleChangeFocus(ANewFocus : Boolean);
+
+Begin
+  { No change? }
+  If ANewFocus = FFocus Then
+    Exit;
+
+  FFocus := ANewFocus;
+  If FFocus Then
+  Begin
+    { focus in }
+    If FFullScreen Then
+      EnterFullScreen;
+
+    internal_ShowCursor(FCursorVisible);
+  End
+  Else
+  Begin
+    { focus out }
+    If FFullScreen Then
+      LeaveFullScreen;
+
+    internal_ShowCursor(True);
+  End;
+
+  XSync(FDisplay, False);
+End;
+
+Procedure TX11WindowDisplay.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;
+
+  Procedure HandleMouseEvent;
+
+  Var
+    x, y : cint;
+    state : cuint;
+    PTCMouseButtonState : TPTCMouseButtonState;
+
+    button : TPTCMouseButton;
+    before, after : Boolean;
+    cstate : TPTCMouseButtonState;
+
+  Begin
+    Case e._type Of
+      MotionNotify : Begin
+        x := e.xmotion.x;
+        y := e.xmotion.y;
+        state := e.xmotion.state;
+      End;
+      ButtonPress, ButtonRelease : Begin
+        x := e.xbutton.x;
+        y := e.xbutton.y;
+        state := e.xbutton.state;
+        If e._type = ButtonPress Then
+        Begin
+          Case e.xbutton.button Of
+            Button1 : state := state Or Button1Mask;
+            Button2 : state := state Or Button2Mask;
+            Button3 : state := state Or Button3Mask;
+            Button4 : state := state Or Button4Mask;
+            Button5 : state := state Or Button5Mask;
+          End;
+        End
+        Else
+        Begin
+          Case e.xbutton.button Of
+            Button1 : state := state And (Not Button1Mask);
+            Button2 : state := state And (Not Button2Mask);
+            Button3 : state := state And (Not Button3Mask);
+            Button4 : state := state And (Not Button4Mask);
+            Button5 : state := state And (Not Button5Mask);
+          End;
+        End;
+      End;
+      Else
+        Raise TPTCError.Create('Internal Error');
+    End;
+
+    If (state And Button1Mask) = 0 Then
+      PTCMouseButtonState := []
+    Else
+      PTCMouseButtonState := [PTCMouseButton1];
+    If (state And Button2Mask) <> 0 Then
+      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
+    If (state And Button3Mask) <> 0 Then
+      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
+    If (state And Button4Mask) <> 0 Then
+      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton4];
+    If (state And Button5Mask) <> 0 Then
+      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton5];
+
+    If (x >= 0) And (x < FWidth) And (y >= 0) And (y < FHeight) Then
+    Begin
+      If Not FPreviousMousePositionSaved Then
+      Begin
+        FPreviousMouseX := x; { first DeltaX will be 0 }
+        FPreviousMouseY := y; { first DeltaY will be 0 }
+        FPreviousMouseButtonState := [];
+      End;
+
+      { movement? }
+      If (x <> FPreviousMouseX) Or (y <> FPreviousMouseY) Then
+        FEventQueue.AddEvent(TPTCMouseEvent.Create(x, y, x - FPreviousMouseX, y - 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(x, y, 0, 0, cstate, True, button));
+        End
+        Else
+          If before And (Not after) Then
+          Begin
+            { button was released }
+            cstate := cstate - [button];
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(x, y, 0, 0, cstate, False, button));
+          End;
+      End;
+
+      FPreviousMouseX := x;
+      FPreviousMouseY := y;
+      FPreviousMouseButtonState := PTCMouseButtonState;
+      FPreviousMousePositionSaved := True;
+    End;
+  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]) = FAtomClose) Then
+          Halt(0);
+      End;
+      Expose : Begin
+        {...}
+      End;
+      KeyPress, KeyRelease : HandleKeyEvent;
+      ButtonPress, ButtonRelease, MotionNotify : HandleMouseEvent;
+    End;
+  End;
+  If NewFocusSpecified Then
+    HandleChangeFocus(NewFocus);
+End;
+
+Procedure TX11WindowDisplay.Update;
+
+Begin
+  FPrimary.Put(FWindow, FGC, FDestX, FDestY);
+
+  HandleEvents;
+End;
+
+Procedure TX11WindowDisplay.Update(Const AArea : TPTCArea);
+
+Var
+  updatearea : TPTCArea;
+  tmparea : TPTCArea;
+
+Begin
+  tmparea := TPTCArea.Create(0, 0, FWidth, FHeight);
+  Try
+    updatearea := TPTCClipper.Clip(tmparea, AArea);
+    Try
+      FPrimary.Put(FWindow, FGC, updatearea.Left, updatearea.Top,
+                   FDestX + updatearea.Left, FDestY + updatearea.Top,
+                   updatearea.Width, updatearea.Height);
+    Finally
+      updatearea.Free;
+    End;
+  Finally
+    tmparea.Free;
+  End;
+
+  HandleEvents;
+End;
+
+Function TX11WindowDisplay.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 TX11WindowDisplay.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 TX11WindowDisplay.Lock : Pointer;
+
+Begin
+  Result := FPrimary.Lock;
+End;
+
+Procedure TX11WindowDisplay.unlock;
+
+Begin
+End;
+
+Procedure TX11WindowDisplay.GetModes(Var AModes : TPTCModeDynArray);
+
+Var
+  current_desktop_format, tmpfmt : TPTCFormat;
+
+Begin
+  If FModeSwitcher = Nil Then
+    FModeSwitcher := CreateModeSwitcher;
+
+  current_desktop_format := Nil;
+  tmpfmt := TPTCFormat.Create(8);
+  Try
+    current_desktop_format := GetX11Format(tmpfmt);
+
+    FModeSwitcher.GetModes(AModes, current_desktop_format);
+  Finally
+    tmpfmt.Free;
+    current_desktop_format.Free;
+  End;
+End;
+
+Procedure TX11WindowDisplay.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);
+End;
+
+Function TX11WindowDisplay.GetPitch : Integer;
+
+Begin
+  Result := FPrimary.pitch;
+End;
+
+Function TX11WindowDisplay.CreateImage(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer;
+                                       AFormat : TPTCFormat) : TX11Image;
+
+Begin
+  {$IFDEF ENABLE_X11_EXTENSION_XSHM}
+  If (PTC_X11_TRY_XSHM In FFlags) And XShmQueryExtension(ADisplay) Then
+  Begin
+    Try
+      LOG('trying to create a XShm image');
+      Result := TX11ShmImage.Create(ADisplay, AScreen, AWidth, AHeight, AFormat);
+      Exit;
+    Except
+      LOG('XShm failed');
+    End;
+  End;
+  {$ENDIF ENABLE_X11_EXTENSION_XSHM}
+
+  LOG('trying to create a normal image');
+  Result := TX11NormalImage.Create(ADisplay, AScreen, AWidth, AHeight, AFormat);
+End;
+
+Function TX11WindowDisplay.CreateModeSwitcher : TX11Modes;
+
+Begin
+{$IFDEF ENABLE_X11_EXTENSION_XRANDR}
+  If PTC_X11_TRY_XRANDR In FFlags Then
+    Try
+      LOG('trying to initialize the Xrandr mode switcher');
+      Result := TX11ModesXrandr.Create(FDisplay, FScreen);
+      Exit;
+    Except
+      LOG('Xrandr failed');
+    End;
+{$ENDIF ENABLE_X11_EXTENSION_XRANDR}
+
+{$IFDEF ENABLE_X11_EXTENSION_XF86VIDMODE}
+  If PTC_X11_TRY_XF86VIDMODE In FFlags Then
+    Try
+      LOG('trying to initialize the XF86VidMode mode switcher');
+      Result := TX11ModesXF86VidMode.Create(FDisplay, FScreen);
+      Exit;
+    Except
+      LOG('XF86VidMode failed');
+    End;
+{$ENDIF ENABLE_X11_EXTENSION_XF86VIDMODE}
+
+  LOG('creating the standard NoModeSwitching mode switcher');
+  Result := TX11ModesNoModeSwitching.Create(FDisplay, FScreen);
+End;
+
+Function TX11WindowDisplay.GetX11Window : TWindow;
+
+Begin
+  Result := FWindow;
+End;
+
+Function TX11WindowDisplay.GetX11GC : TGC;
+
+Begin
+  Result := FGC;
+End;
+
+Function TX11WindowDisplay.IsFullScreen : Boolean;
+
+Begin
+  Result := FFullScreen;
+End;
+
+Procedure TX11WindowDisplay.CreateColormap; { Register colour maps }
+
+Var
+  i : Integer;
+  r, g, b : Single;
+
+Begin
+  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');
+    XInstallColormap(FDisplay, FCMap);
+    XSetWindowColormap(FDisplay, FWindow, FCMap);
+  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);
+  End;
+End;

packages/extra/ptc/x11/x11windowi.inc

@@ -1,713 +0,0 @@
-Constructor TX11WindowDisplay.Create;
-
-Begin
-  m_has_shm := False;
-  m_primary := Nil;
-  m_window := 0;
-  m_colours := Nil;
-  m_keypressed := False;
-  FFullScreen := False;
-  FPreviousMousePositionSaved := False;
-  FFocus := True;
-  FModeSwitcher := Nil;
-  FX11InvisibleCursor := None;
-  FCursorVisible := True;
-  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;
-  tmpArrayOfCLong : Array[1..1] Of clong;
-  tmpPixmap : TPixmap;
-  BlackColor : TXColor;
-  BlankCursorData : Array[1..8] Of Byte = (0, 0, 0, 0, 0, 0, 0, 0);
-
-Begin
-  m_disp := disp;
-  m_screen := DefaultScreen(disp);
-  m_height := _height;
-  m_width := _width;
-  m_destx := 0;
-  m_desty := 0;
-  
-  FFullScreen := PTC_X11_FULLSCREEN In m_flags;
-  
-  FFocus := True;
-
-  FPreviousMousePositionSaved := False;
-
-  FillChar(BlackColor, SizeOf(BlackColor), 0);
-  BlackColor.red := 0;
-  BlackColor.green := 0;
-  BlackColor.blue := 0;
-
-  { Create the mode switcher object }
-  If FFullScreen Then
-    Try
-      FModeSwitcher := TX11Modes.Create(m_disp, m_screen);
-    Except
-      On error : TPTCError Do
-      Begin
-        {todo: log the error}
-        FModeSwitcher := Nil;
-      End;
-    End;
-
-  { Create the invisible cursor }
-  tmpPixmap := XCreateBitmapFromData(m_disp, RootWindow(m_disp, m_screen), @BlankCursorData, 8, 8);
-  Try
-    FX11InvisibleCursor := XCreatePixmapCursor(m_disp, tmpPixmap, tmpPixmap, @BlackColor, @BlackColor, 0, 0);
-  Finally
-    If tmpPixmap <> None Then
-      XFreePixmap(m_disp, tmpPixmap);
-  End;
-
-  { 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, RootWindow(m_disp, m_screen), 0, 0,
-                _width, _height, 0, BlackPixel(m_disp, m_screen),
-		                    BlackPixel(m_disp, m_screen));
-  { 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 := PMinSize Or PBaseSize;
-    size_hints^.min_width := _width;
-    size_hints^.min_height := _height;
-    size_hints^.base_width := _width;
-    size_hints^.base_height := _height;
-    If FFullScreen Then
-    Begin
-      size_hints^.flags := size_hints^.flags Or PWinGravity;
-      size_hints^.win_gravity := StaticGravity;
-    End
-    Else
-    Begin
-      { not fullscreen - add maxsize limit=minsize, i.e. make window not resizable }
-      size_hints^.flags := size_hints^.flags Or PMaxSize;
-      size_hints^.max_width := _width;
-      size_hints^.max_height := _height;
-    End;
-    XSetWMNormalHints(m_disp, m_window, size_hints);
-    XFlush(m_disp);
-  Finally
-    XFree(size_hints);
-  End;
-  
-  { Set the _NET_WM_STATE property }
-  If FFullScreen Then
-  Begin
-    tmpArrayOfCLong[1] := XInternAtom(m_disp, '_NET_WM_STATE_FULLSCREEN', False);
-    
-    XChangeProperty(m_disp, m_window, 
-                    XInternAtom(m_disp, '_NET_WM_STATE', False),
-		    XA_ATOM,
-		    32, PropModeReplace, @tmpArrayOfCLong, 1);
-  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 FocusChangeMask 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;
-
-  If FFullScreen Then
-    EnterFullScreen;
-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
-  FreeAndNil(FModeSwitcher);
-
-  {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 (Not (PTC_X11_LEAVE_WINDOW In m_flags)) Then
-  Begin
-    XUnmapWindow(m_disp, m_window);
-    XSync(m_disp, False);
-    
-    XDestroyWindow(m_disp, m_window);
-  End;
-  
-  { Free the invisible cursor }
-  If FX11InvisibleCursor <> None Then
-  Begin
-    XFreeCursor(m_disp, FX11InvisibleCursor);
-    FX11InvisibleCursor := None;
-  End;
-End;
-
-Procedure TX11WindowDisplay.internal_ShowCursor(visible : Boolean);
-
-Var
-  attr : TXSetWindowAttributes;
-
-Begin
-  If visible Then
-    attr.cursor := None { Use the normal cursor }
-  Else
-    attr.cursor := FX11InvisibleCursor; { Set the invisible cursor }
-  
-  XChangeWindowAttributes(m_disp, m_window, CWCursor, @attr);
-End;
-
-Procedure TX11WindowDisplay.SetCursor(visible : Boolean);
-
-Begin
-  FCursorVisible := visible;
-  
-  If FFocus Then
-    internal_ShowCursor(FCursorVisible);
-End;
-
-Procedure TX11WindowDisplay.EnterFullScreen;
-
-Begin
-  { Try to switch mode }
-  If Assigned(FModeSwitcher) Then
-    FModeSwitcher.SetBestMode(m_width, m_height);
-
-  XSync(m_disp, False);
-End;
-
-Procedure TX11WindowDisplay.LeaveFullScreen;
-
-Begin
-  { Restore previous mode }
-  If Assigned(FModeSwitcher) Then
-    FModeSwitcher.RestorePreviousMode;
-
-  XSync(m_disp, False);
-End;
-
-Procedure TX11WindowDisplay.HandleChangeFocus(NewFocus : Boolean);
-
-Begin
-  { No change? }
-  If NewFocus = FFocus Then
-    Exit;
-
-  FFocus := NewFocus;
-  If FFocus Then
-  Begin
-    { focus in }
-    If FFullScreen Then
-      EnterFullScreen;
-    
-    internal_ShowCursor(FCursorVisible);
-  End
-  Else
-  Begin
-    { focus out }
-    If FFullScreen Then
-      LeaveFullScreen;
-    
-    internal_ShowCursor(True);
-  End;
-  
-  XSync(m_disp, False);
-End;
-
-Procedure TX11WindowDisplay.HandleEvents;
-
-Var
-  e : TXEvent;
-  NewFocus : Boolean;
-  NewFocusSpecified : Boolean;
-
-  Function UsefulEventsPending : Boolean;
-  
-  Var
-    tmpEvent : TXEvent;
-  
-  Begin
-    If XCheckTypedEvent(m_disp, ClientMessage, @tmpEvent) Then
-    Begin
-      Result := True;
-      XPutBackEvent(m_disp, @tmpEvent);
-      Exit;
-    End;
-    
-    If XCheckMaskEvent(m_disp, FocusChangeMask Or
-                       KeyPressMask Or KeyReleaseMask Or
-		       ButtonPressMask Or ButtonReleaseMask Or
-		       PointerMotionMask Or ExposureMask, @tmpEvent) Then
-    Begin
-      Result := True;
-      XPutBackEvent(m_disp, @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(m_normalkeys[sym And $FF], uni, alt, shift, ctrl, press);
-      $FF : key := TPTCKeyEvent.Create(m_functionkeys[sym And $FF], uni, alt, shift, ctrl, press);
-      Else
-        key := TPTCKeyEvent.Create;
-    End;
-    FEventQueue.AddEvent(key);
-  End;
-  
-  Procedure HandleMouseEvent;
-  
-  Var
-    x, y : cint;
-    state : cuint;
-    PTCMouseButtonState : TPTCMouseButtonState;
-    
-    button : TPTCMouseButton;
-    before, after : Boolean;
-    cstate : TPTCMouseButtonState;
-    
-  Begin
-    Case e._type Of
-      MotionNotify : Begin
-        x := e.xmotion.x;
-	y := e.xmotion.y;
-	state := e.xmotion.state;
-      End;
-      ButtonPress, ButtonRelease : Begin
-        x := e.xbutton.x;
-	y := e.xbutton.y;
-	state := e.xbutton.state;
-	If e._type = ButtonPress Then
-	Begin
-	  Case e.xbutton.button Of
-	    Button1 : state := state Or Button1Mask;
-	    Button2 : state := state Or Button2Mask;
-	    Button3 : state := state Or Button3Mask;
-	    Button4 : state := state Or Button4Mask;
-	    Button5 : state := state Or Button5Mask;
-	  End;
-	End
-	Else
-	Begin
-	  Case e.xbutton.button Of
-	    Button1 : state := state And (Not Button1Mask);
-	    Button2 : state := state And (Not Button2Mask);
-	    Button3 : state := state And (Not Button3Mask);
-	    Button4 : state := state And (Not Button4Mask);
-	    Button5 : state := state And (Not Button5Mask);
-	  End;
-	End;
-      End;
-      Else
-        Raise TPTCError.Create('Internal Error');
-    End;
-    
-    If (state And Button1Mask) = 0 Then
-      PTCMouseButtonState := []
-    Else
-      PTCMouseButtonState := [PTCMouseButton1];
-    If (state And Button2Mask) <> 0 Then
-      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
-    If (state And Button3Mask) <> 0 Then
-      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
-    If (state And Button4Mask) <> 0 Then
-      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton4];
-    If (state And Button5Mask) <> 0 Then
-      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton5];
-    
-    If (x >= 0) And (x < m_width) And (y >= 0) And (y < m_height) Then
-    Begin
-      If Not FPreviousMousePositionSaved Then
-      Begin
-        FPreviousMouseX := x; { first DeltaX will be 0 }
-	FPreviousMouseY := y; { first DeltaY will be 0 }
-	FPreviousMouseButtonState := [];
-      End;
-      
-      { movement? }
-      If (x <> FPreviousMouseX) Or (y <> FPreviousMouseY) Then
-        FEventQueue.AddEvent(TPTCMouseEvent.Create(x, y, x - FPreviousMouseX, y - 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(x, y, 0, 0, cstate, True, button));
-	End
-	Else
-	  If before And (Not after) Then
-	  Begin
-	    { button was released }
-	    cstate := cstate - [button];
-	    FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(x, y, 0, 0, cstate, False, button));
-	  End;
-      End;
-      
-      FPreviousMouseX := x;
-      FPreviousMouseY := y;
-      FPreviousMouseButtonState := PTCMouseButtonState;
-      FPreviousMousePositionSaved := True;
-    End;
-  End;
-
-Begin
-  NewFocusSpecified := False;
-  While UsefulEventsPending Do
-  Begin
-    XNextEvent(m_disp, @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, MotionNotify : HandleMouseEvent;
-    End;
-  End;
-  If NewFocusSpecified Then
-    HandleChangeFocus(NewFocus);
-End;
-
-Procedure TX11WindowDisplay.update;
-
-Begin
-  m_primary.put(m_window, m_gc, m_destx, m_desty);
-  
-  HandleEvents;
-End;
-
-Procedure TX11WindowDisplay.update(Const _area : TPTCArea);
-
-Var
-  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;
-  
-  HandleEvents;
-End;
-
-Function TX11WindowDisplay.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(m_disp, @tmpEvent);
-    End;
-  Until (Not Wait) Or (event <> Nil);
-  Result := event <> Nil;
-End;
-
-Function TX11WindowDisplay.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(m_disp, @tmpEvent);
-    End;
-  Until (Not Wait) Or (Result <> Nil);
-End;
-
-Function TX11WindowDisplay.lock : Pointer;
-
-Begin
-  lock := m_primary.lock;
-End;
-
-Procedure TX11WindowDisplay.unlock;
-
-Begin
-End;
-
-Procedure TX11WindowDisplay.palette(Const _palette : TPTCPalette);
-
-Var
-  pal : PUint32;
-  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;
-
-Function TX11WindowDisplay.isFullScreen : Boolean;
-
-Begin
-  Result := FFullScreen;
-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;