+ UPgrade PTCPas to latest svn revision

git-svn-id: trunk@6912 -

.gitattributes

@@ -3160,11 +3160,15 @@ packages/extra/pcap/fpmake.pp svneol=native#text/plain
 packages/extra/pcap/pcap.pp svneol=native#text/plain
 packages/extra/ptc/Makefile -text
 packages/extra/ptc/Makefile.fpc -text
-packages/extra/ptc/aread.inc -text
-packages/extra/ptc/areai.inc -text
+packages/extra/ptc/aread.inc svneol=native#text/x-pascal
+packages/extra/ptc/areai.inc svneol=native#text/x-pascal
 packages/extra/ptc/basecond.inc -text
 packages/extra/ptc/baseconi.inc -text
+packages/extra/ptc/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/c_api/area.inc -text
 packages/extra/ptc/c_api/aread.inc -text
@@ -3195,16 +3199,18 @@ packages/extra/ptc/c_api/surface.inc -text
 packages/extra/ptc/c_api/surfaced.inc -text
 packages/extra/ptc/c_api/timer.inc -text
 packages/extra/ptc/c_api/timerd.inc -text
-packages/extra/ptc/cleard.inc -text
-packages/extra/ptc/cleari.inc -text
-packages/extra/ptc/clipperd.inc -text
-packages/extra/ptc/clipperi.inc -text
-packages/extra/ptc/colord.inc -text
-packages/extra/ptc/colori.inc -text
-packages/extra/ptc/consoled.inc -text
-packages/extra/ptc/consolei.inc -text
-packages/extra/ptc/copyd.inc -text
-packages/extra/ptc/copyi.inc -text
+packages/extra/ptc/cleard.inc svneol=native#text/x-pascal
+packages/extra/ptc/cleari.inc svneol=native#text/x-pascal
+packages/extra/ptc/clipperd.inc svneol=native#text/x-pascal
+packages/extra/ptc/clipperi.inc svneol=native#text/x-pascal
+packages/extra/ptc/colord.inc svneol=native#text/x-pascal
+packages/extra/ptc/colori.inc svneol=native#text/x-pascal
+packages/extra/ptc/consoled.inc svneol=native#text/x-pascal
+packages/extra/ptc/consolei.inc svneol=native#text/x-pascal
+packages/extra/ptc/copyd.inc svneol=native#text/x-pascal
+packages/extra/ptc/copyi.inc svneol=native#text/x-pascal
+packages/extra/ptc/coreimplementation.inc svneol=native#text/x-pascal
+packages/extra/ptc/coreinterface.inc svneol=native#text/x-pascal
 packages/extra/ptc/demos/Makefile -text
 packages/extra/ptc/demos/Makefile.fpc -text
 packages/extra/ptc/demos/fire.pp -text
@@ -3239,8 +3245,10 @@ packages/extra/ptc/dos/timeunit/timeunit.pp -text
 packages/extra/ptc/dos/vesa/console.inc -text
 packages/extra/ptc/dos/vesa/consoled.inc -text
 packages/extra/ptc/dos/vesa/vesa.pp -text
-packages/extra/ptc/errord.inc -text
-packages/extra/ptc/errori.inc -text
+packages/extra/ptc/errord.inc svneol=native#text/x-pascal
+packages/extra/ptc/errori.inc svneol=native#text/x-pascal
+packages/extra/ptc/eventd.inc svneol=native#text/x-pascal
+packages/extra/ptc/eventi.inc svneol=native#text/x-pascal
 packages/extra/ptc/examples/Makefile -text
 packages/extra/ptc/examples/Makefile.fpc -text
 packages/extra/ptc/examples/area.pp -text
@@ -3262,24 +3270,28 @@ packages/extra/ptc/examples/save.pp -text
 packages/extra/ptc/examples/stretch.pp -text
 packages/extra/ptc/examples/stretch.tga -text
 packages/extra/ptc/examples/timer.pp -text
-packages/extra/ptc/formatd.inc -text
-packages/extra/ptc/formati.inc -text
-packages/extra/ptc/keyd.inc -text
-packages/extra/ptc/keyi.inc -text
-packages/extra/ptc/log.inc -text
-packages/extra/ptc/moded.inc -text
-packages/extra/ptc/modei.inc -text
-packages/extra/ptc/paletted.inc -text
-packages/extra/ptc/palettei.inc -text
+packages/extra/ptc/formatd.inc svneol=native#text/x-pascal
+packages/extra/ptc/formati.inc svneol=native#text/x-pascal
+packages/extra/ptc/keyd.inc svneol=native#text/x-pascal
+packages/extra/ptc/keyeventd.inc svneol=native#text/x-pascal
+packages/extra/ptc/keyeventi.inc svneol=native#text/x-pascal
+packages/extra/ptc/keyi.inc svneol=native#text/x-pascal
+packages/extra/ptc/log.inc svneol=native#text/x-pascal
+packages/extra/ptc/moded.inc svneol=native#text/x-pascal
+packages/extra/ptc/modei.inc svneol=native#text/x-pascal
+packages/extra/ptc/mouseeventd.inc svneol=native#text/x-pascal
+packages/extra/ptc/mouseeventi.inc svneol=native#text/x-pascal
+packages/extra/ptc/paletted.inc svneol=native#text/x-pascal
+packages/extra/ptc/palettei.inc svneol=native#text/x-pascal
 packages/extra/ptc/ptc.cfg -text
 packages/extra/ptc/ptc.pp -text
-packages/extra/ptc/surfaced.inc -text
-packages/extra/ptc/surfacei.inc -text
+packages/extra/ptc/surfaced.inc svneol=native#text/x-pascal
+packages/extra/ptc/surfacei.inc svneol=native#text/x-pascal
 packages/extra/ptc/test/convtest.pas -text
 packages/extra/ptc/test/endian.pas -text
 packages/extra/ptc/test/view.pp -text
-packages/extra/ptc/timerd.inc -text
-packages/extra/ptc/timeri.inc -text
+packages/extra/ptc/timerd.inc svneol=native#text/x-pascal
+packages/extra/ptc/timeri.inc svneol=native#text/x-pascal
 packages/extra/ptc/tinyptc/tinyptc.pp -text
 packages/extra/ptc/win32/base/cursor.inc -text
 packages/extra/ptc/win32/base/event.inc -text

packages/extra/ptc/aread.inc

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

packages/extra/ptc/areai.inc

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

packages/extra/ptc/baseconsoled.inc

@@ -0,0 +1,57 @@
+{
+    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/baseconsolei.inc

@@ -0,0 +1,88 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+Constructor TPTCBaseConsole.Create;
+
+Begin
+  FReleaseEnabled := False;
+End;
+
+Function TPTCBaseConsole.KeyPressed : Boolean;
+
+Var
+  k, kpeek : TPTCEvent;
+
+Begin
+  k := Nil;
+  Try
+    Repeat
+      kpeek := PeekEvent(False, [PTCKeyEvent]);
+      If kpeek = Nil Then
+        Exit(False);
+      If FReleaseEnabled Or (kpeek As TPTCKeyEvent).Press Then
+        Exit(True);
+      NextEvent(k, False, [PTCKeyEvent]);
+    Until False;
+  Finally
+    k.Free;
+  End;
+End;
+
+Procedure TPTCBaseConsole.ReadKey(Var 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/basesurface.inc

@@ -0,0 +1,31 @@
+{
+    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 TPTCBaseSurface.Create;
+
+Begin
+End;
+}
+{Destructor TPTCBaseSurface.Destroy;
+
+Begin
+  Inherited Destroy;
+End;
+}

packages/extra/ptc/basesurfaced.inc

@@ -0,0 +1,63 @@
+{
+    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/cleard.inc

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

packages/extra/ptc/cleari.inc

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

packages/extra/ptc/clipperd.inc

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

packages/extra/ptc/clipperi.inc

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

packages/extra/ptc/colord.inc

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

packages/extra/ptc/colori.inc

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

packages/extra/ptc/consoled.inc

@@ -22,13 +22,13 @@ Type
   TPTCConsole=Class(TPTCBaseConsole)
   Private
     Function ConsoleCreate(index : Integer) : TPTCBaseConsole;
-    Function ConsoleCreate(Const _name : String) : TPTCBaseConsole;
+    Function ConsoleCreate(Const AName : String) : TPTCBaseConsole;
     Procedure check;
     console : TPTCBaseConsole;
     m_modes : Array[0..1023] Of TPTCMode;
     hacky_option_console_flag : Boolean;
   Public
-    Constructor Create;
+    Constructor Create; Override;
     Destructor Destroy; Override;
     Procedure configure(Const _file : String); Override;
     Function option(Const _option : String) : Boolean; Override;
@@ -74,18 +74,18 @@ Type
     Procedure clear(Const color : TPTCColor;
                     Const _area : TPTCArea); Override;
     Procedure palette(Const _palette : TPTCPalette); Override;
-    Function palette : TPTCPalette; Override;
-    Procedure clip(Const _area : TPTCArea); Override;
-    Function width : Integer; Override;
-    Function height : Integer; Override;
-    Function pitch : Integer; Override;
-    Function pages : Integer; Override;
-    Function area : TPTCArea; Override;
-    Function clip : TPTCArea; Override;
-    Function format : TPTCFormat; Override;
-    Function name : String; Override;
-    Function title : String; Override;
-    Function information : String; Override;
+    Function Palette : TPTCPalette; Override;
+    Procedure Clip(Const _area : TPTCArea); Override;
+    Function GetWidth : Integer; Override;
+    Function GetHeight : Integer; Override;
+    Function GetPitch : Integer; Override;
+    Function GetPages : Integer; Override;
+    Function GetArea : TPTCArea; Override;
+    Function Clip : TPTCArea; Override;
+    Function GetFormat : TPTCFormat; Override;
+    Function GetName : String; Override;
+    Function GetTitle : String; Override;
+    Function GetInformation : String; Override;
     Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override;
     Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override;
   End;

packages/extra/ptc/consolei.inc

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

packages/extra/ptc/copyd.inc

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

packages/extra/ptc/copyi.inc

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

packages/extra/ptc/coreimplementation.inc

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

packages/extra/ptc/coreinterface.inc

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

packages/extra/ptc/errord.inc

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

packages/extra/ptc/errori.inc

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

packages/extra/ptc/eventd.inc

@@ -0,0 +1,38 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+Type
+  TPTCEventType = (PTCKeyEvent, PTCMouseEvent{, PTCExposeEvent});
+  TPTCEventMask = Set Of TPTCEventType;
+  TPTCEvent = Class(TObject)
+  Protected
+    Function GetType : TPTCEventType; Virtual; Abstract;
+  Public
+    Property EventType : TPTCEventType Read GetType;
+  End;
+
+Const
+  PTCAnyEvent : TPTCEventMask = [PTCKeyEvent, PTCMouseEvent{, PTCExposeEvent}];
+
+{Type
+  TPTCExposeEvent = Class(TPTCEvent)
+  Protected
+    Function GetType : TPTCEventType; Override;
+  End;}

packages/extra/ptc/eventi.inc

@@ -0,0 +1,141 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{Function TPTCExposeEvent.GetType : TPTCEventType;
+
+Begin
+  Result := PTCExposeEvent;
+End;}
+
+Type
+  PEventLinkedList = ^TEventLinkedList;
+  TEventLinkedList = Record
+    Event : TPTCEvent;
+    Next : PEventLinkedList;
+  End;
+  TEventQueue = Class(TObject)
+  Private
+    FHead, FTail : PEventLinkedList;
+  Public
+    Constructor Create;
+    Destructor Destroy; Override;
+    Procedure AddEvent(event : TPTCEvent);
+    Function PeekEvent(Const EventMask : TPTCEventMask) : TPTCEvent;
+    Function NextEvent(Const EventMask : TPTCEventMask) : TPTCEvent;
+  End;
+
+Constructor TEventQueue.Create;
+
+Begin
+  FHead := Nil;
+  FTail := Nil;
+End;
+
+Destructor TEventQueue.Destroy;
+
+Var
+  p, pnext : PEventLinkedList;
+
+Begin
+  p := FHead;
+  While p <> Nil Do
+  Begin
+    FreeAndNil(p^.Event);
+    pnext := p^.Next;
+    Dispose(p);
+    p := pnext;
+  End;
+  Inherited Destroy;
+End;
+
+Procedure TEventQueue.AddEvent(event : TPTCEvent);
+
+Var
+  tmp : PEventLinkedList;
+
+Begin
+  New(tmp);
+  FillChar(tmp^, SizeOf(tmp^), 0);
+  tmp^.Next := Nil;
+  tmp^.Event := event;
+
+  If FTail <> Nil Then
+  Begin
+    FTail^.Next := tmp;
+    FTail := tmp;
+  End
+  Else
+  Begin { FTail = Nil }
+    FHead := tmp;
+    FTail := tmp;
+  End;
+End;
+
+Function TEventQueue.PeekEvent(Const EventMask : TPTCEventMask) : TPTCEvent;
+
+Var
+  p : PEventLinkedList;
+
+Begin
+  p := FHead;
+  While p <> Nil Do
+  Begin
+    If p^.Event.EventType In EventMask Then
+    Begin
+      Result := p^.Event;
+      Exit;
+    End;
+    p := p^.Next;
+  End;
+
+  Result := Nil;
+End;
+
+Function TEventQueue.NextEvent(Const EventMask : TPTCEventMask) : TPTCEvent;
+
+Var
+  prev, p : PEventLinkedList;
+
+Begin
+  prev := Nil;
+  p := FHead;
+  While p <> Nil Do
+  Begin
+    If p^.Event.EventType In EventMask Then
+    Begin
+      Result := p^.Event;
+
+      { delete the element from the linked list }
+      If prev <> Nil Then
+        prev^.Next := p^.Next
+      Else
+        FHead := p^.Next;
+      If p^.Next = Nil Then
+        FTail := prev;
+      Dispose(p);
+
+      Exit;
+    End;
+    prev := p;
+    p := p^.Next;
+  End;
+
+  Result := Nil;
+End;

packages/extra/ptc/formatd.inc

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

packages/extra/ptc/formati.inc

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

packages/extra/ptc/keyeventd.inc

@@ -0,0 +1,166 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+Type
+  TPTCKeyEvent=Class(TPTCEvent)
+  Private
+    FCode : Integer;
+    FUnicode : Integer;
+    FAlt : Boolean;
+    FShift : Boolean;
+    FControl : Boolean;
+    FPress : Boolean;
+
+    Function GetRelease : Boolean;
+  Protected
+    Function GetType : TPTCEventType; Override;
+  Public
+    Constructor Create;
+    Constructor Create(ACode : Integer);
+    Constructor Create(ACode, AUnicode : Integer);
+    Constructor Create(ACode, AUnicode : Integer; APress : Boolean);
+    Constructor Create(ACode : Integer; AAlt, AShift, AControl : Boolean);
+    Constructor Create(ACode : Integer; AAlt, AShift, AControl, APress : Boolean);
+    Constructor Create(ACode, AUnicode : Integer;
+                       AAlt, AShift, AControl : Boolean);
+    Constructor Create(ACode, AUnicode : Integer;
+                       AAlt, AShift, AControl, APress : Boolean);
+    Constructor Create(Const AKey : TPTCKeyEvent);
+    Procedure Assign(Const AKey : TPTCKeyEvent);
+    Function Equals(Const AKey : TPTCKeyEvent) : Boolean;
+    Property Code : Integer read FCode;
+    Property Unicode : Integer read FUnicode;
+    Property Alt : Boolean read FAlt;
+    Property Shift : Boolean read FShift;
+    Property Control : Boolean read FControl;
+    Property Press : Boolean read FPress;
+    Property Release : Boolean read GetRelease;
+  End;
+
+Const
+  PTCKEY_UNDEFINED    = $00;
+  PTCKEY_CANCEL       = $03;
+  PTCKEY_BACKSPACE    = $08; {'\b'}
+  PTCKEY_TAB          = $09; {'\t'}
+  PTCKEY_ENTER        = $0A; {'\n'}
+  PTCKEY_CLEAR        = $0C;
+  PTCKEY_SHIFT        = $10;
+  PTCKEY_CONTROL      = $11;
+  PTCKEY_ALT          = $12;
+  PTCKEY_PAUSE        = $13;
+  PTCKEY_CAPSLOCK     = $14;
+  PTCKEY_KANA         = $15;
+  PTCKEY_FINAL        = $18;
+  PTCKEY_KANJI        = $19;
+  PTCKEY_ESCAPE       = $1B;
+  PTCKEY_CONVERT      = $1C;
+  PTCKEY_NONCONVERT   = $1D;
+  PTCKEY_ACCEPT       = $1E;
+  PTCKEY_MODECHANGE   = $1F;
+  PTCKEY_SPACE        = $20;
+  PTCKEY_PAGEUP       = $21;
+  PTCKEY_PAGEDOWN     = $22;
+  PTCKEY_END          = $23;
+  PTCKEY_HOME         = $24;
+  PTCKEY_LEFT         = $25;
+  PTCKEY_UP           = $26;
+  PTCKEY_RIGHT        = $27;
+  PTCKEY_DOWN         = $28;
+  PTCKEY_COMMA        = $2C; {','}
+  PTCKEY_PERIOD       = $2E; {'.'}
+  PTCKEY_SLASH        = $2F; {'/'}
+  PTCKEY_ZERO         = $30;
+  PTCKEY_ONE          = $31;
+  PTCKEY_TWO          = $32;
+  PTCKEY_THREE        = $33;
+  PTCKEY_FOUR         = $34;
+  PTCKEY_FIVE         = $35;
+  PTCKEY_SIX          = $36;
+  PTCKEY_SEVEN        = $37;
+  PTCKEY_EIGHT        = $38;
+  PTCKEY_NINE         = $39;
+  PTCKEY_SEMICOLON    = $3B; {';'}
+  PTCKEY_EQUALS       = $3D; {'='}
+  PTCKEY_A            = $41;
+  PTCKEY_B            = $42;
+  PTCKEY_C            = $43;
+  PTCKEY_D            = $44;
+  PTCKEY_E            = $45;
+  PTCKEY_F            = $46;
+  PTCKEY_G            = $47;
+  PTCKEY_H            = $48;
+  PTCKEY_I            = $49;
+  PTCKEY_J            = $4A;
+  PTCKEY_K            = $4B;
+  PTCKEY_L            = $4C;
+  PTCKEY_M            = $4D;
+  PTCKEY_N            = $4E;
+  PTCKEY_O            = $4F;
+  PTCKEY_P            = $50;
+  PTCKEY_Q            = $51;
+  PTCKEY_R            = $52;
+  PTCKEY_S            = $53;
+  PTCKEY_T            = $54;
+  PTCKEY_U            = $55;
+  PTCKEY_V            = $56;
+  PTCKEY_W            = $57;
+  PTCKEY_X            = $58;
+  PTCKEY_Y            = $59;
+  PTCKEY_Z            = $5A;
+  PTCKEY_OPENBRACKET  = $5B; {'['}
+  PTCKEY_BACKSLASH    = $5C; {'\'}
+  PTCKEY_CLOSEBRACKET = $5D; {']'}
+  PTCKEY_NUMPAD0      = $60;
+  PTCKEY_NUMPAD1      = $61;
+  PTCKEY_NUMPAD2      = $62;
+  PTCKEY_NUMPAD3      = $63;
+  PTCKEY_NUMPAD4      = $64;
+  PTCKEY_NUMPAD5      = $65;
+  PTCKEY_NUMPAD6      = $66;
+  PTCKEY_NUMPAD7      = $67;
+  PTCKEY_NUMPAD8      = $68;
+  PTCKEY_NUMPAD9      = $69;
+  PTCKEY_MULTIPLY     = $6A; {numpad '*'}
+  PTCKEY_ADD          = $6B; {numpad '+'}
+  PTCKEY_SEPARATOR    = $6C;
+  PTCKEY_SUBTRACT     = $6D; {numpad '-'}
+  PTCKEY_DECIMAL      = $6E; {numpad '.'}
+  PTCKEY_DIVIDE       = $6F; {numpad '/'}
+  PTCKEY_F1           = $70;
+  PTCKEY_F2           = $71;
+  PTCKEY_F3           = $72;
+  PTCKEY_F4           = $73;
+  PTCKEY_F5           = $74;
+  PTCKEY_F6           = $75;
+  PTCKEY_F7           = $76;
+  PTCKEY_F8           = $77;
+  PTCKEY_F9           = $78;
+  PTCKEY_F10          = $79;
+  PTCKEY_F11          = $7A;
+  PTCKEY_F12          = $7B;
+  PTCKEY_DELETE       = $7F;
+  PTCKEY_NUMLOCK      = $90;
+  PTCKEY_SCROLLLOCK   = $91;
+  PTCKEY_PRINTSCREEN  = $9A;
+  PTCKEY_INSERT       = $9B;
+  PTCKEY_HELP         = $9C;
+  PTCKEY_META         = $9D;
+  PTCKEY_BACKQUOTE    = $C0;
+  PTCKEY_QUOTE        = $DE;

packages/extra/ptc/keyeventi.inc

@@ -0,0 +1,153 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+Function TPTCKeyEvent.GetType : TPTCEventType;
+
+Begin
+  Result := PTCKeyEvent;
+End;
+
+Constructor TPTCKeyEvent.Create;
+
+Begin
+  FCode    := Integer(PTCKEY_UNDEFINED);
+  FUnicode := -1;
+  FAlt     := False;
+  FShift   := False;
+  FControl := False;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode : Integer);
+
+Begin
+  FCode    := ACode;
+  FUnicode := -1;
+  FAlt     := False;
+  FShift   := False;
+  FControl := False;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer);
+
+Begin
+  FCode    := ACode;
+  FUnicode := AUnicode;
+  FAlt     := False;
+  FShift   := False;
+  FControl := False;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer; APress : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := AUnicode;
+  FAlt     := False;
+  FShift   := False;
+  FControl := False;
+  FPress   := APress;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode : Integer; AAlt, AShift, AControl : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := -1;
+  FAlt     := AAlt;
+  FShift   := AShift;
+  FControl := AControl;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode : Integer; AAlt, AShift, AControl, APress : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := -1;
+  FAlt     := AAlt;
+  FShift   := AShift;
+  FControl := AControl;
+  FPress   := APress;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer; AAlt, AShift, AControl : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := AUnicode;
+  FAlt     := AAlt;
+  FShift   := AShift;
+  FControl := AControl;
+  FPress   := True;
+End;
+
+Constructor TPTCKeyEvent.Create(ACode, AUnicode : Integer;
+                                AAlt, AShift, AControl, APress : Boolean);
+
+Begin
+  FCode    := ACode;
+  FUnicode := AUnicode;
+  FAlt     := AAlt;
+  FShift   := AShift;
+  FControl := AControl;
+  FPress   := APress;
+End;
+
+Constructor TPTCKeyEvent.Create(Const AKey : TPTCKeyEvent);
+
+Begin
+  FCode    := AKey.Code;
+  FUnicode := AKey.Unicode;
+  FAlt     := AKey.Alt;
+  FShift   := AKey.Shift;
+  FControl := AKey.Control;
+  FPress   := AKey.Press;
+End;
+
+Procedure TPTCKeyEvent.Assign(Const AKey : TPTCKeyEvent);
+
+Begin
+  FCode    := AKey.Code;
+  FUnicode := AKey.Unicode;
+  FAlt     := AKey.Alt;
+  FShift   := AKey.Shift;
+  FControl := AKey.Control;
+  FPress   := AKey.Press;
+End;
+
+Function TPTCKeyEvent.Equals(Const AKey : TPTCKeyEvent) : Boolean;
+
+Begin
+  Result := (FCode    = AKey.FCode) And
+            (FUnicode = AKey.FUnicode) And
+            (FAlt     = AKey.FAlt) And
+            (FShift   = AKey.FShift) And
+            (FControl = AKey.FControl) And
+            (FPress   = AKey.FPress);
+End;
+
+Function TPTCKeyEvent.GetRelease : Boolean;
+
+Begin
+  Result := Not FPress;
+End;

packages/extra/ptc/log.inc

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

packages/extra/ptc/moded.inc

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

packages/extra/ptc/modei.inc

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

packages/extra/ptc/mouseeventd.inc

@@ -0,0 +1,56 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+Type
+{todo  TPTCMouseCursor = (PTCMouseCursorDefault,
+                     PTCMouseCursorAlwaysVisible,
+                     PTCMouseCursorAlwaysInvisible);}
+  TPTCMouseButton = (PTCMouseButton1, { left mouse button }
+                     PTCMouseButton2, { right mouse button }
+                     PTCMouseButton3, { middle mouse button }
+                     PTCMouseButton4,
+                     PTCMouseButton5);
+  TPTCMouseButtonState = Set Of TPTCMouseButton;
+  TPTCMouseEvent = Class(TPTCEvent)
+  Private
+    FX, FY : Integer;
+    FDeltaX, FDeltaY : Integer;
+    FButtonState : TPTCMouseButtonState;
+  Protected
+    Function GetType : TPTCEventType; Override;
+  Public
+    Constructor Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState);
+    Property X : Integer Read FX;
+    Property Y : Integer Read FY;
+    Property DeltaX : Integer Read FDeltaX;
+    Property DeltaY : Integer Read FDeltaY;
+    Property ButtonState : TPTCMouseButtonState Read FButtonState;
+  End;
+  TPTCMouseButtonEvent = Class(TPTCMouseEvent)
+  Private
+    FPress : Boolean;
+    FButton : TPTCMouseButton;
+    Function GetRelease : Boolean;
+  Public
+    Constructor Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState; APress : Boolean; AButton : TPTCMouseButton);
+    Property Press : Boolean Read FPress;
+    Property Release : Boolean Read GetRelease;
+    Property Button : TPTCMouseButton Read FButton;
+  End;

packages/extra/ptc/mouseeventi.inc

@@ -0,0 +1,53 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2006  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+Function TPTCMouseEvent.GetType : TPTCEventType;
+
+Begin
+  Result := PTCMouseEvent;
+End;
+
+Constructor TPTCMouseEvent.Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState);
+
+Begin
+  FX := AX;
+  FY := AY;
+  FDeltaX := ADeltaX;
+  FDeltaY := ADeltaY;
+  FButtonState := AButtonState;
+End;
+
+Constructor TPTCMouseButtonEvent.Create(AX, AY, ADeltaX, ADeltaY : Integer; AButtonState : TPTCMouseButtonState; APress : Boolean; AButton : TPTCMouseButton);
+
+Begin
+  If APress Xor (AButton In AButtonState) Then
+    Raise TPTCError.Create('Invalid ButtonState');
+
+  Inherited Create(AX, AY, ADeltaX, ADeltaY, AButtonState);
+
+  FPress := APress;
+  FButton := AButton;
+End;
+
+Function TPTCMouseButtonEvent.GetRelease : Boolean;
+
+Begin
+  Result := Not FPress;
+End;

packages/extra/ptc/palettei.inc

@@ -55,7 +55,7 @@ Begin
   m_handle := Hermes_PaletteInstance;
   If m_handle = 0 Then
     Raise TPTCError.Create('could not create hermes palette instance');
-  ASSign(palette);
+  Assign(palette);
 End;
 
 Destructor TPTCPalette.Destroy;

packages/extra/ptc/surfaced.inc

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

packages/extra/ptc/surfacei.inc

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

packages/extra/ptc/timeri.inc

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