--- Merging r19633 into '.':

U    packages/graph/src/ptcgraph/ptcgraph.pp
U    packages/graph/src/ptcgraph/ptccrt.pp
U    packages/ptc/tests/convtest.pp
U    packages/ptc/tests/view.pp
U    packages/ptc/src/win32/directx/primaryd.inc
U    packages/ptc/src/win32/directx/directxconsoled.inc
U    packages/ptc/src/win32/directx/displayd.inc
U    packages/ptc/src/win32/directx/translate.inc
U    packages/ptc/src/win32/directx/directxconsolei.inc
U    packages/ptc/src/win32/directx/hook.inc
U    packages/ptc/src/win32/directx/primary.inc
U    packages/ptc/src/win32/directx/display.inc
U    packages/ptc/src/win32/gdi/gdiconsoled.inc
U    packages/ptc/src/win32/gdi/win32dibi.inc
U    packages/ptc/src/win32/gdi/gdiconsolei.inc
U    packages/ptc/src/win32/gdi/win32dibd.inc
U    packages/ptc/src/win32/base/window.inc
U    packages/ptc/src/win32/base/kbd.inc
U    packages/ptc/src/ptc.pp
U    packages/ptc/src/dos/textfx2/textfx2.pp
U    packages/ptc/src/dos/textfx2/textfx2consoled.inc
U    packages/ptc/src/dos/textfx2/textfx2consolei.inc
U    packages/ptc/src/dos/cga/cgaconsoled.inc
U    packages/ptc/src/dos/cga/cgaconsolei.inc
U    packages/ptc/src/dos/vga/vgaconsolei.inc
U    packages/ptc/src/dos/vga/vgaconsoled.inc
U    packages/ptc/src/dos/vesa/vesaconsolei.inc
U    packages/ptc/src/dos/vesa/vesaconsoled.inc
U    packages/ptc/src/wince/gapi/wincegapiconsoled.inc
U    packages/ptc/src/wince/gapi/wincegapiconsolei.inc
U    packages/ptc/src/wince/gdi/wincebitmapinfoi.inc
U    packages/ptc/src/wince/gdi/wincegdiconsoled.inc
U    packages/ptc/src/wince/gdi/wincebitmapinfod.inc
U    packages/ptc/src/wince/gdi/wincegdiconsolei.inc
U    packages/ptc/src/ptcwrapper/ptcwrapper.pp
U    packages/ptc/src/ptcwrapper/ptceventqueue.pp
U    packages/ptc/src/core/clipperi.inc
U    packages/ptc/src/core/aread.inc
U    packages/ptc/src/core/copyd.inc
U    packages/ptc/src/core/log.inc
U    packages/ptc/src/core/areai.inc
U    packages/ptc/src/core/colord.inc
U    packages/ptc/src/core/copyi.inc
U    packages/ptc/src/core/timerd.inc
U    packages/ptc/src/core/basesurfaced.inc
U    packages/ptc/src/core/colori.inc
U    packages/ptc/src/core/timeri.inc
U    packages/ptc/src/core/cleard.inc
U    packages/ptc/src/core/formatd.inc
U    packages/ptc/src/core/surfaced.inc
U    packages/ptc/src/core/keyeventd.inc
U    packages/ptc/src/core/mouseeventd.inc
U    packages/ptc/src/core/cleari.inc
U    packages/ptc/src/core/surfacei.inc
U    packages/ptc/src/core/baseconsoled.inc
U    packages/ptc/src/core/formati.inc
U    packages/ptc/src/core/paletted.inc
U    packages/ptc/src/core/keyeventi.inc
U    packages/ptc/src/core/mouseeventi.inc
U    packages/ptc/src/core/consoled.inc
U    packages/ptc/src/core/baseconsolei.inc
U    packages/ptc/src/core/palettei.inc
U    packages/ptc/src/core/consolei.inc
U    packages/ptc/src/core/eventd.inc
U    packages/ptc/src/core/moded.inc
U    packages/ptc/src/core/eventi.inc
U    packages/ptc/src/core/modei.inc
U    packages/ptc/src/core/clipperd.inc
U    packages/ptc/src/x11/x11displayi.inc
U    packages/ptc/src/x11/x11modesi.inc
U    packages/ptc/src/x11/x11imaged.inc
U    packages/ptc/src/x11/x11imagei.inc
U    packages/ptc/src/x11/x11windowdisplayd.inc
U    packages/ptc/src/x11/x11windowdisplayi.inc
U    packages/ptc/src/x11/x11consoled.inc
U    packages/ptc/src/x11/x11dga1displayd.inc
U    packages/ptc/src/x11/x11dga2displayd.inc
U    packages/ptc/src/x11/x11displayd.inc
U    packages/ptc/src/x11/x11consolei.inc
U    packages/ptc/src/x11/x11dga1displayi.inc
U    packages/ptc/src/x11/x11modesd.inc
U    packages/ptc/src/x11/x11dga2displayi.inc
A    packages/ptc/docs/INTF-CHANGES-0.99.12.txt
U    packages/ptc/docs/INSTALL.txt
U    packages/ptc/docs/CHANGES.txt
A    packages/ptc/docs/INTF-CHANGES-FAQ-0.99.12.txt
U    packages/ptc/docs/INTRO.txt
U    packages/ptc/docs/README.txt
U    packages/ptc/examples/mojo.pp
U    packages/ptc/examples/tunnel.pp
U    packages/ptc/examples/area.pp
U    packages/ptc/examples/land.pp
U    packages/ptc/examples/timer.pp
U    packages/ptc/examples/random.pp
U    packages/ptc/examples/clear.pp
U    packages/ptc/examples/mouse.pp
U    packages/ptc/examples/lights.pp
U    packages/ptc/examples/tunnel3d.pp
U    packages/ptc/examples/palette.pp
U    packages/ptc/examples/hicolor.pp
U    packages/ptc/examples/keyboard.pp
U    packages/ptc/examples/console.pp
U    packages/ptc/examples/modes.pp
U    packages/ptc/examples/buffer.pp
U    packages/ptc/examples/stretch.pp
U    packages/ptc/examples/pixel.pp
U    packages/ptc/examples/keyboard2.pp
U    packages/ptc/examples/image.pp
U    packages/ptc/examples/fire.pp
U    packages/ptc/examples/clip.pp
U    packages/ptc/examples/con_info.pp
U    packages/ptc/examples/texwarp.pp
U    packages/ptc/examples/flower.pp
U    packages/ptc/examples/save.pp
--- Merging r19644 into '.':
U    rtl/emx/system.pas
--- Merging r19654 into '.':
U    packages/lua/src/lua.pas
--- Merging r19660 into '.':
U    rtl/inc/variants.pp
--- Merging r19679 into '.':
U    packages/postgres/src/dllistdyn.pp
--- Merging r19734 into '.':
U    rtl/win/wininc/defines.inc
U    rtl/win/wininc/redef.inc
--- Merging r19754 into '.':
U    packages/regexpr/src/regexpr.pas
--- Merging r19756 into '.':
U    packages/x11/src/xlib.pp
--- Merging r19874 into '.':
U    packages/gtk2/src/atk/atk.pas
U    packages/gtk2/src/gtk+/gdk-pixbuf/gdk2pixbuf.pas
U    packages/gtk2/src/gtk+/gdk/gdk2.pas
U    packages/gtk2/src/gtk+/gtk/gtk2.pas
U    packages/gtk2/src/gtk+/gtk/gtkscrolledwindow.inc
U    packages/gtk2/src/gtk+/gtk/gtkmain.inc
U    packages/gtk2/src/gtk+/gtk/gtkbox.inc
U    packages/gtk2/src/gtk+/gtk/gtktextlayout.inc
U    packages/gtk2/src/pangocairo/pangocairo.pas
U    packages/gtk2/src/libglade/libglade2.pas
U    packages/gtk2/src/pango/pango.pas
U    packages/gtk2/src/gtkglext/gdkglext.pas
U    packages/gtk2/src/gtkglext/gtkglext.pas
U    packages/gtk2/src/gtkhtml/gtkhtml.pas
U    packages/gtk2/src/glib/glib2.pas
U    packages/gtk2/src/glib/gincludes.inc
U    packages/gtk2/src/glib/glibconfig.inc
U    packages/gtk2/src/glib/gmem.inc
U    packages/gtk2/src/glib/giochannel.inc
U    packages/gtk2/src/glib/gutils.inc
U    packages/gtk2/src/glib/gthread.inc
U    packages/gtk2/src/glib/gmain.inc
--- Merging r19878 into '.':
U    rtl/linux/ossysc.inc
--- Merging r19880 into '.':
U    packages/pxlib/src/pxlib.pp
U    packages/pxlib/examples/ppxview.pp
--- Merging r19883 into '.':
U    rtl/win/winsock.pp
--- Merging r19893 into '.':
U    packages/unixutil/src/unixutils.pp

# revisions: 19633,19644,19654,19660,19679,19728,19734,19754,19756,19874,19878,19880,19883,19893
------------------------------------------------------------------------
r19633 | nickysn | 2011-11-12 19:28:40 +0100 (Sat, 12 Nov 2011) | 1 line
Changed paths:
   M /trunk/packages/graph/src/ptcgraph/ptccrt.pp
   M /trunk/packages/graph/src/ptcgraph/ptcgraph.pp
   M /trunk/packages/ptc/docs/CHANGES.txt
   M /trunk/packages/ptc/docs/INSTALL.txt
   A /trunk/packages/ptc/docs/INTF-CHANGES-0.99.12.txt
   A /trunk/packages/ptc/docs/INTF-CHANGES-FAQ-0.99.12.txt
   M /trunk/packages/ptc/docs/INTRO.txt
   M /trunk/packages/ptc/docs/README.txt
   M /trunk/packages/ptc/examples/area.pp
   M /trunk/packages/ptc/examples/buffer.pp
   M /trunk/packages/ptc/examples/clear.pp
   M /trunk/packages/ptc/examples/clip.pp
   M /trunk/packages/ptc/examples/con_info.pp
   M /trunk/packages/ptc/examples/console.pp
   M /trunk/packages/ptc/examples/fire.pp
   M /trunk/packages/ptc/examples/flower.pp
   M /trunk/packages/ptc/examples/hicolor.pp
   M /trunk/packages/ptc/examples/image.pp
   M /trunk/packages/ptc/examples/keyboard.pp
   M /trunk/packages/ptc/examples/keyboard2.pp
   M /trunk/packages/ptc/examples/land.pp
   M /trunk/packages/ptc/examples/lights.pp
   M /trunk/packages/ptc/examples/modes.pp
   M /trunk/packages/ptc/examples/mojo.pp
   M /trunk/packages/ptc/examples/mouse.pp
   M /trunk/packages/ptc/examples/palette.pp
   M /trunk/packages/ptc/examples/pixel.pp
   M /trunk/packages/ptc/examples/random.pp
   M /trunk/packages/ptc/examples/save.pp
   M /trunk/packages/ptc/examples/stretch.pp
   M /trunk/packages/ptc/examples/texwarp.pp
   M /trunk/packages/ptc/examples/timer.pp
   M /trunk/packages/ptc/examples/tunnel.pp
   M /trunk/packages/ptc/examples/tunnel3d.pp
   M /trunk/packages/ptc/src/core/aread.inc
   M /trunk/packages/ptc/src/core/areai.inc
   M /trunk/packages/ptc/src/core/baseconsoled.inc
   M /trunk/packages/ptc/src/core/baseconsolei.inc
   M /trunk/packages/ptc/src/core/basesurfaced.inc
   M /trunk/packages/ptc/src/core/cleard.inc
   M /trunk/packages/ptc/src/core/cleari.inc
   M /trunk/packages/ptc/src/core/clipperd.inc
   M /trunk/packages/ptc/src/core/clipperi.inc
   M /trunk/packages/ptc/src/core/colord.inc
   M /trunk/packages/ptc/src/core/colori.inc
   M /trunk/packages/ptc/src/core/consoled.inc
   M /trunk/packages/ptc/src/core/consolei.inc
   M /trunk/packages/ptc/src/core/copyd.inc
   M /trunk/packages/ptc/src/core/copyi.inc
   M /trunk/packages/ptc/src/core/eventd.inc
   M /trunk/packages/ptc/src/core/eventi.inc
   M /trunk/packages/ptc/src/core/formatd.inc
   M /trunk/packages/ptc/src/core/formati.inc
   M /trunk/packages/ptc/src/core/keyeventd.inc
   M /trunk/packages/ptc/src/core/keyeventi.inc
   M /trunk/packages/ptc/src/core/log.inc
   M /trunk/packages/ptc/src/core/moded.inc
   M /trunk/packages/ptc/src/core/modei.inc
   M /trunk/packages/ptc/src/core/mouseeventd.inc
   M /trunk/packages/ptc/src/core/mouseeventi.inc
   M /trunk/packages/ptc/src/core/paletted.inc
   M /trunk/packages/ptc/src/core/palettei.inc
   M /trunk/packages/ptc/src/core/surfaced.inc
   M /trunk/packages/ptc/src/core/surfacei.inc
   M /trunk/packages/ptc/src/core/timerd.inc
   M /trunk/packages/ptc/src/core/timeri.inc
   M /trunk/packages/ptc/src/dos/cga/cgaconsoled.inc
   M /trunk/packages/ptc/src/dos/cga/cgaconsolei.inc
   M /trunk/packages/ptc/src/dos/textfx2/textfx2.pp
   M /trunk/packages/ptc/src/dos/textfx2/textfx2consoled.inc
   M /trunk/packages/ptc/src/dos/textfx2/textfx2consolei.inc
   M /trunk/packages/ptc/src/dos/vesa/vesaconsoled.inc
   M /trunk/packages/ptc/src/dos/vesa/vesaconsolei.inc
   M /trunk/packages/ptc/src/dos/vga/vgaconsoled.inc
   M /trunk/packages/ptc/src/dos/vga/vgaconsolei.inc
   M /trunk/packages/ptc/src/ptc.pp
   M /trunk/packages/ptc/src/ptcwrapper/ptceventqueue.pp
   M /trunk/packages/ptc/src/ptcwrapper/ptcwrapper.pp
   M /trunk/packages/ptc/src/win32/base/kbd.inc
   M /trunk/packages/ptc/src/win32/base/window.inc
   M /trunk/packages/ptc/src/win32/directx/directxconsoled.inc
   M /trunk/packages/ptc/src/win32/directx/directxconsolei.inc
   M /trunk/packages/ptc/src/win32/directx/display.inc
   M /trunk/packages/ptc/src/win32/directx/displayd.inc
   M /trunk/packages/ptc/src/win32/directx/hook.inc
   M /trunk/packages/ptc/src/win32/directx/primary.inc
   M /trunk/packages/ptc/src/win32/directx/primaryd.inc
   M /trunk/packages/ptc/src/win32/directx/translate.inc
   M /trunk/packages/ptc/src/win32/gdi/gdiconsoled.inc
   M /trunk/packages/ptc/src/win32/gdi/gdiconsolei.inc
   M /trunk/packages/ptc/src/win32/gdi/win32dibd.inc
   M /trunk/packages/ptc/src/win32/gdi/win32dibi.inc
   M /trunk/packages/ptc/src/wince/gapi/wincegapiconsoled.inc
   M /trunk/packages/ptc/src/wince/gapi/wincegapiconsolei.inc
   M /trunk/packages/ptc/src/wince/gdi/wincebitmapinfod.inc
   M /trunk/packages/ptc/src/wince/gdi/wincebitmapinfoi.inc
   M /trunk/packages/ptc/src/wince/gdi/wincegdiconsoled.inc
   M /trunk/packages/ptc/src/wince/gdi/wincegdiconsolei.inc
   M /trunk/packages/ptc/src/x11/x11consoled.inc
   M /trunk/packages/ptc/src/x11/x11consolei.inc
   M /trunk/packages/ptc/src/x11/x11dga1displayd.inc
   M /trunk/packages/ptc/src/x11/x11dga1displayi.inc
   M /trunk/packages/ptc/src/x11/x11dga2displayd.inc
   M /trunk/packages/ptc/src/x11/x11dga2displayi.inc
   M /trunk/packages/ptc/src/x11/x11displayd.inc
   M /trunk/packages/ptc/src/x11/x11displayi.inc
   M /trunk/packages/ptc/src/x11/x11imaged.inc
   M /trunk/packages/ptc/src/x11/x11imagei.inc
   M /trunk/packages/ptc/src/x11/x11modesd.inc
   M /trunk/packages/ptc/src/x11/x11modesi.inc
   M /trunk/packages/ptc/src/x11/x11windowdisplayd.inc
   M /trunk/packages/ptc/src/x11/x11windowdisplayi.inc
   M /trunk/packages/ptc/tests/convtest.pp
   M /trunk/packages/ptc/tests/view.pp

* Updated PTCPas to version 0.99.12
------------------------------------------------------------------------
------------------------------------------------------------------------
r19644 | hajny | 2011-11-17 21:19:00 +0100 (Thu, 17 Nov 2011) | 1 line
Changed paths:
   M /trunk/rtl/emx/system.pas

  * retrieve process ID even if running under DOS
------------------------------------------------------------------------
------------------------------------------------------------------------
r19654 | marco | 2011-11-19 12:50:54 +0100 (Sat, 19 Nov 2011) | 2 lines
Changed paths:
   M /trunk/packages/lua/src/lua.pas

 * Lua libraryname fix, mantis 20705

------------------------------------------------------------------------
------------------------------------------------------------------------
r19660 | marco | 2011-11-20 20:45:22 +0100 (Sun, 20 Nov 2011) | 2 lines
Changed paths:
   M /trunk/rtl/inc/variants.pp

 * add NULL handling for customvariants, patch by Ludo, Mantis #20697

------------------------------------------------------------------------
------------------------------------------------------------------------
r19679 | jonas | 2011-11-24 20:58:52 +0100 (Thu, 24 Nov 2011) | 3 lines
Changed paths:
   M /trunk/packages/postgres/src/dllistdyn.pp

  * use generic sharedsuffix for libpq (fixes shared library extension
    for Mac OS X, patch by Ludo Brands, mantis #20734)

------------------------------------------------------------------------
------------------------------------------------------------------------
r19728 | mattias | 2011-12-02 22:35:27 +0100 (Fri, 02 Dec 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/avl_tree.pp

avl_tree: fixed FindPointer if on last node
------------------------------------------------------------------------
------------------------------------------------------------------------
r19734 | marco | 2011-12-03 17:41:06 +0100 (Sat, 03 Dec 2011) | 2 lines
Changed paths:
   M /trunk/rtl/win/wininc/defines.inc
   M /trunk/rtl/win/wininc/redef.inc

 * expanded VK_ codes. Patch by Nikolay N. Mantis #20801

------------------------------------------------------------------------
------------------------------------------------------------------------
r19754 | marco | 2011-12-04 19:41:04 +0100 (Sun, 04 Dec 2011) | 3 lines
Changed paths:
   M /trunk/packages/regexpr/src/regexpr.pas

 * fix for regexpr unicode mode. (multiple a move with the size of the base char type)
     Patch by Ludo B., mantis #020806

------------------------------------------------------------------------
------------------------------------------------------------------------
r19756 | marco | 2011-12-04 21:02:05 +0100 (Sun, 04 Dec 2011) | 3 lines
Changed paths:
   M /trunk/packages/x11/src/xlib.pp

 * Fixed opague pointer usage where the empty record was used instead of the 
   opague pointer. Patch by "No Realname",  Mantis #20814

------------------------------------------------------------------------
------------------------------------------------------------------------
r19874 | marco | 2011-12-18 23:48:47 +0100 (Sun, 18 Dec 2011) | 2 lines
Changed paths:
   M /trunk/packages/gtk2/src/atk/atk.pas
   M /trunk/packages/gtk2/src/glib/gincludes.inc
   M /trunk/packages/gtk2/src/glib/giochannel.inc
   M /trunk/packages/gtk2/src/glib/glib2.pas
   M /trunk/packages/gtk2/src/glib/glibconfig.inc
   M /trunk/packages/gtk2/src/glib/gmain.inc
   M /trunk/packages/gtk2/src/glib/gmem.inc
   M /trunk/packages/gtk2/src/glib/gthread.inc
   M /trunk/packages/gtk2/src/glib/gutils.inc
   M /trunk/packages/gtk2/src/gtk+/gdk/gdk2.pas
   M /trunk/packages/gtk2/src/gtk+/gdk-pixbuf/gdk2pixbuf.pas
   M /trunk/packages/gtk2/src/gtk+/gtk/gtk2.pas
   M /trunk/packages/gtk2/src/gtk+/gtk/gtkbox.inc
   M /trunk/packages/gtk2/src/gtk+/gtk/gtkmain.inc
   M /trunk/packages/gtk2/src/gtk+/gtk/gtkscrolledwindow.inc
   M /trunk/packages/gtk2/src/gtk+/gtk/gtktextlayout.inc
   M /trunk/packages/gtk2/src/gtkglext/gdkglext.pas
   M /trunk/packages/gtk2/src/gtkglext/gtkglext.pas
   M /trunk/packages/gtk2/src/gtkhtml/gtkhtml.pas
   M /trunk/packages/gtk2/src/libglade/libglade2.pas
   M /trunk/packages/gtk2/src/pango/pango.pas
   M /trunk/packages/gtk2/src/pangocairo/pangocairo.pas

 * Improve win64 support gtk2, step 1: updating ifdefs. Patch by Julian Schutsch, Mantis #20578

------------------------------------------------------------------------
------------------------------------------------------------------------
r19878 | marco | 2011-12-21 15:05:52 +0100 (Wed, 21 Dec 2011) | 2 lines
Changed paths:
   M /trunk/rtl/linux/ossysc.inc

 * add public alias to getrlimit

------------------------------------------------------------------------
------------------------------------------------------------------------
r19880 | marco | 2011-12-21 20:32:32 +0100 (Wed, 21 Dec 2011) | 2 lines
Changed paths:
   M /trunk/packages/pxlib/examples/ppxview.pp
   M /trunk/packages/pxlib/src/pxlib.pp

 * fixes for pxlib (paradox loader) from Barlone, Mantis #20945

------------------------------------------------------------------------
------------------------------------------------------------------------
r19883 | marco | 2011-12-22 13:20:00 +0100 (Thu, 22 Dec 2011) | 2 lines
Changed paths:
   M /trunk/rtl/win/winsock.pp

 * correct INVALID_SOCKET to NOT 0, mantis #20946

------------------------------------------------------------------------
------------------------------------------------------------------------
r19893 | marco | 2011-12-27 14:00:08 +0100 (Tue, 27 Dec 2011) | 2 lines
Changed paths:
   M /trunk/packages/unixutil/src/unixutils.pp

 * fix mantis #20973, return value in unixutils.

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@20021 -

.gitattributes

@@ -5567,6 +5567,8 @@ packages/ptc/Makefile.fpc svneol=native#text/plain
 packages/ptc/docs/AUTHORS.txt svneol=native#text/plain
 packages/ptc/docs/CHANGES.txt svneol=native#text/plain
 packages/ptc/docs/INSTALL.txt svneol=native#text/plain
+packages/ptc/docs/INTF-CHANGES-0.99.12.txt svneol=native#text/plain
+packages/ptc/docs/INTF-CHANGES-FAQ-0.99.12.txt svneol=native#text/plain
 packages/ptc/docs/INTRO.txt svneol=native#text/plain
 packages/ptc/docs/README.txt svneol=native#text/plain
 packages/ptc/docs/TODO.txt svneol=native#text/plain

packages/graph/src/ptcgraph/ptccrt.pp

@@ -110,56 +110,51 @@ end;
 
 procedure GetKeyEvents;
 var
-  ev: TPTCEvent;
-  KeyEv: TPTCKeyEvent;
+  ev: IPTCEvent;
+  KeyEv: IPTCKeyEvent;
 begin
-  ev := nil;
-  try
-    repeat
-      PTCWrapperObject.NextEvent(ev, False, [PTCKeyEvent]);
-      if ev <> nil then
+  repeat
+    PTCWrapperObject.NextEvent(ev, False, [PTCKeyEvent]);
+    if ev <> nil then
+    begin
+      KeyEv := ev as IPTCKeyEvent;
+      if KeyEv.Press then
       begin
-        KeyEv := TPTCKeyEvent(ev);
-        if KeyEv.Press then
-        begin
-          case KeyEv.Code of
-            PTCKEY_BACKSPACE:
-              if KeyEv.Control then
-                KeyBufAdd(#127)
-              else
-                KeyBufAdd(#8);
-            PTCKEY_ENTER:  KeyBufAdd(#13);
-            PTCKEY_ESCAPE: KeyBufAdd(#27);
-            PTCKEY_INSERT: KeyBufAdd(#0#82);
-            PTCKEY_DELETE: KeyBufAdd(#0#83);
-            PTCKEY_LEFT:   KeyBufAdd(#0#75);
-            PTCKEY_UP:     KeyBufAdd(#0#72);
-            PTCKEY_RIGHT:  KeyBufAdd(#0#77);
-            PTCKEY_DOWN:   KeyBufAdd(#0#80);
-            PTCKEY_HOME:     KeyBufAdd(#0#71);
-            PTCKEY_END:      KeyBufAdd(#0#79);
-            PTCKEY_PAGEUP:   KeyBufAdd(#0#73);
-            PTCKEY_PAGEDOWN: KeyBufAdd(#0#81);
-            PTCKEY_F1:     KeyBufAdd(#0#59);
-            PTCKEY_F2:     KeyBufAdd(#0#60);
-            PTCKEY_F3:     KeyBufAdd(#0#61);
-            PTCKEY_F4:     KeyBufAdd(#0#62);
-            PTCKEY_F5:     KeyBufAdd(#0#63);
-            PTCKEY_F6:     KeyBufAdd(#0#64);
-            PTCKEY_F7:     KeyBufAdd(#0#65);
-            PTCKEY_F8:     KeyBufAdd(#0#66);
-            PTCKEY_F9:     KeyBufAdd(#0#67);
-            PTCKEY_F10:    KeyBufAdd(#0#68);
+        case KeyEv.Code of
+          PTCKEY_BACKSPACE:
+            if KeyEv.Control then
+              KeyBufAdd(#127)
             else
-              if (KeyEv.Unicode >= 32) and (KeyEv.Unicode <= 127) then
-                KeyBufAdd(Chr(KeyEv.Unicode));
-          end;
+              KeyBufAdd(#8);
+          PTCKEY_ENTER:  KeyBufAdd(#13);
+          PTCKEY_ESCAPE: KeyBufAdd(#27);
+          PTCKEY_INSERT: KeyBufAdd(#0#82);
+          PTCKEY_DELETE: KeyBufAdd(#0#83);
+          PTCKEY_LEFT:   KeyBufAdd(#0#75);
+          PTCKEY_UP:     KeyBufAdd(#0#72);
+          PTCKEY_RIGHT:  KeyBufAdd(#0#77);
+          PTCKEY_DOWN:   KeyBufAdd(#0#80);
+          PTCKEY_HOME:     KeyBufAdd(#0#71);
+          PTCKEY_END:      KeyBufAdd(#0#79);
+          PTCKEY_PAGEUP:   KeyBufAdd(#0#73);
+          PTCKEY_PAGEDOWN: KeyBufAdd(#0#81);
+          PTCKEY_F1:     KeyBufAdd(#0#59);
+          PTCKEY_F2:     KeyBufAdd(#0#60);
+          PTCKEY_F3:     KeyBufAdd(#0#61);
+          PTCKEY_F4:     KeyBufAdd(#0#62);
+          PTCKEY_F5:     KeyBufAdd(#0#63);
+          PTCKEY_F6:     KeyBufAdd(#0#64);
+          PTCKEY_F7:     KeyBufAdd(#0#65);
+          PTCKEY_F8:     KeyBufAdd(#0#66);
+          PTCKEY_F9:     KeyBufAdd(#0#67);
+          PTCKEY_F10:    KeyBufAdd(#0#68);
+          else
+            if (KeyEv.Unicode >= 32) and (KeyEv.Unicode <= 127) then
+              KeyBufAdd(Chr(KeyEv.Unicode));
         end;
       end;
-    until ev = nil;
-  finally
-    ev.Free;
-  end;
+    end;
+  until ev = nil;
 end;
 
 function KeyPressed: Boolean;

packages/graph/src/ptcgraph/ptcgraph.pp

@@ -293,9 +293,9 @@ var
   ptcformat: TPTCFormat = nil;}
   PTCWidth: Integer;
   PTCHeight: Integer;
-  PTCFormat8: TPTCFormat;
-  PTCFormat15: TPTCFormat;
-  PTCFormat16: TPTCFormat;
+  PTCFormat8: IPTCFormat;
+  PTCFormat15: IPTCFormat;
+  PTCFormat16: IPTCFormat;
 
   EGAPaletteEnabled: Boolean;
   EGAPalette: TEGAPalette;
@@ -416,7 +416,7 @@ begin
 //  writeln('Initializing mode');
   { create format }
 {  FreeAndNil(PTCFormat);
-  PTCFormat:=TPTCFormat.Create(16,$f800,$07e0,$001f);}
+  PTCFormat:=TPTCFormatFactory.CreateNew(16,$f800,$07e0,$001f);}
   { open the console }
 {  ptcconsole.open(paramstr(0),ptcformat);}
   { create surface matching console dimensions }
@@ -640,7 +640,7 @@ begin
   CurrentCGABkColor := 0;
 end;
 
-procedure ptc_InternalOpen(const ATitle: string; AWidth, AHeight: Integer; AFormat: TPTCFormat; AVirtualPages: Integer);
+procedure ptc_InternalOpen(const ATitle: string; AWidth, AHeight: Integer; AFormat: IPTCFormat; AVirtualPages: Integer);
 var
   ConsoleWidth, ConsoleHeight: Integer;
 begin
@@ -1503,11 +1503,11 @@ end;
   { Returns nil if no graphics mode supported.        }
   { This list is READ ONLY!                           }
   var
-    PTCModeList: PPTCMode;
+    PTCModeList: TPTCModeList;
 
     function ModeListEmpty: Boolean;
     begin
-      ModeListEmpty := (PTCModeList = nil) or (not PTCModeList[0].Valid);
+      ModeListEmpty := Length(PTCModeList) = 0;
     end;
 
     function ContainsExactResolution(AWidth, AHeight: Integer): Boolean;
@@ -1520,9 +1520,7 @@ end;
         exit;
       end;
 
-      I := 0;
-      while (PTCModeList[I].Valid) do
-      begin
+      for I := Low(PTCModeList) to High(PTCModeList) do
         with PTCModeList[I] do
           if (Width = AWidth) and
              (Height = AHeight) then
@@ -1530,8 +1528,6 @@ end;
             ContainsExactResolution := True;
             exit;
           end;
-        Inc(I);
-      end;
       ContainsExactResolution := False;
     end;
 
@@ -1545,9 +1541,7 @@ end;
         exit;
       end;
 
-      I := 0;
-      while (PTCModeList[I].Valid) do
-      begin
+      for I := Low(PTCModeList) to High(PTCModeList) do
         with PTCModeList[I] do
           if (Width >= AWidth) and
              (Height >= AHeight) then
@@ -1555,8 +1549,6 @@ end;
             ContainsAtLeast := True;
             exit;
           end;
-        Inc(I);
-      end;
       ContainsAtLeast := False;
     end;
 
@@ -2828,16 +2820,13 @@ end;
   end;
 
 initialization
-  PTCFormat8 := TPTCFormat.Create(8);
-  PTCFormat15 := TPTCFormat.Create(16, $7C00, $03E0, $001F);
-  PTCFormat16 := TPTCFormat.Create(16, $F800, $07E0, $001F);
+  PTCFormat8 := TPTCFormatFactory.CreateNew(8);
+  PTCFormat15 := TPTCFormatFactory.CreateNew(16, $7C00, $03E0, $001F);
+  PTCFormat16 := TPTCFormatFactory.CreateNew(16, $F800, $07E0, $001F);
   PTCWrapperObject := TPTCWrapperThread.Create;
   InitializeGraph;
 finalization
   PTCWrapperObject.Terminate;
   PTCWrapperObject.WaitFor;
   PTCWrapperObject.Free;
-  PTCFormat16.Free;
-  PTCFormat15.Free;
-  PTCFormat8.Free;
 end.

packages/gtk2/src/atk/atk.pas

@@ -30,7 +30,7 @@ interface
 uses glib2;
 
 const
-{$ifdef win32}
+{$ifdef windows}
   {$define atkwin}
   atklib = 'libatk-1.0-0.dll';
   {$IFDEF FPC}

packages/gtk2/src/glib/gincludes.inc

@@ -66,7 +66,7 @@
 
 {$include gmarshal.inc}
 
-{$IFDEF win32}
+{$IFDEF winDOWS}
 {$include gwin32.inc}
 {$ENDIF}
 

packages/gtk2/src/glib/giochannel.inc

@@ -194,7 +194,7 @@ function g_io_channel_unix_get_fd(channel:PGIOChannel):gint;cdecl;external glibl
 { Hook for GClosure / GSource integration. Don't touch  }
 //GLIB_VAR GSourceFuncs g_io_watch_funcs;
 
-{$ifdef WIN32}
+{$ifdef WINDOWS}
 
 const
   G_WIN32_MSG_HANDLE = 19981206;

packages/gtk2/src/glib/glib2.pas

@@ -38,7 +38,7 @@ uses
   ctypes,SysUtils;
 
 const
-{$ifdef win32}
+{$ifdef windows}
   {$define gtkwin}
   gliblib    = 'libglib-2.0-0.dll';
   gthreadlib = 'libgthread-2.0-0.dll';

packages/gtk2/src/glib/glibconfig.inc

@@ -102,7 +102,7 @@ const
    GLIB_SYSDEF_POLLHUP   = 16;
    GLIB_SYSDEF_POLLNVAL  = 32;
 
-{$ifdef win32}
+{$ifdef windows}
    G_MODULE_SUFFIX  = 'dll';
 {$else}
    G_MODULE_SUFFIX  = 'so';

packages/gtk2/src/glib/gmain.inc

@@ -182,7 +182,7 @@ function g_idle_remove_by_data(data:gpointer):gboolean;cdecl;external gliblib na
 // GLIB_VAR GSourceFuncs g_timeout_funcs;
 // GLIB_VAR GSourceFuncs g_idle_funcs;
 
-{$ifdef win32}
+{$ifdef windows}
 procedure g_main_poll_win32_msg_add(priority:gint; fd:PGPollFD; hwnd:guint);cdecl;external gliblib name 'g_main_poll_win32_msg_add';
 {$endif}
 

packages/gtk2/src/glib/gmem.inc

@@ -52,7 +52,7 @@ function g_mem_is_system_malloc:gboolean; cdecl; external gliblib;
 {$IFNDEF KYLIX}
 { Memory profiler and checker, has to be enabled via g_mem_set_vtable() }
 var
-  {$IFDEF WIN32}
+  {$IFDEF WINDOWS}
   glib_mem_profiler_table : PGMemVTable; external gliblib name 'glib_mem_profiler_table';
   {$ELSE}
   glib_mem_profiler_table : PGMemVTable;cvar;external;

packages/gtk2/src/glib/gthread.inc

@@ -92,7 +92,7 @@ function G_THREAD_ERROR: TGQuark;
 
 {$IFNDEF KYLIX}
   var
-    {$IFDEF WIN32}
+    {$IFDEF WINDOWS}
     g_thread_functions_for_glib_use : TGThreadFunctions; external gliblib name 'g_thread_functions_for_glib_use';
     g_thread_use_default_impl       : gboolean; external gliblib name 'g_thread_use_default_impl';
     g_threads_got_initialized       : gboolean; external gliblib name 'g_threads_got_initialized';

packages/gtk2/src/glib/gutils.inc

@@ -11,7 +11,7 @@
 //------------------------------------------------------------------------------
 
 {$IFDEF read_interface_rest}
-{$ifdef WIN32}
+{$ifdef WINDOWS}
 
   { On native Win32, directory separator is the backslash, and search path
      separator is the semicolon.

packages/gtk2/src/gtk+/gdk-pixbuf/gdk2pixbuf.pas

@@ -36,7 +36,7 @@ interface
 uses glib2;
 
 const
-{$ifdef win32}
+{$ifdef windows}
   {$define gdkpixbufwin}
   gdkpixbuflib = 'libgdk_pixbuf-2.0-0.dll';
   {$IFDEF FPC}
@@ -77,7 +77,7 @@ const
 
 {$IFNDEF Kylix}
 var
-  {$IFDEF WIN32 }
+  {$IFDEF WINDOWS }
   gdk_pixbuf_major_version: guint; external gdkpixbuflib name 'gdk_pixbuf_major_version';
   gdk_pixbuf_minor_version: guint; external gdkpixbuflib name 'gdk_pixbuf_minor_version';
   gdk_pixbuf_micro_version: guint; external gdkpixbuflib name 'gdk_pixbuf_micro_version';

packages/gtk2/src/gtk+/gdk/gdk2.pas

@@ -33,7 +33,7 @@ uses glib2, gdk2pixbuf, pango, cairo;
 
 const
 // OS dependent defines
-{$ifdef win32}
+{$ifdef windows}
   {$DEFINE GDK_WINDOWING_WIN32}
   gdklib = 'libgdk-win32-2.0-0.dll';
   {$IFDEF FPC}
@@ -179,7 +179,7 @@ procedure gdk_event_send_clientmessage_toall(event:PGdkEvent); cdecl; external g
 {$IFNDEF KYLIX}
 { Threading }
 var
-  {$IFDEF WIN32}
+  {$IFDEF WINDOWS}
   gdk_threads_mutex : PGMutex; external gdklib name 'gdk_threads_mutex';
   {$ELSE}
   gdk_threads_mutex : PGMutex; cvar; external;

packages/gtk2/src/gtk+/gtk/gtk2.pas

@@ -72,7 +72,7 @@ uses
 
 const
 // OS dependent defines
-{$ifdef win32}
+{$ifdef windows}
   {$DEFINE GTK_WINDOWING_WIN32}
   gtklib = 'libgtk-win32-2.0-0.dll';
   {$IFDEF FPC}

packages/gtk2/src/gtk+/gtk/gtkbox.inc

@@ -11,7 +11,7 @@
         container : TGtkContainer;
         children : PGList;
         spacing : gint16;
-        flag0 : {$ifdef win32}longint{$else}word{$endif};
+        flag0 : {$ifdef windows}longint{$else}word{$endif};
      end;
 
    PGtkBoxClass = ^TGtkBoxClass;

packages/gtk2/src/gtk+/gtk/gtkmain.inc

@@ -37,7 +37,7 @@ const
 {$IFNDEF KYLIX}
 { Gtk version.  }
 var
-  {$IFDEF WIN32}
+  {$IFDEF WINDOWS}
    gtk_major_version : guint;external gtklib name 'gtk_major_version';
    gtk_minor_version : guint;external gtklib name 'gtk_minor_version';
    gtk_micro_version : guint;external gtklib name 'gtk_micro_version';

packages/gtk2/src/gtk+/gtk/gtkscrolledwindow.inc

@@ -12,7 +12,7 @@
         container : TGtkBin;
         hscrollbar : PGtkWidget;
         vscrollbar : PGtkWidget;
-        flag0 : {$ifdef win32}longint{$else}word{$endif};
+        flag0 : {$ifdef windows}longint{$else}word{$endif};
         shadow_type : guint16;
      end;
 

packages/gtk2/src/gtk+/gtk/gtktextlayout.inc

@@ -132,7 +132,7 @@
 {$IFDEF read_interface_rest}
 {$IFNDEF KYLIX}
 var
-  {$IFDEF WIN32}
+  {$IFDEF WINDOWS}
    gtk_text_attr_appearance_type : TPangoAttrType; external gtklib name 'gtk_text_attr_appearance_type';
   {$ELSE}
    gtk_text_attr_appearance_type : TPangoAttrType;cvar; external;

packages/gtk2/src/gtkglext/gdkglext.pas

@@ -31,7 +31,7 @@ uses Glib2, Gdk2;
 
 const
   GdkGLExtLib = 
-    {$ifdef WIN32} 'libgdkglext-win32-1.0-0.dll'
+    {$ifdef WINDOWS} 'libgdkglext-win32-1.0-0.dll'
     {$else}        
       {$ifdef DARWIN}
         'gdkglext-x11-1.0'

packages/gtk2/src/gtkglext/gtkglext.pas

@@ -31,7 +31,7 @@ uses Glib2, Gdk2, Gtk2, GdkGLExt;
 
 const
   GtkGLExtLib = 
-    {$ifdef WIN32} 'libgtkglext-win32-1.0-0.dll'
+    {$ifdef WINDOWS} 'libgtkglext-win32-1.0-0.dll'
     {$else}        
       {$ifdef DARWIN}
         'gtkglext-x11-1.0'

packages/gtk2/src/gtkhtml/gtkhtml.pas

@@ -39,7 +39,7 @@ uses
 const
 // OS dependent defines
 // !!!!! Maybe wrong for platforms other than linux !!!!!
-{$ifdef win32}
+{$ifdef windows}
   {$DEFINE GTK_WINDOWING_WIN32}
   gtkhtmllib = 'libgtkhtml-win32-2.0-0.dll';
   {$IFDEF FPC}

packages/gtk2/src/libglade/libglade2.pas

@@ -34,7 +34,7 @@ uses
   glib2, gtk2;
 
 const
-{$ifdef win32}
+{$ifdef windows}
   {$define gtkwin}
   LibGladeLib = 'libglade-2.0-0.dll';
   {$IFDEF FPC}

packages/gtk2/src/pango/pango.pas

@@ -36,7 +36,7 @@ uses glib2;
 {$DEFINE PANGO_ENABLE_BACKEND}
 
 const
-{$ifdef win32}
+{$ifdef windows}
   {$define pangowin}
   pangolib = 'libpango-1.0-0.dll';
   {$IFDEF FPC}

packages/gtk2/src/pangocairo/pangocairo.pas

@@ -33,7 +33,7 @@ interface
 uses glib2, pango, cairo;
 
 const
-{$ifdef win32}
+{$ifdef windows}
   {$define pangowin}
   pangocairolib = 'libpangocairo-1.0-0.dll';
   {$IFDEF FPC}

packages/lua/src/lua.pas

@@ -44,8 +44,8 @@ interface
 
 const
 {$IFDEF UNIX}
-  LUA_NAME = 'liblua5.1.so';
-  LUA_LIB_NAME = 'liblua5.1.so';
+  LUA_NAME = 'liblua.so.5.1';
+  LUA_LIB_NAME = 'liblua.so.5.1';
 {$ELSE}
   LUA_NAME = 'lua5.1.dll';
   LUA_LIB_NAME = 'lua5.1.dll';

packages/postgres/src/dllistdyn.pp

@@ -16,7 +16,7 @@ uses
 
 {$IFDEF Unix}
   const
-    pqlib = 'libpq.so';
+    pqlib = 'libpq.'+sharedsuffix;
 {$ENDIF}
 {$IFDEF Windows}
   const

packages/ptc/docs/CHANGES.txt

@@ -1,3 +1,13 @@
+0.99.12
+ - pressing Alt or F10 under Windows no longer pauses the application.
+ - API changes:
+    - PTC classes have been made descendants of TInterfacedObject and are now
+      accessed via interfaces. This simplifies memory management, because
+      objects are now reference counted and automatically freed when they are
+      no longer used. Unfortunately, this breaks existing code. However it's
+      relatively easy to fix. See the files INTF-CHANGES-0.99.12.txt and
+      INTF-CHANGES-FAQ-0.99.12.txt for details.
+
 0.99.11
  - added ptcgraph - an implementation of FPC's BGI-compatible graph unit on top
    of PTCPas. It should work on all platforms, supported by PTCPas,  except for

packages/ptc/docs/INSTALL.txt

@@ -1,13 +1,13 @@
 The supported platforms are Linux, FreeBSD, Windows, Windows Mobile and DOS.
 
 Generally you need the latest stable version of the Free Pascal Compiler, which
-currently means version 2.4.0. Generally FPC 2.2.4 should also work fine.
+currently means version 2.4.2. Generally FPC 2.2.4 should also work fine.
 
  - Compiling the library:
 Before starting make sure the FPCDIR environment variable is set correctly.
-For example: (windows, fpc version 2.4.0, default install dir)
+For example: (windows, fpc version 2.4.2, default install dir)
 
-  set FPCDIR=c:\fpc\2.4.0
+  set FPCDIR=c:\fpc\2.4.2
 
 To compile the library type:
 

packages/ptc/docs/INTF-CHANGES-0.99.12.txt

@@ -0,0 +1,29 @@
+This document describes the API changes introduced in version 0.99.12 of PTCPas
+
+Since version 0.99.12, most PTCPas classes have been made descendants of
+TInterfacedObject and are now only accessible via interfaces. The reason for
+this change is to provide automatic memory management via reference counting for
+the PTC core objects, so that they are freed automatically, once they're no
+longer in use, without causing any memory leaks.
+
+Unfortunately, this breaks existing code. However, it's relatively easy to fix
+it and the purpose of this document is to explain how. Here's a basic summary
+of the changes that need to be made:
+
+1) in your source code, replace "TPTCSomething.Create" with
+"TPTCSomethingFactory.CreateNew" (where 'Something' will correspond to one of
+those, depending on which objects are used in your program: Area, Color,
+Console, Event, Format, KeyEvent, Mode, MouseButtonEvent, MouseEvent, Palette,
+Surface and Timer)
+2) replace "TPTCSomething" with "IPTCSomething" (where 'Something' = an object
+from point #1)
+3) try compiling your code and you'll probably get some errors. Remove every
+call to .Free that fails with a compilation error, since it's no longer needed -
+PTC core objects are freed automatically when their reference count reaches
+zero.
+4) if you are using FreeAndNil, be extra careful! Since it accepts an untyped
+var parameter (bad design coming from Delphi), it will not cause a compilation
+error, if you are using it on an interface, but you will instead get a crash at
+runtime. Sadly, there's not much you can do, besides checking every call to
+FreeAndNil and replacing it with ":= nil" when you're using it on a PTC core
+object.

packages/ptc/docs/INTF-CHANGES-FAQ-0.99.12.txt

@@ -0,0 +1,77 @@
+Frequently Asked Questions about the changes, introduced in version 0.99.12 of
+PTCPas
+
+Q: My code uses only the ptcgraph and ptccrt (TP7 compatibility) units. Is it
+affected by the changes?
+A: No. Only code that uses the ptc unit is affected.
+
+Q: Were the changes necessary?
+A: Yes, I believe so. Using certain objects like events, areas, and formats was
+tedious because of the need to manually manage and free them. You had to be
+aware of their lifecycle, e.g. when getting an event from the console you had
+to free it once you were done with it, but, when getting the format of the
+console, you had to know that you must not free it and that you must not change
+it with .Assign (otherwise things would break in the console, etc.) With the new
+interfaces, suddenly you don't have to worry about all that. The original C++
+library OpenPTC was much easier to work with, thanks to C++'s automatic
+destructors, copy constructors and operator overloading. However, when PTC was
+ported to Pascal for the first time, FPC was still at version 1.0.x and didn't
+support interfaces, so it wasn't possible to do at the time. I was planning this
+change for a long time but I kept postponing it until now :)
+
+Q: Are you planning any more changes that break backward compatibility?
+A: No. I promise :)
+
+Q: Was it possible to introduce the changes, without breaking backward
+compatibility with existing code?
+A: Basically, it was hard to do without having to maintain a full set of wrapper
+classes with the old interface for compatibility and that is a lot of extra work
+I wouldn't like to do. I'd rather help people migrate their code to the new
+version. :)
+I documented the necessary changes, most of them can be done with just a series
+of search & replace and you can also email me your code if you have any
+trouble - I'll do my best to help.
+
+Q: How about keeping the old methods around and adding new overloaded ones?
+A: I considered doing that for a while, but I figured it wasn't an option,
+because it would make a huge mess out of PTCPas' interface. Also mixing
+reference counted interfaces and ordinary classes is dangerous and prone to
+errors (see next question for details). If you really cannot justify the effort
+needed to upgrade your code, old PTCPas versions are available on sourceforge
+forever. :)
+
+Q: Why were constructors replaced with factory methods?
+A: I wanted to hide the old classes completely and force the use of interfaces
+everywhere. One of the reason for this was that if I kept the old classes, in
+certain cases, that would make old code compile without errors, but crash at
+runtime. Here's an example:
+
+var
+  format: TPTCFormat;  // bug: this should be changed to IPTCFormat
+  ...
+begin
+  format := TPTCFormat.Create(8);  // object created, ref count = 0
+
+  surface := TPTCSurface.Create(320, 200, format);  // the reference count of
+  // 'format' is increased (i.e. becomes 1) before the constructor call and
+  // decreased afterwards back to 0 and then the object is freed.
+  // If format was declared of type IPTCFormat, it would keep the reference
+  // count one higher until the variable goes out of scope.
+
+  console := TPTCConsole.Create;
+  console.Open(320, 200, format);  // here we try to use format for the second
+  // time, but it has been freed and we get a crash at runtime :(
+  ...
+end.
+
+The problem occurs when mixing direct references to the object with access to it
+via interfaces. To prevent this type of error, I made the TPTCFormat type
+private (i.e. hidden in the implementation part of the ptc unit) and only
+IPTCFormat public. This way, when trying to compile this code, you'll get a
+compile error in the declaration of 'format: TPTCFormat;' and you'll know that
+you need to fix it (by changing the type to IPTCFormat). However, this has the
+side effect of making the call to TPTCFormat.Create impossible (because
+TPTCFormat isn't public). IPTCFormat.Create sounds like the logical alternative,
+but it's also not possible, as IPTCFormat is an interface and interfaces cannot
+have constructors. That's why I introduced factory class methods (in this case:
+TPTCFormatFactory.CreateNew)

packages/ptc/docs/INTRO.txt

@@ -1,40 +1,56 @@
-For more complete documentation please see the API reference found in the
+For more detailed documentation please see the API reference found in the
 'api-reference' directory (as well as online on the official PTCPas website).
 
 This will explain the basics of creating a simple graphics application using
 PTC for FPC. :)
 
-(If you aren't familiar with Delphi classes, please refer to the Free Pascal
-Reference guide, Chapter 5 - Classes.)
+(If you aren't familiar with Delphi classes and interfaces, please refer to the
+Free Pascal Reference guide, Chapter 6 - Classes and Chapter 7 - Interfaces.)
 
-There are 3 classes you should get familiar with: TPTCFormat, TPTCSurface and
-TPTCConsole.
+There are 3 interfaces you should get familiar with: IPTCFormat, IPTCSurface
+and IPTCConsole.
 
-Ok, what is TPTCFormat? It basically describes a pixel format. To create a
+Ok, what is IPTCFormat? It basically describes a pixel format. To create a
 pixel format for 32 bpp use:
-  Format := TPTCFormat.Create(32, $FF0000, $FF00, $FF);
+
+var
+  Format: IPTCFormat;
+begin
+  Format := TPTCFormatFactory.CreateNew(32, $FF0000, $FF00, $FF);
 
 32 is the number of bits per pixel. (Only formats with 8, 16, 24 and 32 bits
 per pixel are supported). $FF0000, $FF00 and $FF are the red, green and blue
 masks.
 
+Note that you no longer need to call Format.Free. The object is reference
+counted and will be freed automatically when it's no longer needed. This also
+applies to all the other PTC objects created by their TPTC*Factory.CreateNew
+methods.
+
 
 Now, when you have created your favourite pixel format, you should create a
 surface:
-  Surface := TPTCSurface.Create(320, 200, Format);
+var
+  Surface: IPTCSurface;
+begin
+  Surface := TPTCSurfaceFactory.CreateNew(320, 200, Format);
 
 This will create a buffer in RAM to hold a single 320x200 frame in the given
-format. Note that TPTCSurface is always created in normal RAM, not video RAM,
-so it's not a problem if your video card doesn't have enough memory for it,
-or doesn't support e.g. 320x200x32bpp. You just create a TPTCConsole and open
-it in whatever mode is supported by the hardware and then PTC will blit the
-image stored in TPTCSurface to the console, doing any conversions that are
-necessary (i.e. converting to another pixel format, stretching the image to
-another resolution, etc...).
-
-
-How to use this TPTCConsole? Easy! First create it:
-  Console := TPTCConsole.Create;
+format. Note that surfaces, created by TPTCSurfaceFactory.CreateNew are always
+created in normal RAM, not video RAM, so it's not a problem if your video card
+doesn't have enough memory for it, or doesn't support the exact resolution that
+you requested. You just create a IPTCConsole and open it in whatever mode is
+supported by the hardware and then PTC will blit the image stored in
+IPTCSurface to the console, doing any conversions that are necessary (i.e.
+converting to another pixel format, stretch the image to another resolution,
+etc...).
+
+
+How to use this IPTCConsole? Easy! First create it:
+var
+  Console: IPTCConsole;
+begin
+  Console := TPTCConsoleFactory.CreateNew;
 
 This still doesn't do anything, just allocates memory and initializes stuff.
 Then you switch to the desired mode:
@@ -46,9 +62,9 @@ to switch to the best mode. If (for example) your card doesn't support
 To see the actual mode that PTC has set use these properties:
   Console.Width Console.Height and Console.Format
 
-Ok, now that you have created a TPTCSurface and opened a TPTCConsole, what to
-do next? Draw stuff... The lock function of TPTCSurface will give you a pointer
-to the internal buffer.
+Ok, now that you have created an IPTCSurface and opened an IPTCConsole, what to
+do next? Draw stuff... The lock function of IPTCSurface will give you a pointer
+to its internal buffer.
   ptr := Surface.Lock;
 
 Now you can draw your frame in the buffer, pointed by ptr. Note that this buffer
@@ -61,10 +77,10 @@ When you're done you have to unlock the surface and copy it to the console:
 
 The Surface.Copy(Console) will do the conversion (if necessary) to the actual
 mode. Console.Update will actually show the new frame (if the console driver
-supports multiple pages and you have enough video RAM for that, etc... :) ).
+supports multiple video pages and you have enough video RAM for that, etc... :) ).
 
-See the example programs for additional details. (keyboard input, high
-resolution timers - they're pretty much straightforward)
+See the example programs for additional details. (keyboard and mouse input,
+high resolution timers - they're pretty much straightforward)
 
 Enjoy!
 

packages/ptc/docs/README.txt

@@ -1,4 +1,4 @@
-PTCPas 0.99.11
+PTCPas 0.99.12
 Nikolay Nikolov ([email protected])
 
 PTCPas is a free, portable framebuffer library, written in Free Pascal. It is
@@ -18,13 +18,13 @@ OpenPTC C++ library. Since then, OpenPTC development has stalled and PTCPas
 lives on as a fully independent Object Pascal project.
 
 Supported consoles:
-  DirectX 3+ (should work on all x86 Windows versions since Windows 95, except
-              Windows CE. This currently means 95/98/ME/NT4/2000/XP/2003/Vista.
-              It is compatible with the x64 editions of XP and 2003 (although
-              only as a 32-bit application, no native win64 yet). On NT4 you
-              need SP3 or later. Also some very ancient versions of Windows 95
-              do not have any DirectX preinstalled, so it has to be installed
-              separately.)
+  DirectX 3+ (should work on all x86 and x64 Windows versions since Windows 95,
+              except Windows CE. This currently means 95/98/ME/NT4/2000/XP/2003/
+              Vista/2008/7. It is compatible with the x64 editions of XP, 2003,
+              Vista, 2008 and 7 (both as a 32-bit application and native win64).
+              On NT4 you need SP3 or later. Ancient versions of Windows 95 come
+              without any DirectX version by default, so you may have to install
+              it.)
   Win32 GDI (no fullscreen support. Slower than DirectX, but maybe more
              compatible.)
   X11 (on linux and other unix-like OSes, supports XRandR, XF86VidMode, XShm

packages/ptc/examples/area.pp

@@ -16,33 +16,33 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  format: TPTCFormat = nil;
-  surface: TPTCSurface = nil;
+  console: IPTCConsole;
+  format: IPTCFormat;
+  surface: IPTCSurface;
   pixels: PDWord;
   width, height: Integer;
   i: Integer;
   x, y, r, g, b: Integer;
-  area: TPTCArea = nil;
+  area: IPTCArea;
 begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { create console }
       console.open('Area example', format);
 
       { create surface half the size of the console }
-      surface := TPTCSurface.Create(console.width div 2, console.height div 2, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width div 2, console.height div 2, format);
 
       { setup destination area }
       x := console.width div 4;
       y := console.height div 4;
-      area := TPTCArea.Create(x, y, x + surface.width, y + surface.height);
+      area := TPTCAreaFactory.CreateNew(x, y, x + surface.width, y + surface.height);
 
       { loop until a key is pressed }
       while not console.KeyPressed do
@@ -81,11 +81,8 @@ begin
         console.update;
       end;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      format.Free;
-      area.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/buffer.pp

@@ -16,9 +16,8 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  format: TPTCFormat = nil;
-  palette: TPTCPalette = nil;
+  console: IPTCConsole;
+  format: IPTCFormat;
   width, height: Integer;
   pixels: PUint32 = nil;
   x, y, r, g, b: Integer;
@@ -27,22 +26,21 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { open the console }
-      console.open('Buffer example', format);
+      console.Open('Buffer example', format);
 
       { get console dimensions }
-      width := console.width;
-      height := console.height;
+      width := console.Width;
+      height := console.Height;
 
       { allocate a buffer of pixels }
       pixels := GetMem(width * height * SizeOf(Uint32));
       FillChar(pixels^, width * height * SizeOf(Uint32), 0);
-      palette := TPTCPalette.Create;
 
       { loop until a key is pressed }
       while not console.KeyPressed do
@@ -64,18 +62,16 @@ begin
         end;
 
         { load pixels to console }
-        console.load(pixels, width, height, width * 4, format, palette);
+        console.Load(pixels, width, height, width * 4, format, TPTCPaletteFactory.CreateNew);
 
         { update console }
-        console.update;
+        console.Update;
       end;
     finally
       { free pixels buffer }
       FreeMem(pixels);
-      console.close;
-      palette.Free;
-      format.Free;
-      console.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/clear.pp

@@ -16,27 +16,27 @@ uses
   SysUtils, ptc;
 
 var
-  console: TPTCConsole = nil;
-  format: TPTCFormat = nil;
-  surface: TPTCSurface = nil;
+  console: IPTCConsole;
+  format: IPTCFormat;
+  surface: IPTCSurface;
   width, height: Integer;
   x, y: Integer;
   size: Integer;
-  area: TPTCArea = nil;
-  color: TPTCColor = nil;
+  area: IPTCArea;
+  color: IPTCColor;
 begin
   try
     { create console }
-    console := TPTCConsole.Create;
+    console := TPTCConsoleFactory.CreateNew;
 
     { create format }
-    format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+    format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
     { open the console }
     console.open('Clear example', format);
 
     { create surface matching console dimensions }
-    surface := TPTCSurface.Create(console.width, console.height, format);
+    surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
     { loop until a key is pressed }
     while not console.KeyPressed do
@@ -52,30 +52,23 @@ begin
       { get random area size }
       size := Random(width div 8);
 
-      try
-        { setup clear area }
-        area := TPTCArea.Create(x-size, y-size, x+size, y+size);
+      { setup clear area }
+      area := TPTCAreaFactory.CreateNew(x-size, y-size, x+size, y+size);
 
-        { create random color }
-        color := TPTCColor.Create(Random, Random, Random);
+      { create random color }
+      color := TPTCColorFactory.CreateNew(Random, Random, Random);
 
-        { clear surface area with color }
-        surface.clear(color, area);
+      { clear surface area with color }
+      surface.clear(color, area);
 
-        { copy to console }
-        surface.copy(console);
+      { copy to console }
+      surface.copy(console);
 
-        { update console }
-        console.update;
-      finally
-        FreeAndNil(area);
-        FreeAndNil(color);
-      end;
+      { update console }
+      console.update;
     end;
-    console.close;
-    console.Free;
-    surface.Free;
-    format.Free;
+    if Assigned(console) then
+      console.close;
   except
     on error: TPTCError do
       { report error }

packages/ptc/examples/clip.pp

@@ -16,10 +16,9 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
-  area: TPTCArea;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
   x1, y1, x2, y2: Integer;
   pixels: PUint32;
   width, height: Integer;
@@ -29,16 +28,16 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { open the console }
       console.open('Clip example', format);
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { calculate clip coordinates }
       x1 := console.width div 4;
@@ -46,14 +45,8 @@ begin
       x2 := console.width - x1;
       y2 := console.height - y1;
 
-      { setup clip area }
-      area := TPTCArea.Create(x1, y1, x2, y2);
-      try
-        { set clip area }
-        console.clip(area);
-      finally
-        area.Free;
-      end;
+      { set clip area }
+      console.clip(TPTCAreaFactory.CreateNew(x1, y1, x2, y2));
 
       { loop until a key is pressed }
       while not console.KeyPressed do
@@ -92,10 +85,8 @@ begin
         console.update;
       end;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/con_info.pp

@@ -15,7 +15,7 @@ program InfoExample;
 uses
   ptc;
 
-procedure print(const format: TPTCFormat);
+procedure print(format: IPTCFormat);
 begin
   { check format type }
   if format.direct then
@@ -32,7 +32,7 @@ begin
 end;
 
 var
-  console: TPTCConsole = nil;
+  console: IPTCConsole;
 begin
   try
     try
@@ -42,7 +42,7 @@ begin
       Writeln;
 
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { open the console }
       console.open('Info example');
@@ -64,8 +64,8 @@ begin
       Writeln('[console information]');
       Writeln(console.information);
     finally
-      console.close;
-      console.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/console.pp

@@ -16,13 +16,13 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  palette: TPTCPalette = nil;
+  console: IPTCConsole;
+  palette: IPTCPalette;
   data: array [0..255] of DWord;
   i: Integer;
   pixels: PByte;
   width, height, pitch: Integer;
-  format: TPTCFormat;
+  format: IPTCFormat;
   bits, bytes: Integer;
   x, y: Integer;
   color: DWord;
@@ -32,29 +32,29 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { open the console with one page }
       console.open('Console example', 1);
 
       { create palette }
-      palette := TPTCPalette.Create;
+      palette := TPTCPaletteFactory.CreateNew;
 
       { generate palette }
       for i := 0 to 255 do
         data[i] := i;
 
       { load palette data }
-      palette.load(data);
+      palette.Load(data);
 
       { set console palette }
-      console.palette(palette);
+      console.Palette(palette);
 
       { loop until a key is pressed }
       while not console.KeyPressed do
       begin
         { lock console }
-        pixels := console.lock;
+        pixels := console.Lock;
 
         try
           { get console dimensions }
@@ -104,16 +104,15 @@ begin
           end;
         finally
           { unlock console }
-          console.unlock;
+          console.Unlock;
         end;
 
         { update console }
-        console.update;
+        console.Update;
       end;
     finally
-      palette.Free;
-      console.close;
-      console.Free;
+      if Assigned(console) then
+        console.Close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/fire.pp

@@ -21,13 +21,13 @@ begin
   pack := (r shl 16) or (g shl 8) or b;
 end;
 
-procedure generate(palette: TPTCPalette);
+procedure generate(palette: IPTCPalette);
 var
   data: PUint32;
   i, c: Integer;
 begin
   { lock palette data }
-  data := palette.lock;
+  data := palette.Lock;
 
   try
     { black to red }
@@ -67,15 +67,15 @@ begin
 
   finally
     { unlock palette }
-    palette.unlock;
+    palette.Unlock;
   end;
 end;
 
 var
-  format: TPTCFormat = nil;
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  palette: TPTCPalette = nil;
+  format: IPTCFormat;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  palette: IPTCPalette;
   state: Integer;
   intensity: Single;
   pixels, pixel, p: PUint8;
@@ -84,24 +84,24 @@ var
   top, bottom, c1, c2: Uint32;
   generator: PUint8;
   color: Integer;
-  area: TPTCArea = nil;
+  area: IPTCArea;
 begin
   try
     try
       { create format }
-      format := TPTCFormat.Create(8);
+      format := TPTCFormatFactory.CreateNew(8);
 
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { open console }
       console.open('Fire demo', 320, 200, format);
 
       { create surface }
-      surface := TPTCSurface.Create(320, 208, format);
+      surface := TPTCSurfaceFactory.CreateNew(320, 208, format);
 
       { create palette }
-      palette := TPTCPalette.Create;
+      palette := TPTCPaletteFactory.CreateNew;
 
       { generate palette }
       generate(palette);
@@ -117,7 +117,7 @@ begin
       intensity := 0;
 
       { setup copy area }
-      area := TPTCArea.Create(0, 0, 320, 200);
+      area := TPTCAreaFactory.CreateNew(0, 0, 320, 200);
 
       { main loop }
       repeat
@@ -242,11 +242,8 @@ begin
       until False;
 
     finally
-      console.Free;
-      surface.Free;
-      format.Free;
-      palette.Free;
-      area.Free;
+      if Assigned(console) then
+        console.Close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/flower.pp

@@ -21,7 +21,7 @@ begin
   pack := (r shl 16) or (g shl 8) or b;
 end;
 
-procedure generate_flower(flower: TPTCSurface);
+procedure generate_flower(flower: IPTCSurface);
 var
   data: PUint8;
   x, y, fx, fy, fx2, fy2: Integer;
@@ -56,13 +56,13 @@ begin
   end;
 end;
 
-procedure generate(palette: TPTCPalette);
+procedure generate(palette: IPTCPalette);
 var
   data: PUint32;
   i, c: Integer;
 begin
   { lock palette data }
-  data := palette.lock;
+  data := palette.Lock;
 
   try
     { black to yellow }
@@ -103,17 +103,17 @@ begin
     end;
   finally
     { unlock palette }
-    palette.unlock;
+    palette.Unlock;
   end;
 end;
 
 var
-  console: TPTCConsole = nil;
-  format: TPTCFormat = nil;
-  flower_surface: TPTCSurface = nil;
-  surface: TPTCSurface = nil;
-  palette: TPTCPalette = nil;
-  area: TPTCArea = nil;
+  console: IPTCConsole;
+  format: IPTCFormat;
+  flower_surface: IPTCSurface;
+  surface: IPTCSurface;
+  palette: IPTCPalette;
+  area: IPTCArea;
   time, delta: Single;
   scr, map: PUint8;
   width, height, mapWidth: Integer;
@@ -124,13 +124,13 @@ begin
   try
     try
       { create format }
-      format := TPTCFormat.Create(8);
+      format := TPTCFormatFactory.CreateNew(8);
 
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create flower surface }
-      flower_surface := TPTCSurface.Create(640, 400, format);
+      flower_surface := TPTCSurfaceFactory.CreateNew(640, 400, format);
 
       { generate flower }
       generate_flower(flower_surface);
@@ -139,10 +139,10 @@ begin
       console.open('Flower demo', 320, 200, format);
 
       { create surface }
-      surface := TPTCSurface.Create(320, 200, format);
+      surface := TPTCSurfaceFactory.CreateNew(320, 200, format);
 
       { create palette }
-      palette := TPTCPalette.Create;
+      palette := TPTCPaletteFactory.CreateNew;
 
       { generate palette }
       generate(palette);
@@ -154,7 +154,7 @@ begin
       surface.palette(palette);
 
       { setup copy area }
-      area := TPTCArea.Create(0, 0, 320, 200);
+      area := TPTCAreaFactory.CreateNew(0, 0, 320, 200);
 
       { time data }
       time := 0;
@@ -213,12 +213,6 @@ begin
     finally
       if Assigned(console) then
         console.close;
-      area.Free;
-      format.Free;
-      palette.Free;
-      surface.Free;
-      flower_surface.Free;
-      console.Free;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/hicolor.pp

@@ -16,9 +16,9 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
   pixels: PUint16;
   width, height: Integer;
   i: Integer;
@@ -27,16 +27,16 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(16, $F800, $07E0, $001F);
+      format := TPTCFormatFactory.CreateNew(16, $F800, $07E0, $001F);
 
       { open the console }
       console.open('HiColor example', format);
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { loop until a key is pressed }
       while not console.KeyPressed do
@@ -77,10 +77,8 @@ begin
         console.update;
       end;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/image.pp

@@ -15,14 +15,13 @@ program ImageExample;
 uses
   SysUtils, ptc;
 
-procedure load(surface: TPTCSurface; filename: String);
+procedure load(surface: IPTCSurface; filename: String);
 var
   F: File;
   width, height: Integer;
   pixels: PByte = nil;
   y: Integer;
-  img_format: TPTCFormat = nil;
-  img_palette: TPTCPalette = nil;
+  img_format: IPTCFormat;
 begin
   { open image file }
   AssignFile(F, filename);
@@ -45,36 +44,32 @@ begin
 
     { load pixels to surface }
     {$IFDEF FPC_LITTLE_ENDIAN}
-    img_format := TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF);
+    img_format := TPTCFormatFactory.CreateNew(24, $00FF0000, $0000FF00, $000000FF);
     {$ELSE FPC_LITTLE_ENDIAN}
-    img_format := TPTCFormat.Create(24, $000000FF, $0000FF00, $00FF0000);
+    img_format := TPTCFormatFactory.CreateNew(24, $000000FF, $0000FF00, $00FF0000);
     {$ENDIF FPC_LITTLE_ENDIAN}
-    img_palette := TPTCPalette.Create;
-    surface.load(pixels, width, height, width * 3, img_format, img_palette);
+    surface.Load(pixels, width, height, width * 3, img_format, TPTCPaletteFactory.CreateNew);
 
   finally
     CloseFile(F);
 
     { free image pixels }
     FreeMem(pixels);
-
-    img_palette.Free;
-    img_format.Free;
   end;
 end;
 
 var
-  console: TPTCConsole = nil;
-  format: TPTCFormat = nil;
-  surface: TPTCSurface = nil;
+  console: IPTCConsole;
+  format: IPTCFormat;
+  surface: IPTCSurface;
 begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       try
         { try to open the console matching the image resolution }
@@ -86,7 +81,7 @@ begin
       end;
 
       { create surface }
-      surface := TPTCSurface.Create(320, 200, format);
+      surface := TPTCSurfaceFactory.CreateNew(320, 200, format);
 
       { load image to surface }
       load(surface, 'image.tga');
@@ -102,11 +97,8 @@ begin
 
     finally
       { close console }
-      console.close;
-
-      console.Free;
-      surface.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/keyboard.pp

@@ -16,38 +16,34 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
-  color: TPTCColor = nil;
-  key: TPTCKeyEvent = nil;
-  area: TPTCArea;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
+  color: IPTCColor;
+  key: IPTCKeyEvent;
   x, y: Integer;
   size: Integer;
   delta: Integer;
 begin
   try
     try
-      { create key }
-      key := TPTCKeyEvent.Create;
-
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { open the console }
       console.open('Keyboard example', format);
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { setup cursor data }
       x := surface.width div 2;
       y := surface.height div 2;
       size := surface.width div 10;
-      color := TPTCColor.Create(1, 1, 1);
+      color := TPTCColorFactory.CreateNew(1, 1, 1);
 
       { main loop }
       repeat
@@ -79,14 +75,8 @@ begin
         { clear surface }
         surface.clear;
 
-        { setup cursor area }
-        area := TPTCArea.Create(x - size, y - size, x + size, y + size);
-        try
-          { draw cursor as a quad }
-          surface.clear(color, area);
-        finally
-          area.Free;
-        end;
+        { draw cursor as a quad }
+        surface.clear(color, TPTCAreaFactory.CreateNew(x - size, y - size, x + size, y + size));
 
         { copy to console }
         surface.copy(console);
@@ -95,12 +85,8 @@ begin
         console.update;
       until False;
     finally
-      color.Free;
-      console.close;
-      console.Free;
-      surface.Free;
-      key.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/keyboard2.pp

@@ -11,13 +11,12 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
-  color: TPTCColor = nil;
-  timer: TPTCTimer = nil;
-  key: TPTCKeyEvent = nil;
-  area: TPTCArea;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
+  color: IPTCColor;
+  timer: IPTCTimer;
+  key: IPTCKeyEvent;
   x, y, delta: Real;
   left, right, up, down: Boolean;
   size: Integer;
@@ -29,32 +28,29 @@ begin
   down := False;
   try
     try
-      { create key }
-      key := TPTCKeyEvent.Create;
-
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { enable key release events }
       console.KeyReleaseEnabled := True;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { open the console }
       console.open('Keyboard example 2', format);
 
       { create timer }
-      timer := TPTCTimer.Create;
+      timer := TPTCTimerFactory.CreateNew;
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { setup cursor data }
       x := surface.width div 2;
       y := surface.height div 2;
       size := surface.width div 10;
-      color := TPTCColor.Create(1, 1, 1);
+      color := TPTCColorFactory.CreateNew(1, 1, 1);
 
       { start timer }
       timer.start;
@@ -92,14 +88,8 @@ begin
         { clear surface }
         surface.clear;
 
-        { setup cursor area }
-        area := TPTCArea.Create(Trunc(x) - size, Trunc(y) - size, Trunc(x) + size, Trunc(y) + size);
-        try
-          { draw cursor as a quad }
-          surface.clear(color, area);
-        finally
-          area.Free;
-        end;
+        { draw cursor as a quad }
+        surface.clear(color, TPTCAreaFactory.CreateNew(Trunc(x) - size, Trunc(y) - size, Trunc(x) + size, Trunc(y) + size));
 
         { copy to console }
         surface.copy(console);
@@ -108,13 +98,8 @@ begin
         console.update;
       until Done;
     finally
-      color.Free;
-      console.close;
-      console.Free;
-      surface.Free;
-      key.Free;
-      timer.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/land.pp

@@ -270,11 +270,11 @@ begin
 end;
 
 var
-  format: TPTCFormat = nil;
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  timer: TPTCTimer = nil;
-  key: TPTCKeyEvent = nil;
+  format: IPTCFormat;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  timer: IPTCTimer;
+  key: IPTCKeyEvent;
   pixels: PUint32;
   Done: Boolean;
 
@@ -286,11 +286,10 @@ begin
   Done := False;
   try
     try
-      key := TPTCKeyEvent.Create;
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
-      console := TPTCConsole.Create;
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
+      console := TPTCConsoleFactory.CreateNew;
       console.open('Land demo', SCREENWIDTH, SCREENHEIGHT, format);
-      surface := TPTCSurface.Create(SCREENWIDTH, SCREENHEIGHT, format);
+      surface := TPTCSurfaceFactory.CreateNew(SCREENWIDTH, SCREENHEIGHT, format);
 
       { Compute the height map }
       ComputeMap;
@@ -309,7 +308,7 @@ begin
       scale := 20;
 
       { create timer }
-      timer := TPTCTimer.Create;
+      timer := TPTCTimerFactory.CreateNew;
 
       { start timer }
       timer.start;
@@ -372,12 +371,8 @@ begin
         Inc(y0, Trunc(CurrentSpeed * SinT[index]) div 256);
       until Done;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      timer.Free;
-      format.Free;
-      key.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/lights.pp

@@ -28,10 +28,10 @@ begin
 end;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
-  palette: TPTCPalette = nil;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
+  palette: IPTCPalette;
   dx, dy: Integer;
   divisor: Single;
   data: PUint32;
@@ -54,15 +54,15 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
-      format := TPTCFormat.Create(8);
+      format := TPTCFormatFactory.CreateNew(8);
 
       { open console }
       console.open('Lights demo', 320, 200, format);
 
       { create surface }
-      surface := TPTCSurface.Create(320, 200, format);
+      surface := TPTCSurfaceFactory.CreateNew(320, 200, format);
 
       { setup intensity table }
       for dy := 0 to 199 do
@@ -75,15 +75,15 @@ begin
         end;
 
       { create palette }
-      palette := TPTCPalette.Create;
+      palette := TPTCPaletteFactory.CreateNew;
 
       { generate greyscale palette }
-      data := palette.lock;
+      data := palette.Lock;
       try
         for i := 0 to 255 do
           data[i] := (i shl 16) or (i shl 8) or i;
       finally
-        palette.unlock;
+        palette.Unlock;
       end;
 
       { set console palette }
@@ -271,11 +271,8 @@ begin
         console.update;
       end;
     finally
-      console.close;
-      surface.Free;
-      console.Free;
-      palette.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/modes.pp

@@ -15,7 +15,7 @@ program ModesExample;
 uses
   ptc;
 
-procedure print(const format: TPTCFormat);
+procedure print(format: IPTCFormat);
 begin
   { check format type }
   if format.direct then
@@ -31,7 +31,7 @@ begin
     Write('Format(', format.bits:2, ')');
 end;
 
-procedure print(const mode: TPTCMode);
+procedure print(mode: IPTCMode);
 begin
   { print mode width and height }
   Write(' ', mode.width:4, ' x ', mode.height);
@@ -51,42 +51,32 @@ begin
 end;
 
 var
-  console: TPTCConsole = nil;
-  modes: PPTCMode;
+  console: IPTCConsole;
+  modes: TPTCModeList;
   index: Integer;
 begin
   try
-    try
-      { create console }
-      console := TPTCConsole.Create;
+    { create console }
+    console := TPTCConsoleFactory.CreateNew;
 
-      { get list of console modes }
-      modes := console.modes;
+    { get list of console modes }
+    modes := console.modes;
 
-      { check for empty list }
-      if not modes[0].valid then
-        { the console mode list was empty }
-        Writeln('[console mode list is not available]')
-      else
-      begin
-        { print mode list header }
-        Writeln('[console modes]');
-
-        { mode index }
-        index := 0;
-
-        { iterate through all modes }
-        while modes[index].valid do
-        begin
-          { print mode }
-          print(modes[index]);
+    { check for empty list }
+    if Length(modes) = 0 then
+      { the console mode list was empty }
+      Writeln('[console mode list is not available]')
+    else
+    begin
+      { print mode list header }
+      Writeln('[console modes]');
 
-          { next mode }
-          Inc(index);
-        end;
+      { iterate through all modes }
+      for index := Low(modes) to High(modes) do
+      begin
+        { print mode }
+        print(modes[index]);
       end;
-    finally
-      console.Free;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/mojo.pp

@@ -520,7 +520,7 @@ begin
   frandtab_seed := (frandtab_seed + 1) and $FFFF;
 end;
 
-procedure VLightPart(console: TPTCConsole; surface: TPTCSurface);
+procedure VLightPart(console: IPTCConsole; surface: IPTCSurface);
 var
   vl: VLight = nil;
   vl2: VLight = nil;
@@ -705,33 +705,31 @@ begin
 end;
 
 var
-  format: TPTCFormat = nil;
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
+  format: IPTCFormat;
+  console: IPTCConsole;
+  surface: IPTCSurface;
 begin
   try
     try
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { open console }
       console.open('mojo by statix', 320, 200, format);
 
       { create main drawing surface }
-      surface := TPTCSurface.Create(320, 200, format);
+      surface := TPTCSurfaceFactory.CreateNew(320, 200, format);
 
       { do the light effect }
       VLightPart(console, surface);
 
     finally
       { close console }
-      console.close;
-      console.Free;
-      surface.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
 
     { print message to stdout }

packages/ptc/examples/mouse.pp

@@ -8,13 +8,13 @@ program MouseExample;
 {$MODE objfpc}
 
 uses
-  ptc;
+  ptc, SysUtils;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
-  event: TPTCEvent = nil;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
+  event: IPTCEvent;
   pixels: PUint32;
   color: Uint32;
   width, height: Integer;
@@ -26,10 +26,10 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $FF0000, $FF00, $FF);
+      format := TPTCFormatFactory.CreateNew(32, $FF0000, $FF00, $FF);
 
       { open the console }
       console.open('Mouse example', format);
@@ -38,7 +38,7 @@ begin
       console.option('hide cursor');
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { initialization }
       X := 0;
@@ -49,20 +49,20 @@ begin
         console.NextEvent(event, True, PTCAnyEvent);
 
         { handle mouse events }
-        if event is TPTCMouseEvent then
+        if Supports(event, IPTCMouseEvent) then
         begin
           { if there's more than one mouse event, process them all... }
           repeat
-            X := (event as TPTCMouseEvent).X;
-            Y := (event as TPTCMouseEvent).Y;
-            button := PTCMouseButton1 in (event as TPTCMouseEvent).ButtonState;
+            X := (event as IPTCMouseEvent).X;
+            Y := (event as IPTCMouseEvent).Y;
+            button := PTCMouseButton1 in (event as IPTCMouseEvent).ButtonState;
           until not console.NextEvent(event, False, [PTCMouseEvent]);
         end;
 
         { handle keyboard events }
-        if (event is TPTCKeyEvent) and (event as TPTCKeyEvent).Press then
+        if Supports(event, IPTCKeyEvent) and (event as IPTCKeyEvent).Press then
         begin
-          case (event as TPTCKeyEvent).Code of
+          case (event as IPTCKeyEvent).Code of
             PTCKEY_G: console.Option('grab mouse');
             PTCKEY_U: console.Option('ungrab mouse');
             PTCKEY_ESCAPE: Done := True;
@@ -114,11 +114,8 @@ begin
 
       until Done;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      format.Free;
-      event.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/palette.pp

@@ -16,10 +16,10 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
-  palette: TPTCPalette = nil;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
+  palette: IPTCPalette;
   data: array [0..255] of Uint32;
   pixels: PUint8;
   width, height: Integer;
@@ -29,32 +29,32 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(8);
+      format := TPTCFormatFactory.CreateNew(8);
 
       { open console }
       console.open('Palette example', format);
 
       { create surface }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { create palette }
-      palette := TPTCPalette.Create;
+      palette := TPTCPaletteFactory.CreateNew;
 
       { generate palette }
       for i := 0 to 255 do
         data[i] := i;
 
       { load palette data }
-      palette.load(data);
+      palette.Load(data);
 
       { set console palette }
-      console.palette(palette);
+      console.Palette(palette);
 
       { set surface palette }
-      surface.palette(palette);
+      surface.Palette(palette);
 
       { loop until a key is pressed }
       while not console.KeyPressed do
@@ -92,11 +92,8 @@ begin
         console.update;
       end;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      palette.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/pixel.pp

@@ -15,7 +15,7 @@ program PixelExample;
 uses
   ptc;
 
-procedure putpixel(surface: TPTCSurface; x, y: Integer; r, g, b: Uint8);
+procedure putpixel(surface: IPTCSurface; x, y: Integer; r, g, b: Uint8);
 var
   pixels: PUint32;
   color: Uint32;
@@ -35,23 +35,23 @@ begin
 end;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
 begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { open the console }
       console.open('Pixel example', format);
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { plot a white pixel in the middle of the surface }
       putpixel(surface, surface.width div 2, surface.height div 2, 255, 255, 255);
@@ -65,10 +65,8 @@ begin
       { read key }
       console.ReadKey;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/random.pp

@@ -16,9 +16,9 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
   pixels: PUint32;
   width, height: Integer;
   i: Integer;
@@ -27,16 +27,16 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { open the console }
       console.open('Random example', format);
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { loop until a key is pressed }
       while not console.KeyPressed do
@@ -75,10 +75,8 @@ begin
         console.update;
       end;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/save.pp

@@ -15,15 +15,14 @@ program SaveExample;
 uses
   ptc, Math;
 
-procedure save(surface: TPTCSurface; filename: string);
+procedure save(surface: IPTCSurface; filename: string);
 var
   F: File;
   width, height: Integer;
   size: Integer;
   y: Integer;
   pixels: PUint8 = nil;
-  format: TPTCFormat = nil;
-  palette: TPTCPalette = nil;
+  format: IPTCFormat;
   { generate the header for a true color targa image }
   header: array [0..17] of Uint8 =
     (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
@@ -58,14 +57,13 @@ begin
     pixels := GetMem(size);
 
     {$IFDEF FPC_LITTLE_ENDIAN}
-    format := TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF);
+    format := TPTCFormatFactory.CreateNew(24, $00FF0000, $0000FF00, $000000FF);
     {$ELSE FPC_LITTLE_ENDIAN}
-    format := TPTCFormat.Create(24, $000000FF, $0000FF00, $00FF0000);
+    format := TPTCFormatFactory.CreateNew(24, $000000FF, $0000FF00, $00FF0000);
     {$ENDIF FPC_LITTLE_ENDIAN}
-    palette := TPTCPalette.Create;
 
     { save surface to image pixels }
-    surface.save(pixels, width, height, width * 3, format, palette);
+    surface.save(pixels, width, height, width * 3, format, TPTCPaletteFactory.CreateNew);
 
     { write image pixels one line at a time }
     for y := height - 1 DownTo 0 do
@@ -75,9 +73,6 @@ begin
     { free image pixels }
     FreeMem(pixels);
 
-    palette.Free;
-    format.Free;
-
     CloseFile(F);
   end;
 end;
@@ -128,7 +123,7 @@ begin
   calculate := 0;
 end;
 
-procedure mandelbrot(console: TPTCConsole; surface: TPTCSurface;
+procedure mandelbrot(console: IPTCConsole; surface: IPTCSurface;
                      x1, y1, x2, y2: Single);
 const
   { constant values }
@@ -149,7 +144,7 @@ var
   count: Integer;
   index: Integer;
   color: Uint32;
-  area: TPTCArea;
+  area: IPTCArea;
 begin
   { generate fractal color table }
   for i := 0 to entries - 1 do
@@ -219,13 +214,10 @@ begin
       imaginary := imaginary + dy;
 
       { setup line area }
-      area := TPTCArea.Create(0, y, width, y + 1);
-      try
-        { copy surface area to console }
-        surface.copy(console, area, area);
-      finally
-        area.Free;
-      end;
+      area := TPTCAreaFactory.CreateNew(0, y, width, y + 1);
+
+      { copy surface area to console }
+      surface.copy(console, area, area);
 
       { update console area }
       console.update;
@@ -237,24 +229,24 @@ begin
 end;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
   x1, y1, x2, y2: Single;
 begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { open the console with a single page }
       console.open('Save example', format, 1);
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { setup viewing area }
       x1 := -2.00;
@@ -271,10 +263,8 @@ begin
       { read key }
       console.ReadKey;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/stretch.pp

@@ -15,14 +15,13 @@ program StretchExample;
 uses
   ptc;
 
-procedure load(surface: TPTCSurface; filename: String);
+procedure load(surface: IPTCSurface; filename: string);
 var
   F: File;
   width, height: Integer;
   pixels: PByte = nil;
   y: Integer;
-  tmp: TPTCFormat;
-  tmp2: TPTCPalette;
+  format: IPTCFormat;
 begin
   { open image file }
   AssignFile(F, filename);
@@ -45,20 +44,11 @@ begin
 
     { load pixels to surface }
     {$IFDEF FPC_LITTLE_ENDIAN}
-    tmp := TPTCFormat.Create(24, $00FF0000, $0000FF00, $000000FF);
+    format := TPTCFormatFactory.CreateNew(24, $00FF0000, $0000FF00, $000000FF);
     {$ELSE FPC_LITTLE_ENDIAN}
-    tmp := TPTCFormat.Create(24, $000000FF, $0000FF00, $00FF0000);
+    format := TPTCFormatFactory.CreateNew(24, $000000FF, $0000FF00, $00FF0000);
     {$ENDIF FPC_LITTLE_ENDIAN}
-    try
-      tmp2 := TPTCPalette.Create;
-      try
-        surface.load(pixels, width, height, width * 3, tmp, tmp2);
-      finally
-        tmp2.Free;
-      end;
-    finally
-      tmp.Free;
-    end;
+    surface.Load(pixels, width, height, width * 3, format, TPTCPaletteFactory.CreateNew);
   finally
     { free image pixels }
     FreeMem(pixels);
@@ -69,13 +59,12 @@ begin
 end;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  image: TPTCSurface = nil;
-  format: TPTCFormat = nil;
-  timer: TPTCTimer = nil;
-  area: TPTCArea = nil;
-  color: TPTCColor = nil;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  image: IPTCSurface;
+  format: IPTCFormat;
+  timer: IPTCTimer;
+  area: IPTCArea;
   time: Double;
   zoom: Single;
   x, y, x1, y1, x2, y2, dx, dy: Integer;
@@ -83,19 +72,19 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { open the console }
       console.open('Stretch example', format);
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { create image surface }
-      image := TPTCSurface.Create(320, 140, format);
+      image := TPTCSurfaceFactory.CreateNew(320, 140, format);
 
       { load image to surface }
       load(image, 'stretch.tga');
@@ -107,11 +96,10 @@ begin
       dy := surface.height div 3;
 
       { create timer }
-      timer := TPTCTimer.Create;
+      timer := TPTCTimerFactory.CreateNew;
 
       { start timer }
       timer.start;
-      color := TPTCColor.Create(1, 1, 1);
 
       { loop until a key is pressed }
       while not console.KeyPressed do
@@ -120,7 +108,7 @@ begin
         time := timer.time;
 
         { clear surface to white background }
-        surface.clear(color);
+        surface.clear(TPTCColorFactory.CreateNew(1, 1, 1));
 
         { calculate zoom factor at current time }
         zoom := 2.5 * (1 - cos(time));
@@ -132,28 +120,20 @@ begin
         y2 := Trunc(y + zoom * dy);
 
         { setup image copy area }
-        area := TPTCArea.Create(x1, y1, x2, y2);
-        try
-          { copy and stretch image to surface }
-          image.copy(surface, image.area, area);
-
-          { copy surface to console }
-          surface.copy(console);
-
-          { update console }
-          console.update;
-        finally
-          area.Free;
-        end;
+        area := TPTCAreaFactory.CreateNew(x1, y1, x2, y2);
+
+        { copy and stretch image to surface }
+        image.copy(surface, image.area, area);
+
+        { copy surface to console }
+        surface.copy(console);
+
+        { update console }
+        console.update;
       end;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      format.Free;
-      image.Free;
-      color.Free;
-      timer.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/texwarp.pp

@@ -22,7 +22,7 @@ const
   green_balance: Uint32 = 3;
   blue_balance: Uint32 = 1;
 
-procedure blur(s: TPTCSurface);
+procedure blur(s: IPTCSurface);
 var
   d: PUint8;
   pitch: Integer;
@@ -60,7 +60,7 @@ begin
   end;
 end;
 
-procedure generate(surface: TPTCSurface);
+procedure generate(surface: IPTCSurface);
 var
   dest: PUint32;
   i: Integer;
@@ -256,10 +256,10 @@ begin
 end;
 
 var
-  format: TPTCFormat = nil;
-  texture: TPTCSurface = nil;
-  surface: TPTCSurface = nil;
-  console: TPTCConsole = nil;
+  format: IPTCFormat;
+  texture: IPTCSurface;
+  surface: IPTCSurface;
+  console: IPTCConsole;
   lighttable: PUint8 = nil;
   { texture grid }
   grid: array [0..41*26*3-1] of Uint32;
@@ -270,10 +270,10 @@ begin
   try
     try
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { create texture surface }
-      texture := TPTCSurface.Create(256, 256, format);
+      texture := TPTCSurfaceFactory.CreateNew(256, 256, format);
 
       { create texture }
       generate(texture);
@@ -283,13 +283,13 @@ begin
       make_light_table(lighttable);
 
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { open console }
       console.open('Warp demo', 320, 200, format);
 
       { create drawing surface }
-      surface := TPTCSurface.Create(320, 200, format);
+      surface := TPTCSurfaceFactory.CreateNew(320, 200, format);
 
       { control values }
       xbase := 0;
@@ -365,11 +365,8 @@ begin
         end;
       end;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
-      texture.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
       FreeMem(lighttable);
     end;
   except

packages/ptc/examples/timer.pp

@@ -16,10 +16,10 @@ uses
   ptc;
 
 var
-  console: TPTCConsole = nil;
-  format: TPTCFormat = nil;
-  surface: TPTCSurface = nil;
-  timer: TPTCTimer = nil;
+  console: IPTCConsole;
+  format: IPTCFormat;
+  surface: IPTCSurface;
+  timer: IPTCTimer;
   time, t: Double;
   pixels: PDWord;
   width, height: Integer;
@@ -29,19 +29,19 @@ begin
   try
     try
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { open the console }
       console.open('Timer example', format);
 
       { create surface matching console dimensions }
-      surface := TPTCSurface.Create(console.width, console.height, format);
+      surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
 
       { create timer }
-      timer := TPTCTimer.Create;
+      timer := TPTCTimerFactory.CreateNew;
 
       { start timer }
       timer.start;
@@ -97,11 +97,8 @@ begin
         console.update;
       end;
     finally
-      timer.Free;
-      surface.Free;
-      console.close;
-      console.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/tunnel.pp

@@ -117,9 +117,9 @@ begin
 end;
 
 var
-  format: TPTCFormat = nil;
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
+  format: IPTCFormat;
+  console: IPTCConsole;
+  surface: IPTCSurface;
   TheTunnel: TTunnel = nil;
   time, delta: Single;
   buffer: PUint32;
@@ -127,16 +127,16 @@ begin
   try
     try
       { create format }
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
       { create console }
-      console := TPTCConsole.Create;
+      console := TPTCConsoleFactory.CreateNew;
 
       { open console }
       console.open('Tunnel demo', 320, 200, format);
 
       { create surface }
-      surface := TPTCSurface.Create(320, 200, format);
+      surface := TPTCSurfaceFactory.CreateNew(320, 200, format);
 
       { create tunnel }
       TheTunnel := TTunnel.Create;
@@ -169,10 +169,8 @@ begin
       end;
     finally
       TheTunnel.Free;
-      surface.Free;
-      console.close;
-      console.Free;
-      format.Free;
+      if Assigned(console) then
+        console.close;
     end;
   except
     on error: TPTCError do

packages/ptc/examples/tunnel3d.pp

@@ -343,7 +343,7 @@ begin
 
         { Calculate texture index at intersection point (cylindrical mapping) }
         { try and adjust the 0.2 to stretch/shrink the texture }
-        u_array[(j shl 6) + i] := Trunc(intsc[2] * 0.2) shl 16;
+        u_array[(j shl 6) + i] := Integer(Trunc(intsc[2] * 0.2) shl 16);
         v_array[(j shl 6) + i] := Trunc(abs(arctan2(intsc[1], intsc[0]) * 256 / pi)) shl 16;
 
         { Calculate the dotproduct between the normal vector and the vector }
@@ -396,23 +396,23 @@ begin
 
       { Set up gradients }
       lu := u_array[iadr]; ru := u_array[iadr + 1];
-      liu := (u_array[iadr + 64] - lu) shr 3;
-      riu := (u_array[iadr + 65] - ru) shr 3;
+      liu := (u_array[iadr + 64] - lu) div 8;
+      riu := (u_array[iadr + 65] - ru) div 8;
 
       lv := v_array[iadr]; rv := v_array[iadr + 1];
-      liv := (v_array[iadr + 64] - lv) shr 3;
-      riv := (v_array[iadr + 65] - rv) shr 3;
+      liv := (v_array[iadr + 64] - lv) div 8;
+      riv := (v_array[iadr + 65] - rv) div 8;
 
       ll := l_array[iadr]; rl := l_array[iadr + 1];
-      lil := (l_array[iadr + 64] - ll) shr 3;
-      ril := (l_array[iadr + 65] - rl) shr 3;
+      lil := (l_array[iadr + 64] - ll) div 8;
+      ril := (l_array[iadr + 65] - rl) div 8;
 
       for y := 0 to 7 do
       begin
-        iu := (ru - lu) shr 3;
-        iv := (rv - lv) shr 3;
+        iu := (ru - lu) div 8;
+        iv := (rv - lv) div 8;
         l := ll;
-        il := (rl - ll) shr 3;
+        il := (rl - ll) div 8;
 
         { Mess up everything for the sake of cache optimised mapping :) }
         til_u := DWord(((lu shl 8) and $F8000000) or ((lu shr 1) and $00007FFF) or (lu and $00070000));
@@ -426,8 +426,8 @@ begin
         for x := 0 to 7 do
         begin
           { Interpolate texture u,v and light }
-          Inc(til_u, til_iu);
-          Inc(til_v, til_iv);
+          til_u := DWord(til_u + til_iu);
+          til_v := DWord(til_v + til_iv);
           Inc(l, il);
 
           adr := adr shr 16;
@@ -502,9 +502,9 @@ begin
 end;
 
 var
-  console: TPTCConsole = nil;
-  surface: TPTCSurface = nil;
-  format: TPTCFormat = nil;
+  console: IPTCConsole;
+  surface: IPTCSurface;
+  format: IPTCFormat;
   tunnel: TRayTunnel = nil;
   posz, phase_x, phase_y: Single;
   angle_x, angle_y: Integer;
@@ -512,12 +512,12 @@ var
 begin
   try
     try
-      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
+      format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
 
-      console := TPTCConsole.create;
+      console := TPTCConsoleFactory.CreateNew;
       console.open('Tunnel3D demo', 320, 200, format);
 
-      surface := TPTCSurface.create(320, 200, format);
+      surface := TPTCSurfaceFactory.CreateNew(320, 200, format);
 
       { Create a tunnel, radius=700 }
       tunnel := TRayTunnel.Create(700);
@@ -554,11 +554,9 @@ begin
         phase_y := phase_y + 0.1;
       end;
     finally
-      console.close;
-      console.Free;
-      surface.Free;
+      if Assigned(console) then
+        console.close;
       tunnel.Free;
-      format.Free;
     end;
   except
     on error: TPTCError do

packages/ptc/src/core/aread.inc

@@ -31,21 +31,27 @@
 }
 
 type
-  TPTCArea = class
-  private
-    FLeft, FTop, FRight, FBottom: Integer;
+  IPTCArea = interface
+    function GetLeft: Integer;
+    function GetTop: Integer;
+    function GetRight: Integer;
+    function GetBottom: Integer;
     function GetWidth: Integer;
     function GetHeight: Integer;
-  public
-    constructor Create;
-    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;
+
+    function Equals(AArea: IPTCArea): Boolean;
+
+    property Left: Integer read GetLeft;
+    property Top: Integer read GetTop;
+    property Right: Integer read GetRight;
+    property Bottom: Integer read GetBottom;
     property Width: Integer read GetWidth;
     property Height: Integer read GetHeight;
   end;
+
+  TPTCAreaFactory = class
+  public
+    class function CreateNew: IPTCArea;
+    class function CreateNew(ALeft, ATop, ARight, ABottom: Integer): IPTCArea;
+    class function CreateNew(AArea: IPTCArea): IPTCArea;
+  end;

packages/ptc/src/core/areai.inc

@@ -30,6 +30,38 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+type
+  TPTCArea = class(TInterfacedObject, IPTCArea)
+  private
+    FLeft, FTop, FRight, FBottom: Integer;
+    function GetLeft: Integer;
+    function GetTop: Integer;
+    function GetRight: Integer;
+    function GetBottom: Integer;
+    function GetWidth: Integer;
+    function GetHeight: Integer;
+    function Equals(AArea: IPTCArea): Boolean;
+  public
+    constructor Create;
+    constructor Create(ALeft, ATop, ARight, ABottom: Integer);
+    constructor Create(AArea: IPTCArea);
+  end;
+
+class function TPTCAreaFactory.CreateNew: IPTCArea;
+begin
+  Result := TPTCArea.Create;
+end;
+
+class function TPTCAreaFactory.CreateNew(ALeft, ATop, ARight, ABottom: Integer): IPTCArea;
+begin
+  Result := TPTCArea.Create(ALeft, ATop, ARight, ABottom);
+end;
+
+class function TPTCAreaFactory.CreateNew(AArea: IPTCArea): IPTCArea;
+begin
+  Result := TPTCArea.Create(AArea);
+end;
+
 constructor TPTCArea.Create(ALeft, ATop, ARight, ABottom: Integer);
 begin
   if ALeft < ARight then
@@ -62,28 +94,40 @@ begin
   FBottom := 0;
 end;
 
-constructor TPTCArea.Create(const AArea: TPTCArea);
+constructor TPTCArea.Create(AArea: IPTCArea);
+begin
+  FLeft   := AArea.Left;
+  FTop    := AArea.Top;
+  FRight  := AArea.Right;
+  FBottom := AArea.Bottom;
+end;
+
+function TPTCArea.Equals(AArea: IPTCArea): Boolean;
+begin
+  Result := (FLeft   = AArea.Left) and
+            (FTop    = AArea.Top) and
+            (FRight  = AArea.Right) and
+            (FBottom = AArea.Bottom);
+end;
+
+function TPTCArea.GetLeft: Integer;
+begin
+  Result := FLeft;
+end;
+
+function TPTCArea.GetTop: Integer;
 begin
-  FLeft   := AArea.FLeft;
-  FTop    := AArea.FTop;
-  FRight  := AArea.FRight;
-  FBottom := AArea.FBottom;
+  Result := FTop;
 end;
 
-procedure TPTCArea.Assign(const AArea: TPTCArea);
+function TPTCArea.GetRight: Integer;
 begin
-  FLeft   := AArea.FLeft;
-  FTop    := AArea.FTop;
-  FRight  := AArea.FRight;
-  FBottom := AArea.FBottom;
+  Result := FRight;
 end;
 
-function TPTCArea.Equals(const AArea: TPTCArea): Boolean;
+function TPTCArea.GetBottom: Integer;
 begin
-  Result := (FLeft   = AArea.FLeft) and
-            (FTop    = AArea.FTop) and
-            (FRight  = AArea.FRight) and
-            (FBottom = AArea.FBottom);
+  Result := FBottom;
 end;
 
 function TPTCArea.GetWidth: Integer;

packages/ptc/src/core/baseconsoled.inc

@@ -31,43 +31,43 @@
 }
 
 type
-  TPTCBaseConsole = class(TPTCBaseSurface)
-  private
-    FReleaseEnabled: Boolean;
-    function GetPages: Integer; virtual; abstract;
-    function GetName: string; virtual; abstract;
-    function GetTitle: string; virtual; abstract;
-    function GetInformation: string; virtual; abstract;
-  public
-    constructor Create; virtual;
-    procedure Configure(const AFileName: String); virtual; abstract;
-    function Modes: PPTCMode; virtual; abstract;
-    procedure Open(const ATitle: string; APages: Integer = 0); overload; virtual; abstract;
-    procedure Open(const ATitle: string; const AFormat: TPTCFormat;
-                   APages: Integer = 0); overload; virtual; abstract;
+  IPTCConsole = interface(IPTCSurface)
+    function GetPages: Integer;
+    function GetName: string;
+    function GetTitle: string;
+    function GetInformation: string;
+
+    procedure Configure(const AFileName: string);
+    function Modes: TPTCModeList;
+    procedure Open(const ATitle: string; APages: Integer = 0); overload;
+    procedure Open(const ATitle: string; AFormat: IPTCFormat;
+                   APages: Integer = 0); overload;
     procedure Open(const ATitle: string; AWidth, AHeight: Integer;
-                   const AFormat: TPTCFormat; APages: Integer = 0); overload; virtual; abstract;
-    procedure Open(const ATitle: string; const AMode: TPTCMode;
-                   APages: Integer = 0); overload; virtual; abstract;
-    procedure Close; virtual; abstract;
-    procedure Flush; virtual; abstract;
-    procedure Finish; virtual; abstract;
-    procedure Update; virtual; abstract;
-    procedure Update(const AArea: TPTCArea); virtual; abstract;
+                   AFormat: IPTCFormat; APages: Integer = 0); overload;
+    procedure Open(const ATitle: string; AMode: IPTCMode;
+                   APages: Integer = 0); overload;
+    procedure Close;
+    procedure Flush;
+    procedure Finish;
+    procedure Update;
+    procedure Update(AArea: IPTCArea);
 
     { event handling }
-    function NextEvent(var AEvent: TPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; virtual; abstract;
-    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): TPTCEvent; virtual; abstract;
+    function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
+    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
 
     { key handling }
     function KeyPressed: Boolean;
-    function PeekKey(var AKey: TPTCKeyEvent): Boolean;
-    procedure ReadKey(var AKey: TPTCKeyEvent);
+    function PeekKey(out AKey: IPTCKeyEvent): Boolean;
+    procedure ReadKey(out AKey: IPTCKeyEvent);
     procedure ReadKey;
-    property KeyReleaseEnabled: Boolean read FReleaseEnabled write FReleaseEnabled;
+    procedure SetKeyReleaseEnabled(AValue: Boolean);
+    function GetKeyReleaseEnabled: Boolean;
+    property KeyReleaseEnabled: Boolean read GetKeyReleaseEnabled write SetKeyReleaseEnabled;
 
     property Pages: Integer read GetPages;
     property Name: string read GetName;
     property Title: string read GetTitle;
     property Information: string read GetInformation;
   end;
+

packages/ptc/src/core/baseconsolei.inc

@@ -30,6 +30,98 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+type
+  TPTCBaseConsole = class(TInterfacedObject, IPTCConsole, IPTCSurface)
+  private
+    FReleaseEnabled: Boolean;
+
+    procedure SetKeyReleaseEnabled(AValue: Boolean);
+    function GetKeyReleaseEnabled: Boolean;
+
+    function GetWidth: Integer; virtual; abstract;
+    function GetHeight: Integer; virtual; abstract;
+    function GetPitch: Integer; virtual; abstract;
+    function GetArea: IPTCArea; virtual; abstract;
+    function GetFormat: IPTCFormat; virtual; abstract;
+
+    function GetPages: Integer; virtual; abstract;
+    function GetName: string; virtual; abstract;
+    function GetTitle: string; virtual; abstract;
+    function GetInformation: string; virtual; abstract;
+  public
+    constructor Create; virtual;
+
+    procedure Copy(ASurface: IPTCSurface); virtual; abstract;
+    procedure Copy(ASurface: IPTCSurface;
+                   ASource, ADestination: IPTCArea); virtual; abstract;
+    function Lock: Pointer; virtual; abstract;
+    procedure Unlock; virtual; abstract;
+    procedure Load(const APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette); virtual; abstract;
+    procedure Load(const APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea); virtual; abstract;
+    procedure Save(APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette); virtual; abstract;
+    procedure Save(APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea); virtual; abstract;
+    procedure Clear; virtual; abstract;
+    procedure Clear(AColor: IPTCColor); virtual; abstract;
+    procedure Clear(AColor: IPTCColor;
+                    AArea: IPTCArea); virtual; abstract;
+    procedure Palette(APalette: IPTCPalette); virtual; abstract;
+    procedure Clip(AArea: IPTCArea); virtual; abstract;
+    function Option(const AOption: String): Boolean; virtual; abstract;
+    function Clip: IPTCArea; virtual; abstract;
+    function Palette: IPTCPalette; virtual; abstract;
+
+    procedure Configure(const AFileName: String); virtual; abstract;
+    function Modes: TPTCModeList; virtual; abstract;
+    procedure Open(const ATitle: string; APages: Integer = 0); overload; virtual; abstract;
+    procedure Open(const ATitle: string; AFormat: IPTCFormat;
+                   APages: Integer = 0); overload; virtual; abstract;
+    procedure Open(const ATitle: string; AWidth, AHeight: Integer;
+                   AFormat: IPTCFormat; APages: Integer = 0); overload; virtual; abstract;
+    procedure Open(const ATitle: string; AMode: IPTCMode;
+                   APages: Integer = 0); overload; virtual; abstract;
+    procedure Close; virtual; abstract;
+    procedure Flush; virtual; abstract;
+    procedure Finish; virtual; abstract;
+    procedure Update; virtual; abstract;
+    procedure Update(AArea: IPTCArea); virtual; abstract;
+
+    { event handling }
+    function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; virtual; abstract;
+    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; virtual; abstract;
+
+    { key handling }
+    function KeyPressed: Boolean;
+    function PeekKey(out AKey: IPTCKeyEvent): Boolean;
+    procedure ReadKey(out AKey: IPTCKeyEvent);
+    procedure ReadKey;
+    property KeyReleaseEnabled: Boolean read GetKeyReleaseEnabled write SetKeyReleaseEnabled;
+
+    property Pages: Integer read GetPages;
+    property Name: string read GetName;
+    property Title: string read GetTitle;
+    property Information: string read GetInformation;
+
+    property Width: Integer read GetWidth;
+    property Height: Integer read GetHeight;
+    property Pitch: Integer read GetPitch;
+    property Area: IPTCArea read GetArea;
+    property Format: IPTCFormat read GetFormat;
+  end;
+
 constructor TPTCBaseConsole.Create;
 begin
   FReleaseEnabled := False;
@@ -37,38 +129,29 @@ end;
 
 function TPTCBaseConsole.KeyPressed: Boolean;
 var
-  k, kpeek: TPTCEvent;
+  k, kpeek: IPTCEvent;
 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;
+  repeat
+    kpeek := PeekEvent(False, [PTCKeyEvent]);
+    if kpeek = nil then
+      exit(False);
+    if FReleaseEnabled or (kpeek as IPTCKeyEvent).Press then
+      exit(True);
+    NextEvent(k, False, [PTCKeyEvent]);
+  until False;
 end;
 
-procedure TPTCBaseConsole.ReadKey(var AKey: TPTCKeyEvent);
+procedure TPTCBaseConsole.ReadKey(out AKey: IPTCKeyEvent);
 var
-  ev: TPTCEvent;
+  ev: IPTCEvent;
 begin
-  ev := AKey;
-  try
-    repeat
-      NextEvent(ev, True, [PTCKeyEvent]);
-    until FReleaseEnabled or (ev As TPTCKeyEvent).Press;
-  finally
-    AKey := ev As TPTCKeyEvent;
-  end;
+  repeat
+    NextEvent(ev, True, [PTCKeyEvent]);
+  until FReleaseEnabled or (ev as IPTCKeyEvent).Press;
+  AKey := ev as IPTCKeyEvent;
 end;
 
-function TPTCBaseConsole.PeekKey(var AKey: TPTCKeyEvent): Boolean;
+function TPTCBaseConsole.PeekKey(out AKey: IPTCKeyEvent): Boolean;
 begin
   if KeyPressed then
   begin
@@ -81,12 +164,17 @@ end;
 
 procedure TPTCBaseConsole.ReadKey;
 var
-  k: TPTCKeyEvent;
+  k: IPTCKeyEvent;
 begin
-  k := TPTCKeyEvent.Create;
-  try
-    ReadKey(k);
-  finally
-    k.Free;
-  end;
+  ReadKey(k);
+end;
+
+procedure TPTCBaseConsole.SetKeyReleaseEnabled(AValue: Boolean);
+begin
+  FReleaseEnabled := AValue;
+end;
+
+function TPTCBaseConsole.GetKeyReleaseEnabled: Boolean;
+begin
+  Result := FReleaseEnabled;
 end;

packages/ptc/src/core/basesurfaced.inc

@@ -31,49 +31,48 @@
 }
 
 type
-  TPTCBaseSurface = class
-  private
-    function GetWidth: Integer; virtual; abstract;
-    function GetHeight: Integer; virtual; abstract;
-    function GetPitch: Integer; virtual; abstract;
-    function GetArea: TPTCArea; virtual; abstract;
-    function GetFormat: TPTCFormat; virtual; abstract;
-  public
-    procedure Copy(ASurface: TPTCBaseSurface); virtual; abstract;
-    procedure Copy(ASurface: TPTCBaseSurface;
-                   const ASource, ADestination: TPTCArea); virtual; abstract;
-    function Lock: Pointer; virtual; abstract;
-    procedure Unlock; virtual; abstract;
+  IPTCSurface = interface
+    function GetWidth: Integer;
+    function GetHeight: Integer;
+    function GetPitch: Integer;
+    function GetArea: IPTCArea;
+    function GetFormat: IPTCFormat;
+
+    procedure Copy(ASurface: IPTCSurface);
+    procedure Copy(ASurface: IPTCSurface;
+                   ASource, ADestination: IPTCArea);
+    function Lock: Pointer;
+    procedure Unlock;
     procedure Load(const APixels: Pointer;
                    AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette); virtual; abstract;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette);
     procedure Load(const APixels: Pointer;
                    AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette;
-                   const ASource, ADestination: TPTCArea); virtual; abstract;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea);
     procedure Save(APixels: Pointer;
                    AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette); virtual; abstract;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette);
     procedure Save(APixels: Pointer;
                    AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette;
-                   const ASource, ADestination: TPTCArea); virtual; abstract;
-    procedure Clear; virtual; abstract;
-    procedure Clear(const AColor: TPTCColor); virtual; abstract;
-    procedure Clear(const AColor: TPTCColor;
-                    const AArea: TPTCArea); virtual; abstract;
-    procedure Palette(const APalette: TPTCPalette); virtual; abstract;
-    procedure Clip(const AArea: TPTCArea); virtual; abstract;
-    function Option(const AOption: String): Boolean; virtual; abstract;
-    function Clip: TPTCArea; virtual; abstract;
-    function Palette: TPTCPalette; virtual; abstract;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea);
+    procedure Clear;
+    procedure Clear(AColor: IPTCColor);
+    procedure Clear(AColor: IPTCColor;
+                    AArea: IPTCArea);
+    procedure Palette(APalette: IPTCPalette);
+    procedure Clip(AArea: IPTCArea);
+    function Option(const AOption: String): Boolean;
+    function Clip: IPTCArea;
+    function Palette: IPTCPalette;
     property Width: Integer read GetWidth;
     property Height: Integer read GetHeight;
     property Pitch: Integer read GetPitch;
-    property Area: TPTCArea read GetArea;
-    property Format: TPTCFormat read GetFormat;
+    property Area: IPTCArea read GetArea;
+    property Format: IPTCFormat read GetFormat;
   end;

packages/ptc/src/core/cleard.inc

@@ -34,12 +34,12 @@ type
   TPTCClear = class
   private
     FHandle: THermesClearerHandle;
-    FFormat: TPTCFormat;
+    FFormat: IPTCFormat;
   public
     constructor Create;
     destructor Destroy; override;
-    procedure Request(const AFormat: TPTCFormat);
+    procedure Request(AFormat: IPTCFormat);
     procedure Clear(APixels: Pointer;
                     AX, AY, AWidth, AHeight, APitch: Integer;
-                    const AColor: TPTCColor);
+                    AColor: IPTCColor);
   end;

packages/ptc/src/core/cleari.inc

@@ -32,7 +32,6 @@
 
 constructor TPTCClear.Create;
 begin
-  FFormat := nil;
   { initialize hermes }
   if not Hermes_Init then
     raise TPTCError.Create('could not initialize hermes');
@@ -50,7 +49,6 @@ destructor TPTCClear.Destroy;
 begin
   { return the clearer instance }
   Hermes_ClearerReturn(FHandle);
-  FFormat.Free;
 
   { free hermes }
   Hermes_Done;
@@ -58,20 +56,20 @@ begin
   inherited Destroy;
 end;
 
-procedure TPTCClear.Request(const AFormat: TPTCFormat);
+procedure TPTCClear.Request(AFormat: IPTCFormat);
 var
   hermes_format: PHermesFormat;
 begin
-  hermes_format := @AFormat.FFormat;
+  hermes_format := AFormat.GetHermesFormat;
   { request surface clear for this format }
   if not Hermes_ClearerRequest(FHandle, hermes_format) then
     raise TPTCError.Create('unsupported clear format');
 
   { update current format }
-  FFormat.Assign(AFormat);
+  FFormat := AFormat;
 end;
 
-procedure TPTCClear.Clear(APixels: Pointer; AX, AY, AWidth, AHeight, APitch: Integer; const AColor: TPTCColor);
+procedure TPTCClear.Clear(APixels: Pointer; AX, AY, AWidth, AHeight, APitch: Integer; AColor: IPTCColor);
 var
   r, g, b, a: LongInt;
   index: LongInt;

packages/ptc/src/core/clipperd.inc

@@ -34,9 +34,10 @@ type
   TPTCClipper = class
   public
     { clip a single area against clip area }
-    class function Clip(const AArea, AClip: TPTCArea): TPTCArea;
+    class function Clip(AArea, AClip: IPTCArea): IPTCArea;
     { clip source and destination areas against source and destination clip areas }
-    class procedure Clip(const ASource, AClipSource, AClippedSource,
-                         ADestination, AClipDestination,
-                         AClippedDestination: TPTCArea);
+    class procedure Clip(ASource, AClipSource: IPTCArea;
+                         out AClippedSource: IPTCArea;
+                         ADestination, AClipDestination: IPTCArea;
+                         out AClippedDestination: IPTCArea);
   end;

packages/ptc/src/core/clipperi.inc

@@ -32,7 +32,7 @@
 
 {$INLINE ON}
 
-class function TPTCClipper.Clip(const AArea, AClip: TPTCArea): TPTCArea;
+class function TPTCClipper.Clip(AArea, AClip: IPTCArea): IPTCArea;
 var
   left, top, right, bottom: Integer;
   clip_left, clip_top, clip_right, clip_bottom: Integer;
@@ -103,7 +103,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: IPTCArea); Inline;
 var
   clip_left, clip_top, clip_right, clip_bottom: Real;
 begin
@@ -125,11 +125,11 @@ begin
   bottom := Round(bottom);
 end;
 
-class procedure TPTCClipper.Clip(const ASource, AClipSource, AClippedSource,
-                                 ADestination, AClipDestination,
-                                 AClippedDestination: TPTCArea);
+class procedure TPTCClipper.Clip(ASource, AClipSource: IPTCArea;
+                                 out AClippedSource: IPTCArea;
+                                 ADestination, AClipDestination: IPTCArea;
+                                 out AClippedDestination: IPTCArea);
 var
-  tmp1, tmp2: TPTCArea;
   source_left, source_top, source_right, source_bottom: Real;
   clipped_source_left, clipped_source_top, clipped_source_right,
   clipped_source_bottom: Real;
@@ -148,120 +148,109 @@ var
   adjusted_source_left, adjusted_source_top, adjusted_source_right,
   adjusted_source_bottom: Real;
 begin
-  tmp1 := nil;
-  tmp2 := nil;
-  try
-    { expand source area to floating point }
-    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, 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);
-      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 := ADestination.Width / ASource.Width;
-    source_to_destination_y := ADestination.Height / ASource.Height;
-
-    { expand destination area to floating point }
-    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, AClipDestination);
-
-    { check for early destination area clipping exit }
-    if (clipped_destination_left = clipped_destination_right) or
-       (clipped_destination_top = clipped_destination_bottom) then
-    begin
-      { clipped area is zero }
-      tmp1 := TPTCArea.Create(0, 0, 0, 0);
-      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),
-                            Trunc(clipped_source_right),
-                            Trunc(clipped_source_bottom));
-    tmp2 := TPTCArea.Create(Trunc(clipped_destination_left),
-                            Trunc(clipped_destination_top),
-                            Trunc(clipped_destination_right),
-                            Trunc(clipped_destination_bottom));
-    AClippedSource.Assign(tmp1);
-    AClippedDestination.Assign(tmp2);
-  finally
-    tmp1.Free;
-    tmp2.Free;
+  { expand source area to floating point }
+  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, 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 }
+    AClippedSource := TPTCArea.Create(0, 0, 0, 0);
+    AClippedDestination := AClippedSource;
+    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 := ADestination.Width / ASource.Width;
+  source_to_destination_y := ADestination.Height / ASource.Height;
+
+  { expand destination area to floating point }
+  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, AClipDestination);
+
+  { check for early destination area clipping exit }
+  if (clipped_destination_left = clipped_destination_right) or
+     (clipped_destination_top = clipped_destination_bottom) then
+  begin
+    { clipped area is zero }
+    AClippedSource := TPTCArea.Create(0, 0, 0, 0);
+    AClippedDestination := AClippedSource;
+    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 }
+  AClippedSource := TPTCArea.Create(Trunc(clipped_source_left),
+                                    Trunc(clipped_source_top),
+                                    Trunc(clipped_source_right),
+                                    Trunc(clipped_source_bottom));
+  AClippedDestination := TPTCArea.Create(Trunc(clipped_destination_left),
+                                         Trunc(clipped_destination_top),
+                                         Trunc(clipped_destination_right),
+                                         Trunc(clipped_destination_bottom));
 end;

packages/ptc/src/core/colord.inc

@@ -31,24 +31,30 @@
 }
 
 type
-  TPTCColor = class
-  private
-    FIndex: Integer;
-    FRed, FGreen, FBlue, FAlpha: Single;
-    FDirect: Boolean;
-    FIndexed: Boolean;
+  IPTCColor = interface
+    function GetIndex: Integer;
+    function GetR: Single;
+    function GetG: Single;
+    function GetB: Single;
+    function GetA: Single;
+    function GetDirect: Boolean;
+    function GetIndexed: Boolean;
+
+    function Equals(AColor: IPTCColor): Boolean;
+
+    property Index: Integer read GetIndex;
+    property R: Single read GetR;
+    property G: Single read GetG;
+    property B: Single read GetB;
+    property A: Single read GetA;
+    property Direct: Boolean read GetDirect;
+    property Indexed: Boolean read GetIndexed;
+  end;
+
+  TPTCColorFactory = class
   public
-    constructor Create;
-    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;
+    class function CreateNew: IPTCColor;
+    class function CreateNew(AIndex: Integer): IPTCColor;
+    class function CreateNew(ARed, AGreen, ABlue: Single; AAlpha: Single = 1): IPTCColor;
+    class function CreateNew(AColor: IPTCColor): IPTCColor;
   end;

packages/ptc/src/core/colori.inc

@@ -30,10 +30,51 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+type
+  TPTCColor = class(TInterfacedObject, IPTCColor)
+  private
+    FIndex: Integer;
+    FRed, FGreen, FBlue, FAlpha: Single;
+    FIndexed: Boolean;
+
+    function GetIndex: Integer;
+    function GetR: Single;
+    function GetG: Single;
+    function GetB: Single;
+    function GetA: Single;
+    function GetDirect: Boolean;
+    function GetIndexed: Boolean;
+    function Equals(AColor: IPTCColor): Boolean;
+  public
+    constructor Create;
+    constructor Create(AIndex: Integer);
+    constructor Create(ARed, AGreen, ABlue: Single; AAlpha: Single = 1);
+    constructor Create(AColor: IPTCColor);
+  end;
+
+class function TPTCColorFactory.CreateNew: IPTCColor;
+begin
+  Result := TPTCColor.Create;
+end;
+
+class function TPTCColorFactory.CreateNew(AIndex: Integer): IPTCColor;
+begin
+  Result := TPTCColor.Create(AIndex);
+end;
+
+class function TPTCColorFactory.CreateNew(ARed, AGreen, ABlue: Single; AAlpha: Single = 1): IPTCColor;
+begin
+  Result := TPTCColor.Create(ARed, AGreen, ABlue, AAlpha);
+end;
+
+class function TPTCColorFactory.CreateNew(AColor: IPTCColor): IPTCColor;
+begin
+  Result := TPTCColor.Create(AColor);
+end;
+
 constructor TPTCColor.Create;
 begin
   FIndexed := False;
-  FDirect  := False;
   FIndex   := 0;
   FRed     := 0;
   FGreen   := 0;
@@ -44,7 +85,6 @@ end;
 constructor TPTCColor.Create(AIndex: Integer);
 begin
   FIndexed := True;
-  FDirect  := False;
   FIndex   := AIndex;
   FRed     := 0;
   FGreen   := 0;
@@ -55,7 +95,6 @@ end;
 constructor TPTCColor.Create(ARed, AGreen, ABlue: Single; AAlpha: Single = 1);
 begin
   FIndexed := False;
-  FDirect  := True;
   FIndex   := 0;
   FRed     := ARed;
   FGreen   := AGreen;
@@ -63,35 +102,57 @@ begin
   FAlpha   := AAlpha;
 end;
 
-constructor TPTCColor.Create(const AColor: TPTCColor);
+constructor TPTCColor.Create(AColor: IPTCColor);
+begin
+  FIndex   := AColor.Index;
+  FRed     := AColor.R;
+  FGreen   := AColor.G;
+  FBlue    := AColor.B;
+  FAlpha   := AColor.A;
+  FIndexed := AColor.Indexed;
+end;
+
+function TPTCColor.Equals(AColor: IPTCColor): Boolean;
+begin
+  Result := (FIndexed = AColor.Indexed) and
+            (FIndex   = AColor.Index) and
+            (FRed     = AColor.R) and
+            (FGreen   = AColor.G) and
+            (FBlue    = AColor.B) and
+            (FAlpha   = AColor.A);
+end;
+
+function TPTCColor.GetIndex: Integer;
+begin
+  Result := FIndex;
+end;
+
+function TPTCColor.GetR: Single;
+begin
+  Result := FRed;
+end;
+
+function TPTCColor.GetG: Single;
+begin
+  Result := FGreen;
+end;
+
+function TPTCColor.GetB: Single;
+begin
+  Result := FBlue;
+end;
+
+function TPTCColor.GetA: Single;
 begin
-  FIndex   := AColor.FIndex;
-  FRed     := AColor.FRed;
-  FGreen   := AColor.FGreen;
-  FBlue    := AColor.FBlue;
-  FAlpha   := AColor.FAlpha;
-  FDirect  := AColor.FDirect;
-  FIndexed := AColor.FIndexed;
+  Result := FAlpha;
 end;
 
-procedure TPTCColor.Assign(const AColor: TPTCColor);
+function TPTCColor.GetDirect: Boolean;
 begin
-  FIndex   := AColor.FIndex;
-  FRed     := AColor.FRed;
-  FGreen   := AColor.FGreen;
-  FBlue    := AColor.FBlue;
-  FAlpha   := AColor.FAlpha;
-  FDirect  := AColor.FDirect;
-  FIndexed := AColor.FIndexed;
+  Result := not FIndexed;
 end;
 
-function TPTCColor.Equals(const AColor: TPTCColor): Boolean;
+function TPTCColor.GetIndexed: Boolean;
 begin
-  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);
+  Result := FIndexed;
 end;

packages/ptc/src/core/consoled.inc

@@ -31,79 +31,7 @@
 }
 
 type
-  TPTCConsole = class(TPTCBaseConsole)
-  private
-    FConsole: TPTCBaseConsole;
-    FModes: array [0..1023] of TPTCMode;
-    FOptionsQueue: array of string;
-    FHackyOptionConsoleFlag: Boolean;
-
-    function ConsoleCreate(AIndex: Integer): TPTCBaseConsole;
-    function ConsoleCreate(const AName: string): TPTCBaseConsole;
-    procedure Check;
-
-    procedure AddOptionToOptionsQueue(const AOption: string);
-    procedure ExecuteOptionsFromOptionsQueue;
-    procedure ClearOptionsQueue;
+  TPTCConsoleFactory = class
   public
-    constructor Create; override;
-    destructor Destroy; override;
-    procedure Configure(const AFile: string); override;
-    function Option(const AOption: string): Boolean; override;
-    function Modes: PPTCMode; override;
-    procedure Open(const ATitle: string; APages: Integer = 0); overload; override;
-    procedure Open(const ATitle: string; const AFormat: TPTCFormat;
-                   APages: Integer = 0); overload; override;
-    procedure Open(const ATitle: string; AWidth, AHeight: Integer;
-                   const AFormat: TPTCFormat; APages: Integer = 0); overload; override;
-    procedure Open(const ATitle: string; const AMode: TPTCMode;
-                   APages: Integer = 0); overload; override;
-
-    procedure Close; override;
-    procedure Flush; override;
-    procedure Finish; override;
-    procedure Update; override;
-    procedure Update(const AArea: TPTCArea); override;
-    procedure Copy(ASurface: TPTCBaseSurface); override;
-    procedure Copy(ASurface: TPTCBaseSurface;
-                   const ASource, ADestination: TPTCArea); override;
-    function Lock: Pointer; override;
-    procedure Unlock; override;
-    procedure Load(const APixels: Pointer;
-                   AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette); override;
-    procedure Load(const APixels: Pointer;
-                   AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette;
-                   const ASource, ADestination: TPTCArea); override;
-    procedure Save(APixels: Pointer;
-                   AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette); override;
-    procedure Save(APixels: Pointer;
-                   AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette;
-                   const ASource, ADestination: TPTCArea); override;
-    procedure Clear; override;
-    procedure Clear(const AColor: TPTCColor); override;
-    procedure Clear(const AColor: TPTCColor;
-                    const AArea: TPTCArea); override;
-    procedure Palette(const APalette: TPTCPalette); override;
-    function Palette: TPTCPalette; override;
-    procedure Clip(const AArea: 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 AEvent: TPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
-    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): TPTCEvent; override;
+    class function CreateNew: IPTCConsole;
   end;

packages/ptc/src/core/consolei.inc

@@ -30,6 +30,89 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+type
+  TPTCConsole = class(TPTCBaseConsole)
+  private
+    FConsole: IPTCConsole;
+    FModes: array of IPTCMode;
+    FOptionsQueue: array of string;
+    FHackyOptionConsoleFlag: Boolean;
+
+    function ConsoleCreate(AIndex: Integer): IPTCConsole;
+    function ConsoleCreate(const AName: string): IPTCConsole;
+    procedure Check;
+
+    procedure AddOptionToOptionsQueue(const AOption: string);
+    procedure ExecuteOptionsFromOptionsQueue;
+    procedure ClearOptionsQueue;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure Configure(const AFile: string); override;
+    function Option(const AOption: string): Boolean; override;
+    function Modes: TPTCModeList; override;
+    procedure Open(const ATitle: string; APages: Integer = 0); overload; override;
+    procedure Open(const ATitle: string; AFormat: IPTCFormat;
+                   APages: Integer = 0); overload; override;
+    procedure Open(const ATitle: string; AWidth, AHeight: Integer;
+                   AFormat: IPTCFormat; APages: Integer = 0); overload; override;
+    procedure Open(const ATitle: string; AMode: IPTCMode;
+                   APages: Integer = 0); overload; override;
+
+    procedure Close; override;
+    procedure Flush; override;
+    procedure Finish; override;
+    procedure Update; override;
+    procedure Update(AArea: IPTCArea); override;
+    procedure Copy(ASurface: IPTCSurface); override;
+    procedure Copy(ASurface: IPTCSurface;
+                   ASource, ADestination: IPTCArea); override;
+    function Lock: Pointer; override;
+    procedure Unlock; override;
+    procedure Load(const APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette); override;
+    procedure Load(const APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea); override;
+    procedure Save(APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette); override;
+    procedure Save(APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea); override;
+    procedure Clear; override;
+    procedure Clear(AColor: IPTCColor); override;
+    procedure Clear(AColor: IPTCColor;
+                    AArea: IPTCArea); override;
+    procedure Palette(APalette: IPTCPalette); override;
+    function Palette: IPTCPalette; override;
+    procedure Clip(AArea: IPTCArea); override;
+    function GetWidth: Integer; override;
+    function GetHeight: Integer; override;
+    function GetPitch: Integer; override;
+    function GetPages: Integer; override;
+    function GetArea: IPTCArea; override;
+    function Clip: IPTCArea; override;
+    function GetFormat: IPTCFormat; override;
+    function GetName: string; override;
+    function GetTitle: string; override;
+    function GetInformation: string; override;
+    function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
+    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
+  end;
+
+class function TPTCConsoleFactory.CreateNew: IPTCConsole;
+begin
+  Result := TPTCConsole.Create;
+end;
+
 const
  {$IFDEF GO32V2}
   ConsoleTypesNumber = 4;
@@ -81,9 +164,6 @@ begin
   inherited Create;
   FConsole := nil;
   FHackyOptionConsoleFlag := False;
-  FillChar(FModes, SizeOf(FModes), 0);
-  for I := Low(FModes) to High(FModes) do
-    FModes[I] := TPTCMode.Create;
 
   {$IFDEF UNIX}
     Configure('/usr/share/ptcpas/ptcpas.conf');
@@ -114,9 +194,7 @@ var
   I: Integer;
 begin
   close;
-  FConsole.Free;
-  for I := Low(FModes) to High(FModes) do
-    FModes[I].Free;
+  FConsole := nil;
   inherited Destroy;
 end;
 
@@ -203,54 +281,42 @@ begin
   end;
 end;
 
-function TPTCConsole.Modes: PPTCMode;
+function TPTCConsole.Modes: TPTCModeList;
 var
-  _console: TPTCBaseConsole;
+  _console: IPTCConsole;
   index, mode: Integer;
   local: Integer;
-  _modes: PPTCMode;
-  tmp: TPTCMode;
+  _modes: TPTCModeList;
 begin
   if Assigned(FConsole) then
     Result := FConsole.Modes
   else
   begin
     _console := nil;
+    SetLength(FModes, 0);
     index := -1;
     mode := 0;
-    try
-      repeat
-        Inc(index);
-        try
-          _console := ConsoleCreate(index);
-        except
-          on TPTCError do begin
-            FreeAndNil(_console);
-            Continue;
-          end;
-        end;
-        if _console = nil then
-          Break;
-        _modes := _console.modes;
-        local := 0;
-        while _modes[local].valid do
-        begin
-          FModes[mode].Assign(_modes[local]);
-          Inc(local);
-          Inc(mode);
+    repeat
+      Inc(index);
+      try
+        _console := ConsoleCreate(index);
+      except
+        on TPTCError do begin
+          _console := nil;
+          continue;
         end;
-        FreeAndNil(_console);
-      until False;
-    finally
-      _console.Free;
-    end;
+      end;
+      if _console = nil then
+        break;
+      _modes := _console.modes;
+      SetLength(FModes, Length(FModes) + Length(_modes));
+      for local := Low(_modes) to High(_modes) do
+      begin
+        FModes[mode] := _modes[local];
+        Inc(mode);
+      end;
+    until False;
     { todo: strip duplicate modes from list? }
-    tmp := TPTCMode.Create;
-    try
-      FModes[mode].Assign(tmp);
-    finally
-      tmp.Free;
-    end;
     Result := FModes;
   end;
 end;
@@ -314,7 +380,7 @@ begin
   end;
 end;
 
-procedure TPTCConsole.Open(const ATitle: string; const AFormat: TPTCFormat;
+procedure TPTCConsole.Open(const ATitle: string; AFormat: IPTCFormat;
                            APages: Integer);
 var
   composite, tmp: TPTCError;
@@ -375,7 +441,7 @@ begin
 end;
 
 procedure TPTCConsole.Open(const ATitle: string; AWidth, AHeight: Integer;
-                           const AFormat: TPTCFormat; APages: Integer);
+                           AFormat: IPTCFormat; APages: Integer);
 var
   composite, tmp: TPTCError;
   index: Integer;
@@ -434,7 +500,7 @@ begin
   end;
 end;
 
-procedure TPTCConsole.Open(const ATitle: string; const AMode: TPTCMode;
+procedure TPTCConsole.Open(const ATitle: string; AMode: IPTCMode;
                            APages: Integer);
 var
   composite, tmp: TPTCError;
@@ -519,20 +585,20 @@ begin
   FConsole.Update;
 end;
 
-procedure TPTCConsole.Update(const AArea: TPTCArea);
+procedure TPTCConsole.Update(AArea: IPTCArea);
 begin
   Check;
   FConsole.Update(AArea);
 end;
 
-procedure TPTCConsole.Copy(ASurface: TPTCBaseSurface);
+procedure TPTCConsole.Copy(ASurface: IPTCSurface);
 begin
   Check;
   FConsole.Copy(ASurface);
 end;
 
-procedure TPTCConsole.Copy(ASurface: TPTCBaseSurface;
-                           const ASource, ADestination: TPTCArea);
+procedure TPTCConsole.Copy(ASurface: IPTCSurface;
+                           ASource, ADestination: IPTCArea);
 begin
   Check;
   FConsole.Copy(ASurface, ASource, ADestination);
@@ -552,8 +618,8 @@ end;
 
 procedure TPTCConsole.Load(const APixels: Pointer;
                            AWidth, AHeight, APitch: Integer;
-                           const AFormat: TPTCFormat;
-                           const APalette: TPTCPalette);
+                           AFormat: IPTCFormat;
+                           APalette: IPTCPalette);
 begin
   Check;
   FConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette);
@@ -561,9 +627,9 @@ end;
 
 procedure TPTCConsole.Load(const APixels: Pointer;
                            AWidth, AHeight, APitch: Integer;
-                           const AFormat: TPTCFormat;
-                           const APalette: TPTCPalette;
-                           const ASource, ADestination: TPTCArea);
+                           AFormat: IPTCFormat;
+                           APalette: IPTCPalette;
+                           ASource, ADestination: IPTCArea);
 begin
   Check;
   FConsole.Load(APixels, AWidth, AHeight, APitch, AFormat, APalette,
@@ -572,8 +638,8 @@ end;
 
 procedure TPTCConsole.Save(Apixels: Pointer;
                            AWidth, AHeight, APitch: Integer;
-                           const AFormat: TPTCFormat;
-                           const APalette: TPTCPalette);
+                           AFormat: IPTCFormat;
+                           APalette: IPTCPalette);
 begin
   Check;
   FConsole.Save(APixels, AWidth, AHeight, APitch, AFormat, APalette);
@@ -581,9 +647,9 @@ end;
 
 procedure TPTCConsole.Save(APixels: Pointer;
                            AWidth, AHeight, APitch: Integer;
-                           const AFormat: TPTCFormat;
-                           const APalette: TPTCPalette;
-                           const ASource, ADestination: TPTCArea);
+                           AFormat: IPTCFormat;
+                           APalette: IPTCPalette;
+                           ASource, ADestination: IPTCArea);
 begin
   Check;
   FConsole.Save(APixels, AWidth, AHeight, APitch, AFormat, APalette,
@@ -593,35 +659,35 @@ end;
 procedure TPTCConsole.Clear;
 begin
   Check;
-  FConsole.clear;
+  FConsole.Clear;
 end;
 
-procedure TPTCConsole.Clear(const AColor: TPTCColor);
+procedure TPTCConsole.Clear(AColor: IPTCColor);
 begin
   Check;
-  FConsole.clear(AColor);
+  FConsole.Clear(AColor);
 end;
 
-procedure TPTCConsole.Clear(const AColor: TPTCColor;
-                           const AArea: TPTCArea);
+procedure TPTCConsole.Clear(AColor: IPTCColor;
+                            AArea: IPTCArea);
 begin
   Check;
-  FConsole.clear(AColor, AArea);
+  FConsole.Clear(AColor, AArea);
 end;
 
-procedure TPTCConsole.Palette(const APalette: TPTCPalette);
+procedure TPTCConsole.Palette(APalette: IPTCPalette);
 begin
   Check;
   FConsole.Palette(APalette);
 end;
 
-function TPTCConsole.Palette: TPTCPalette;
+function TPTCConsole.Palette: IPTCPalette;
 begin
   Check;
   Result := FConsole.Palette;
 end;
 
-procedure TPTCConsole.Clip(const AArea: TPTCArea);
+procedure TPTCConsole.Clip(AArea: IPTCArea);
 begin
   Check;
   FConsole.Clip(AArea);
@@ -651,19 +717,19 @@ begin
   Result := FConsole.GetPages;
 end;
 
-function TPTCConsole.GetArea: TPTCArea;
+function TPTCConsole.GetArea: IPTCArea;
 begin
   Check;
   Result := FConsole.GetArea;
 end;
 
-function TPTCConsole.Clip: TPTCArea;
+function TPTCConsole.Clip: IPTCArea;
 begin
   Check;
   Result := FConsole.Clip;
 end;
 
-function TPTCConsole.GetFormat: TPTCFormat;
+function TPTCConsole.GetFormat: IPTCFormat;
 begin
   Check;
   Result := FConsole.GetFormat;
@@ -701,19 +767,19 @@ begin
   Result := FConsole.GetInformation;
 end;
 
-function TPTCConsole.NextEvent(var AEvent: TPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
+function TPTCConsole.NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
 begin
   Check;
   Result := FConsole.NextEvent(AEvent, AWait, AEventMask);
 end;
 
-function TPTCConsole.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): TPTCEvent;
+function TPTCConsole.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
 begin
   Check;
   Result := FConsole.PeekEvent(AWait, AEventMask);
 end;
 
-function TPTCConsole.ConsoleCreate(AIndex: Integer): TPTCBaseConsole;
+function TPTCConsole.ConsoleCreate(AIndex: Integer): IPTCConsole;
 begin
   Result := nil;
   if (AIndex >= Low(ConsoleTypes)) and (AIndex <= High(ConsoleTypes)) then
@@ -723,7 +789,7 @@ begin
     Result.KeyReleaseEnabled := KeyReleaseEnabled;
 end;
 
-function TPTCConsole.ConsoleCreate(const AName: string): TPTCBaseConsole;
+function TPTCConsole.ConsoleCreate(const AName: string): IPTCConsole;
 var
   I, J: Integer;
 begin

packages/ptc/src/core/copyd.inc

@@ -40,8 +40,8 @@ type
   public
     constructor Create;
     destructor Destroy; override;
-    procedure Request(const ASource, ADestination: TPTCFormat);
-    procedure Palette(const ASource, ADestination: TPTCPalette);
+    procedure Request(ASource, ADestination: IPTCFormat);
+    procedure Palette(ASource, ADestination: IPTCPalette);
     procedure Copy(const ASourcePixels: Pointer; ASourceX, ASourceY,
                    ASourceWidth, ASourceHeight, ASourcePitch: Integer;
                    ADestinationPixels: Pointer; ADestinationX, ADestinationY,

packages/ptc/src/core/copyi.inc

@@ -47,25 +47,25 @@ begin
   inherited Destroy;
 end;
 
-procedure TPTCCopy.Request(const ASource, ADestination: TPTCFormat);
+procedure TPTCCopy.Request(ASource, ADestination: IPTCFormat);
 var
   hermes_source_format, hermes_destination_format: PHermesFormat;
 begin
-  hermes_source_format := @ASource.FFormat;
-  hermes_destination_format := @ADestination.FFormat;
+  hermes_source_format := ASource.GetHermesFormat;
+  hermes_destination_format := ADestination.GetHermesFormat;
   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 ASource, ADestination: TPTCPalette);
+procedure TPTCCopy.Palette(ASource, ADestination: IPTCPalette);
 begin
-  if not Hermes_ConverterPalette(FHandle, ASource.FHandle,
-         ADestination.FHandle) then
+  if not Hermes_ConverterPalette(FHandle, ASource.GetHermesPaletteHandle,
+         ADestination.GetHermesPaletteHandle) then
     raise TPTCError.Create('could not set hermes conversion palettes');
 end;
 
-procedure TPTCCopy.copy(const ASourcePixels: Pointer; ASourceX, ASourceY,
+procedure TPTCCopy.Copy(const ASourcePixels: Pointer; ASourceX, ASourceY,
                    ASourceWidth, ASourceHeight, ASourcePitch: Integer;
                    ADestinationPixels: Pointer; ADestinationX, ADestinationY,
                    ADestinationWidth, ADestinationHeight, ADestinationPitch: Integer);

packages/ptc/src/core/eventd.inc

@@ -33,18 +33,11 @@
 type
   TPTCEventType = (PTCKeyEvent, PTCMouseEvent{, PTCExposeEvent});
   TPTCEventMask = set of TPTCEventType;
-  TPTCEvent = class
-  protected
-    function GetType: TPTCEventType; virtual; abstract;
-  public
-    property EventType: TPTCEventType read GetType;
+  IPTCEvent = interface
+    ['{1D5A6831-6648-47B6-83D5-10E65FDB72AD}']
+    function GetEventType: TPTCEventType;
+    property EventType: TPTCEventType read GetEventType;
   end;
 
 const
   PTCAnyEvent: TPTCEventMask = [PTCKeyEvent, PTCMouseEvent{, PTCExposeEvent}];
-
-{type
-  TPTCExposeEvent = Class(TPTCEvent)
-  protected
-    function GetType: TPTCEventType; override;
-  End;}

packages/ptc/src/core/eventi.inc

@@ -36,9 +36,20 @@ begin
 end;}
 
 type
+  TPTCEvent = class(TInterfacedObject, IPTCEvent)
+  protected
+    function GetEventType: TPTCEventType; virtual; abstract;
+  public
+    property EventType: TPTCEventType read GetEventType;
+  end;
+{  TPTCExposeEvent = Class(TPTCEvent)
+  protected
+    function GetType: TPTCEventType; override;
+  End;}
+
   PEventLinkedList = ^TEventLinkedList;
   TEventLinkedList = record
-    Event: TPTCEvent;
+    Event: IPTCEvent;
     Next: PEventLinkedList;
   end;
   TEventQueue = class
@@ -47,9 +58,9 @@ type
   public
     constructor Create;
     destructor Destroy; override;
-    procedure AddEvent(event: TPTCEvent);
-    function PeekEvent(const EventMask: TPTCEventMask): TPTCEvent;
-    function NextEvent(const EventMask: TPTCEventMask): TPTCEvent;
+    procedure AddEvent(const event: IPTCEvent);
+    function PeekEvent(const EventMask: TPTCEventMask): IPTCEvent;
+    function NextEvent(const EventMask: TPTCEventMask): IPTCEvent;
   end;
 
 constructor TEventQueue.Create;
@@ -65,7 +76,7 @@ begin
   p := FHead;
   while p <> nil do
   begin
-    FreeAndNil(p^.Event);
+    p^.Event := nil;
     pnext := p^.Next;
     Dispose(p);
     p := pnext;
@@ -73,7 +84,7 @@ begin
   inherited Destroy;
 end;
 
-procedure TEventQueue.AddEvent(event: TPTCEvent);
+procedure TEventQueue.AddEvent(const event: IPTCEvent);
 var
   tmp: PEventLinkedList;
 begin
@@ -94,7 +105,7 @@ begin
   end;
 end;
 
-function TEventQueue.PeekEvent(const EventMask: TPTCEventMask): TPTCEvent;
+function TEventQueue.PeekEvent(const EventMask: TPTCEventMask): IPTCEvent;
 var
   p: PEventLinkedList;
 begin
@@ -112,7 +123,7 @@ begin
   Result := nil;
 end;
 
-function TEventQueue.NextEvent(const EventMask: TPTCEventMask): TPTCEvent;
+function TEventQueue.NextEvent(const EventMask: TPTCEventMask): IPTCEvent;
 var
   prev, p: PEventLinkedList;
 begin
@@ -123,6 +134,7 @@ begin
     if p^.Event.EventType In EventMask then
     begin
       Result := p^.Event;
+      p^.Event := nil;
 
       { delete the element from the linked list }
       if prev <> nil then

packages/ptc/src/core/formatd.inc

@@ -31,27 +31,36 @@
 }
 
 type
-  TPTCFormat = class
-  private
-    FFormat: THermesFormat;
+  IPTCFormat = interface
+    function GetHermesFormat: PHermesFormat;
+
+    function Equals(AFormat: IPTCFormat): Boolean;
+
+    function GetR: Uint32;
+    function GetG: Uint32;
+    function GetB: Uint32;
+    function GetA: Uint32;
+    function GetBits: Integer;
+    function GetIndexed: Boolean;
     function GetDirect: Boolean;
     function GetBytes: Integer;
-  public
-    constructor Create;
-    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: 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 R: Uint32 read GetR;
+    property G: Uint32 read GetG;
+    property B: Uint32 read GetB;
+    property A: Uint32 read GetA;
+    property Bits: Integer read GetBits;
+    property Indexed: Boolean read GetIndexed;
     property Direct: Boolean read GetDirect;
     property Bytes: Integer read GetBytes;
   end;
+
+  TPTCFormatFactory = class
+  public
+    class function CreateNew: IPTCFormat;
+    class function CreateNew(ABits: Integer): IPTCFormat;
+    class function CreateNew(ABits: Integer;
+                             ARedMask, AGreenMask, ABlueMask: Uint32;
+                             AAlphaMask: Uint32 = 0): IPTCFormat;
+    class function CreateNew(AFormat: IPTCFormat): IPTCFormat;
+  end;

packages/ptc/src/core/formati.inc

@@ -30,6 +30,61 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+type
+  TPTCFormat = class(TInterfacedObject, IPTCFormat)
+  private
+    FFormat: THermesFormat;
+    function GetHermesFormat: PHermesFormat;
+    function Equals(AFormat: IPTCFormat): Boolean;
+    function GetR: Uint32;
+    function GetG: Uint32;
+    function GetB: Uint32;
+    function GetA: Uint32;
+    function GetBits: Integer;
+    function GetIndexed: Boolean;
+    function GetDirect: Boolean;
+    function GetBytes: Integer;
+  public
+    constructor Create;
+    constructor Create(ABits: Integer);
+    constructor Create(ABits: Integer;
+                       ARedMask, AGreenMask, ABlueMask: Uint32;
+                       AAlphaMask: Uint32 = 0);
+    constructor Create(AFormat: IPTCFormat);
+    destructor Destroy; override;
+//    procedure Assign(const format: TPTCFormat);
+{    property R: Uint32 read GetR;
+    property G: Uint32 read GetG;
+    property B: Uint32 read GetB;
+    property A: Uint32 read GetA;
+    property Bits: Integer read GetBits;
+    property Indexed: Boolean read GetIndexed;
+    property Direct: Boolean read GetDirect;
+    property Bytes: Integer read GetBytes;}
+  end;
+
+class function TPTCFormatFactory.CreateNew: IPTCFormat;
+begin
+  Result := TPTCFormat.Create;
+end;
+
+class function TPTCFormatFactory.CreateNew(ABits: Integer): IPTCFormat;
+begin
+  Result := TPTCFormat.Create(ABits);
+end;
+
+class function TPTCFormatFactory.CreateNew(ABits: Integer;
+                                           ARedMask, AGreenMask, ABlueMask: Uint32;
+                                           AAlphaMask: Uint32 = 0): IPTCFormat;
+begin
+  Result := TPTCFormat.Create(ABits, ARedMask, AGreenMask, ABlueMask, AAlphaMask);
+end;
+
+class function TPTCFormatFactory.CreateNew(AFormat: IPTCFormat): IPTCFormat;
+begin
+  Result := TPTCFormat.Create(AFormat);
+end;
+
 constructor TPTCFormat.Create;
 begin
   { defaults }
@@ -85,13 +140,13 @@ begin
     raise TPTCError.Create('could not initialize hermes');
 end;
 
-constructor TPTCFormat.Create(const format: TPTCFormat);
+constructor TPTCFormat.Create(AFormat: IPTCFormat);
 begin
   { initialize hermes }
   if not Hermes_Init then
     raise TPTCError.Create('could not initialize hermes');
 
-  Hermes_FormatCopy(@format.FFormat, @FFormat)
+  Hermes_FormatCopy(AFormat.GetHermesFormat, @FFormat)
 end;
 
 {$INFO TODO: check what happens if Hermes_Init blows up in the constructor...}
@@ -102,16 +157,51 @@ begin
   inherited Destroy;
 end;
 
-procedure TPTCFormat.Assign(const format: TPTCFormat);
+function TPTCFormat.GetHermesFormat: PHermesFormat;
+begin
+  Result := @Fformat;
+end;
+
+{procedure TPTCFormat.Assign(const format: TPTCFormat);
 begin
   if Self = format then
     exit;
   Hermes_FormatCopy(@format.Fformat, @Fformat);
+end;}
+
+function TPTCFormat.Equals(AFormat: IPTCFormat): Boolean;
+begin
+  Result := Hermes_FormatEquals(AFormat.GetHermesFormat, @FFormat);
+end;
+
+function TPTCFormat.GetR: Uint32;
+begin
+  Result := FFormat.r;
+end;
+
+function TPTCFormat.GetG: Uint32;
+begin
+  Result := FFormat.g;
+end;
+
+function TPTCFormat.GetB: Uint32;
+begin
+  Result := FFormat.b;
+end;
+
+function TPTCFormat.GetA: Uint32;
+begin
+  Result := FFormat.a;
+end;
+
+function TPTCFormat.GetBits: Integer;
+begin
+  Result := FFormat.bits;
 end;
 
-function TPTCFormat.Equals(const format: TPTCFormat): Boolean;
+function TPTCFormat.GetIndexed: Boolean;
 begin
-  Result := Hermes_FormatEquals(@format.FFormat, @FFormat);
+  Result := FFormat.indexed;
 end;
 
 function TPTCFormat.GetDirect: Boolean;

packages/ptc/src/core/keyeventd.inc

@@ -31,41 +31,42 @@
 }
 
 type
-  TPTCKeyEvent = class(TPTCEvent)
-  private
-    FCode: Integer;
-    FUnicode: Integer;
-    FAlt: Boolean;
-    FShift: Boolean;
-    FControl: Boolean;
-    FPress: Boolean;
-
+  IPTCKeyEvent = interface(IPTCEvent)
+    ['{9BD1CD41-1DF6-4392-99DC-885EADB6D85A}']
+    function GetCode: Integer;
+    function GetUnicode: Integer;
+    function GetAlt: Boolean;
+    function GetShift: Boolean;
+    function GetControl: Boolean;
+    function GetPress: 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;
+
+//    function Equals(AKey: IPTCKeyEvent): Boolean;
+
+    property Code: Integer read GetCode;
+    property Unicode: Integer read GetUnicode;
+    property Alt: Boolean read GetAlt;
+    property Shift: Boolean read GetShift;
+    property Control: Boolean read GetControl;
+    property Press: Boolean read GetPress;
     property Release: Boolean read GetRelease;
   end;
 
+  TPTCKeyEventFactory = class
+  public
+    class function CreateNew: IPTCKeyEvent;
+    class function CreateNew(ACode: Integer): IPTCKeyEvent;
+    class function CreateNew(ACode, AUnicode: Integer): IPTCKeyEvent;
+    class function CreateNew(ACode, AUnicode: Integer; APress: Boolean): IPTCKeyEvent;
+    class function CreateNew(ACode: Integer; AAlt, AShift, AControl: Boolean): IPTCKeyEvent;
+    class function CreateNew(ACode: Integer; AAlt, AShift, AControl, APress: Boolean): IPTCKeyEvent;
+    class function CreateNew(ACode, AUnicode: Integer;
+                             AAlt, AShift, AControl: Boolean): IPTCKeyEvent;
+    class function CreateNew(ACode, AUnicode: Integer;
+                             AAlt, AShift, AControl, APress: Boolean): IPTCKeyEvent;
+    class function CreateNew(AKey: IPTCKeyEvent): IPTCKeyEvent;
+  end;
+
 const
   PTCKEY_UNDEFINED    = $00;
   PTCKEY_CANCEL       = $03;

packages/ptc/src/core/keyeventi.inc

@@ -29,8 +29,96 @@
     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, IPTCKeyEvent)
+  private
+    FCode: Integer;
+    FUnicode: Integer;
+    FAlt: Boolean;
+    FShift: Boolean;
+    FControl: Boolean;
+    FPress: Boolean;
 
-function TPTCKeyEvent.GetType: TPTCEventType;
+    function GetCode: Integer;
+    function GetUnicode: Integer;
+    function GetAlt: Boolean;
+    function GetShift: Boolean;
+    function GetControl: Boolean;
+    function GetPress: Boolean;
+    function GetRelease: Boolean;
+  protected
+    function GetEventType: 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(AKey: IPTCKeyEvent);
+{    procedure Assign(const AKey: TPTCKeyEvent);
+    function Equals(const AKey: TPTCKeyEvent): Boolean;
+    property Code: Integer read GetCode;
+    property Unicode: Integer read GetUnicode;
+    property Alt: Boolean read GetAlt;
+    property Shift: Boolean read GetShift;
+    property Control: Boolean read GetControl;
+    property Press: Boolean read GetPress;
+    property Release: Boolean read GetRelease;}
+  end;
+
+class function TPTCKeyEventFactory.CreateNew: IPTCKeyEvent;
+begin
+  Result := TPTCKeyEvent.Create;
+end;
+
+class function TPTCKeyEventFactory.CreateNew(ACode: Integer): IPTCKeyEvent;
+begin
+  Result := TPTCKeyEvent.Create(ACode);
+end;
+
+class function TPTCKeyEventFactory.CreateNew(ACode, AUnicode: Integer): IPTCKeyEvent;
+begin
+  Result := TPTCKeyEvent.Create(ACode, AUnicode);
+end;
+
+class function TPTCKeyEventFactory.CreateNew(ACode, AUnicode: Integer; APress: Boolean): IPTCKeyEvent;
+begin
+  Result := TPTCKeyEvent.Create(ACode, AUnicode, APress);
+end;
+
+class function TPTCKeyEventFactory.CreateNew(ACode: Integer; AAlt, AShift, AControl: Boolean): IPTCKeyEvent;
+begin
+  Result := TPTCKeyEvent.Create(ACode, AAlt, AShift, AControl);
+end;
+
+class function TPTCKeyEventFactory.CreateNew(ACode: Integer; AAlt, AShift, AControl, APress: Boolean): IPTCKeyEvent;
+begin
+  Result := TPTCKeyEvent.Create(ACode, AAlt, AShift, AControl, APress);
+end;
+
+class function TPTCKeyEventFactory.CreateNew(ACode, AUnicode: Integer;
+                                             AAlt, AShift, AControl: Boolean): IPTCKeyEvent;
+begin
+  Result := TPTCKeyEvent.Create(ACode, AUnicode, AAlt, AShift, AControl);
+end;
+
+class function TPTCKeyEventFactory.CreateNew(ACode, AUnicode: Integer;
+                                             AAlt, AShift, AControl, APress: Boolean): IPTCKeyEvent;
+begin
+  Result := TPTCKeyEvent.Create(ACode, AUnicode, AAlt, AShift, AControl, APress);
+end;
+
+class function TPTCKeyEventFactory.CreateNew(AKey: IPTCKeyEvent): IPTCKeyEvent;
+begin
+  Result := TPTCKeyEvent.Create(AKey);
+end;
+
+function TPTCKeyEvent.GetEventType: TPTCEventType;
 begin
   Result := PTCKeyEvent;
 end;
@@ -116,7 +204,7 @@ begin
   FPress   := APress;
 end;
 
-constructor TPTCKeyEvent.Create(const AKey: TPTCKeyEvent);
+constructor TPTCKeyEvent.Create(AKey: IPTCKeyEvent);
 begin
   FCode    := AKey.Code;
   FUnicode := AKey.Unicode;
@@ -126,7 +214,7 @@ begin
   FPress   := AKey.Press;
 end;
 
-procedure TPTCKeyEvent.Assign(const AKey: TPTCKeyEvent);
+{procedure TPTCKeyEvent.Assign(const AKey: TPTCKeyEvent);
 begin
   FCode    := AKey.Code;
   FUnicode := AKey.Unicode;
@@ -144,6 +232,36 @@ begin
             (FShift   = AKey.FShift) and
             (FControl = AKey.FControl) and
             (FPress   = AKey.FPress);
+end;}
+
+function TPTCKeyEvent.GetCode: Integer;
+begin
+  Result := FCode;
+end;
+
+function TPTCKeyEvent.GetUnicode: Integer;
+begin
+  Result := FUnicode;
+end;
+
+function TPTCKeyEvent.GetAlt: Boolean;
+begin
+  Result := FAlt;
+end;
+
+function TPTCKeyEvent.GetShift: Boolean;
+begin
+  Result := FShift;
+end;
+
+function TPTCKeyEvent.GetControl: Boolean;
+begin
+  Result := FControl;
+end;
+
+function TPTCKeyEvent.GetPress: Boolean;
+begin
+  Result := FPress;
 end;
 
 function TPTCKeyEvent.GetRelease: Boolean;

packages/ptc/src/core/log.inc

@@ -174,7 +174,7 @@ begin
   LOG_close;
 end;
 
-procedure LOG(const message: string; data: TPTCFormat);
+procedure LOG(const message: string; data: IPTCFormat);
 begin
   if not LOG_enabled then
     exit;

packages/ptc/src/core/moded.inc

@@ -31,22 +31,26 @@
 }
 
 type
-  PPTCMode=^TPTCMode;
-  TPTCMode = class
-  private
-    FValid: Boolean;
-    FWidth: Integer;
-    FHeight: Integer;
-    FFormat: TPTCFormat;
+  IPTCMode = interface
+    function GetValid: Boolean;
+    function GetWidth: Integer;
+    function GetHeight: Integer;
+    function GetFormat: IPTCFormat;
+
+    function Equals(AMode: IPTCMode): Boolean;
+
+    property Valid: Boolean read GetValid;
+    property Width: Integer read GetWidth;
+    property Height: Integer read GetHeight;
+    property Format: IPTCFormat read GetFormat;
+  end;
+
+  TPTCModeList = array of IPTCMode;
+
+  TPTCModeFactory = class
   public
-    constructor Create;
-    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 FValid;
-    property Width: Integer read FWidth;
-    property Height: Integer read FHeight;
-    property Format: TPTCFormat read FFormat;
+    class function CreateNew: IPTCMode;
+    class function CreateNew(AWidth, AHeight: Integer; AFormat: IPTCFormat): IPTCMode;
+    class function CreateNew(AMode: IPTCMode): IPTCMode;
   end;
+

packages/ptc/src/core/modei.inc

@@ -31,7 +31,42 @@
 }
 
 type
-  TPTCModeDynArray = array of TPTCMode;
+  TPTCMode = class(TInterfacedObject, IPTCMode)
+  private
+    FValid: Boolean;
+    FWidth: Integer;
+    FHeight: Integer;
+    FFormat: IPTCFormat;
+    function GetValid: Boolean;
+    function GetWidth: Integer;
+    function GetHeight: Integer;
+    function GetFormat: IPTCFormat;
+  public
+    constructor Create;
+    constructor Create(AWidth, AHeight: Integer; AFormat: IPTCFormat);
+    constructor Create(AMode: IPTCMode);
+{    procedure Assign(const mode: TPTCMode);}
+    function Equals(AMode: IPTCMode): Boolean;
+{    property Valid: Boolean read GetValid;
+    property Width: Integer read GetWidth;
+    property Height: Integer read GetHeight;
+    property Format: IPTCFormat read GetFormat;}
+  end;
+
+class function TPTCModeFactory.CreateNew: IPTCMode;
+begin
+  Result := TPTCMode.Create;
+end;
+
+class function TPTCModeFactory.CreateNew(AWidth, AHeight: Integer; AFormat: IPTCFormat): IPTCMode;
+begin
+  Result := TPTCMode.Create(AWidth, AHeight, AFormat);
+end;
+
+class function TPTCModeFactory.CreateNew(AMode: IPTCMode): IPTCMode;
+begin
+  Result := TPTCMode.Create(AMode);
+end;
 
 constructor TPTCMode.Create;
 begin
@@ -41,40 +76,54 @@ begin
   FValid := False;
 end;
 
-constructor TPTCMode.Create(AWidth, AHeight: Integer; const AFormat: TPTCFormat);
+constructor TPTCMode.Create(AWidth, AHeight: Integer; AFormat: IPTCFormat);
 begin
-  FFormat := TPTCFormat.Create(AFormat);
+  FFormat := AFormat;
   FWidth := AWidth;
   FHeight := AHeight;
   FValid := True;
 end;
 
-constructor TPTCMode.Create(const mode: TPTCMode);
+constructor TPTCMode.Create(AMode: IPTCMode);
 begin
-  FFormat := TPTCFormat.Create(mode.FFormat);
+  FFormat := AMode.Format;
+  FWidth := AMode.Width;
+  FHeight := AMode.Height;
+  FValid := AMode.Valid;
+end;
+
+{procedure TPTCMode.Assign(const mode: TPTCMode);
+begin
+  FFormat := mode.FFormat;
   FWidth := mode.FWidth;
   FHeight := mode.FHeight;
   FValid := mode.FValid;
 end;
+}
+function TPTCMode.Equals(AMode: IPTCMode): Boolean;
+begin
+  Result := (FValid = AMode.Valid) and
+            (FWidth = AMode.Width) and
+            (FHeight = AMode.Height) and
+             FFormat.Equals(AMode.Format);
+end;
 
-destructor TPTCMode.Destroy;
+function TPTCMode.GetValid: Boolean;
 begin
-  FFormat.Free;
-  inherited Destroy;
+  Result := FValid;
 end;
 
-procedure TPTCMode.Assign(const mode: TPTCMode);
+function TPTCMode.GetWidth: Integer;
 begin
-  FFormat.Assign(mode.FFormat);
-  FWidth := mode.FWidth;
-  FHeight := mode.FHeight;
-  FValid := mode.FValid;
+  Result := FWidth;
+end;
+
+function TPTCMode.GetHeight: Integer;
+begin
+  Result := FHeight;
 end;
 
-function TPTCMode.Equals(const mode: TPTCMode): Boolean;
+function TPTCMode.GetFormat: IPTCFormat;
 begin
-  Result := (FValid = mode.FValid) and
-            (FWidth = mode.FWidth) and
-            (FHeight = mode.FHeight) and
-             FFormat.Equals(mode.FFormat);
+  Result := FFormat;
 end;

packages/ptc/src/core/mouseeventd.inc

@@ -39,30 +39,37 @@ type
                      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;
+  TPTCMouseButtonState = set of TPTCMouseButton;
+  IPTCMouseEvent = interface(IPTCEvent)
+    ['{4D093608-6F27-4578-B41E-3492A4C7FEED}']
+    function GetX: Integer;
+    function GetY: Integer;
+    function GetDeltaX: Integer;
+    function GetDeltaY: Integer;
+    function GetButtonState: TPTCMouseButtonState;
+
+    property X: Integer read GetX;
+    property Y: Integer read GetY;
+    property DeltaX: Integer read GetDeltaX;
+    property DeltaY: Integer read GetDeltaY;
+    property ButtonState: TPTCMouseButtonState read GetButtonState;
   end;
-  TPTCMouseButtonEvent = Class(TPTCMouseEvent)
-  private
-    FPress: Boolean;
-    FButton: TPTCMouseButton;
+  IPTCMouseButtonEvent = interface(IPTCMouseEvent)
+    ['{363B9ACC-4DEB-4031-8BD9-0B6788C6CFA7}']
+    function GetPress: Boolean;
     function GetRelease: Boolean;
-  public
-    constructor Create(AX, AY, ADeltaX, ADeltaY: Integer; AButtonState: TPTCMouseButtonState; APress: Boolean; AButton: TPTCMouseButton);
-    property Press: Boolean read FPress;
+    function GetButton: TPTCMouseButton;
+
+    property Press: Boolean read GetPress;
     property Release: Boolean read GetRelease;
-    property Button: TPTCMouseButton read FButton;
+    property Button: TPTCMouseButton read GetButton;
+  end;
+
+  TPTCMouseEventFactory = class
+  public
+    class function CreateNew(AX, AY, ADeltaX, ADeltaY: Integer; AButtonState: TPTCMouseButtonState): IPTCMouseEvent;
+  end;
+  TPTCMouseButtonEventFactory = class
+  public
+    class function CreateNew(AX, AY, ADeltaX, ADeltaY: Integer; AButtonState: TPTCMouseButtonState; APress: Boolean; AButton: TPTCMouseButton): IPTCMouseButtonEvent;
   end;

packages/ptc/src/core/mouseeventi.inc

@@ -30,7 +30,52 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-function TPTCMouseEvent.GetType: TPTCEventType;
+type
+  TPTCMouseEvent = class(TPTCEvent, IPTCMouseEvent)
+  private
+    FX, FY: Integer;
+    FDeltaX, FDeltaY: Integer;
+    FButtonState: TPTCMouseButtonState;
+    function GetX: Integer;
+    function GetY: Integer;
+    function GetDeltaX: Integer;
+    function GetDeltaY: Integer;
+    function GetButtonState: TPTCMouseButtonState;
+  protected
+    function GetEventType: TPTCEventType; override;
+  public
+    constructor Create(AX, AY, ADeltaX, ADeltaY: Integer; AButtonState: TPTCMouseButtonState);
+{    property X: Integer read GetX;
+    property Y: Integer read GetY;
+    property DeltaX: Integer read GetDeltaX;
+    property DeltaY: Integer read GetDeltaY;
+    property ButtonState: TPTCMouseButtonState read GetButtonState;}
+  end;
+  TPTCMouseButtonEvent = class(TPTCMouseEvent, IPTCMouseButtonEvent)
+  private
+    FPress: Boolean;
+    FButton: TPTCMouseButton;
+    function GetPress: Boolean;
+    function GetRelease: Boolean;
+    function GetButton: TPTCMouseButton;
+  public
+    constructor Create(AX, AY, ADeltaX, ADeltaY: Integer; AButtonState: TPTCMouseButtonState; APress: Boolean; AButton: TPTCMouseButton);
+{    property Press: Boolean read GetPress;
+    property Release: Boolean read GetRelease;
+    property Button: TPTCMouseButton read GetButton;}
+  end;
+
+class function TPTCMouseEventFactory.CreateNew(AX, AY, ADeltaX, ADeltaY: Integer; AButtonState: TPTCMouseButtonState): IPTCMouseEvent;
+begin
+  Result := TPTCMouseEvent.Create(AX, AY, ADeltaX, ADeltaY, AButtonState);
+end;
+
+class function TPTCMouseButtonEventFactory.CreateNew(AX, AY, ADeltaX, ADeltaY: Integer; AButtonState: TPTCMouseButtonState; APress: Boolean; AButton: TPTCMouseButton): IPTCMouseButtonEvent;
+begin
+  Result := TPTCMouseButtonEvent.Create(AX, AY, ADeltaX, ADeltaY, AButtonState, APress, AButton);
+end;
+
+function TPTCMouseEvent.GetEventType: TPTCEventType;
 begin
   Result := PTCMouseEvent;
 end;
@@ -44,6 +89,31 @@ begin
   FButtonState := AButtonState;
 end;
 
+function TPTCMouseEvent.GetX: Integer;
+begin
+  Result := FX;
+end;
+
+function TPTCMouseEvent.GetY: Integer;
+begin
+  Result := FY;
+end;
+
+function TPTCMouseEvent.GetDeltaX: Integer;
+begin
+  Result := FDeltaX;
+end;
+
+function TPTCMouseEvent.GetDeltaY: Integer;
+begin
+  Result := FDeltaY;
+end;
+
+function TPTCMouseEvent.GetButtonState: TPTCMouseButtonState;
+begin
+  Result := FButtonState;
+end;
+
 constructor TPTCMouseButtonEvent.Create(AX, AY, ADeltaX, ADeltaY: Integer; AButtonState: TPTCMouseButtonState; APress: Boolean; AButton: TPTCMouseButton);
 begin
   if APress xor (AButton In AButtonState) then
@@ -55,7 +125,17 @@ begin
   FButton := AButton;
 end;
 
+function TPTCMouseButtonEvent.GetPress: Boolean;
+begin
+  Result := FPress;
+end;
+
 function TPTCMouseButtonEvent.GetRelease: Boolean;
 begin
   Result := not FPress;
 end;
+
+function TPTCMouseButtonEvent.GetButton: TPTCMouseButton;
+begin
+  Result := FButton;
+end;

packages/ptc/src/core/paletted.inc

@@ -31,17 +31,7 @@
 }
 
 type
-  TPTCPalette = class
-  private
-    FLocked: Boolean;
-    FHandle: THermesPaletteHandle;
-  public
-    constructor Create;
-    constructor Create(const AData: array of Uint32);
-    constructor Create(const APalette: TPTCPalette);
-    destructor Destroy; override;
-    procedure Assign(const APalette: TPTCPalette);
-    function Equals(const APalette: TPTCPalette): Boolean;
+  IPTCPalette = interface
     function Lock: PUint32;
     procedure Unlock;
     procedure Load(const AData: array of Uint32);
@@ -49,4 +39,12 @@ type
     procedure Save(var AData: array of Uint32);
     procedure Save(AData: Pointer);
     function Data: PUint32;
+    function GetHermesPaletteHandle: THermesPaletteHandle;
+  end;
+
+  TPTCPaletteFactory = class
+  public
+    class function CreateNew: IPTCPalette;
+    class function CreateNew(const AData: array of Uint32): IPTCPalette;
+    class function CreateNew(APalette: IPTCPalette): IPTCPalette;
   end;

packages/ptc/src/core/palettei.inc

@@ -30,6 +30,43 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+type
+  TPTCPalette = class(TInterfacedObject, IPTCPalette)
+  private
+    FLocked: Boolean;
+    FHandle: THermesPaletteHandle;
+  public
+    constructor Create;
+    constructor Create(const AData: array of Uint32);
+    constructor Create(APalette: IPTCPalette);
+    destructor Destroy; override;
+//    procedure Assign(const APalette: TPTCPalette);
+//    function Equals(const APalette: TPTCPalette): Boolean;
+    function Lock: PUint32;
+    procedure Unlock;
+    procedure Load(const AData: array of Uint32);
+    procedure Load(AData: Pointer);
+    procedure Save(var AData: array of Uint32);
+    procedure Save(AData: Pointer);
+    function Data: PUint32;
+    function GetHermesPaletteHandle: THermesPaletteHandle;
+  end;
+
+class function TPTCPaletteFactory.CreateNew: IPTCPalette;
+begin
+  Result := TPTCPalette.Create;
+end;
+
+class function TPTCPaletteFactory.CreateNew(const AData: array of Uint32): IPTCPalette;
+begin
+  Result := TPTCPalette.Create(AData);
+end;
+
+class function TPTCPaletteFactory.CreateNew(APalette: IPTCPalette): IPTCPalette;
+begin
+  Result := TPTCPalette.Create(APalette);
+end;
+
 constructor TPTCPalette.Create;
 var
   zero: array [0..255] of Uint32;
@@ -55,7 +92,7 @@ begin
   Load(AData);
 end;
 
-constructor TPTCPalette.Create(const APalette: TPTCPalette);
+constructor TPTCPalette.Create(APalette: IPTCPalette);
 begin
   FLocked := False;
   if not Hermes_Init then
@@ -63,7 +100,7 @@ begin
   FHandle := Hermes_PaletteInstance;
   if FHandle = nil then
     raise TPTCError.Create('could not create hermes palette instance');
-  Assign(APalette);
+  Hermes_PaletteSet(FHandle, Hermes_PaletteGet(APalette.GetHermesPaletteHandle));
 end;
 
 destructor TPTCPalette.Destroy;
@@ -75,7 +112,7 @@ begin
   inherited Destroy;
 end;
 
-procedure TPTCPalette.Assign(const APalette: TPTCPalette);
+{procedure TPTCPalette.Assign(const APalette: TPTCPalette);
 begin
   if Self = APalette then
     exit;
@@ -87,7 +124,7 @@ function TPTCPalette.Equals(const APalette: TPTCPalette): Boolean;
 begin
   Equals := CompareDWord(Hermes_PaletteGet(FHandle)^, Hermes_PaletteGet(APalette.FHandle)^, 1024 div 4) = 0;
 end;
-
+}
 function TPTCPalette.Lock: PUint32;
 begin
   if FLocked then
@@ -127,3 +164,8 @@ function TPTCPalette.Data: PUint32;
 begin
   Result := Hermes_PaletteGet(FHandle);
 end;
+
+function TPTCPalette.GetHermesPaletteHandle: THermesPaletteHandle;
+begin
+  Result := FHandle;
+end;

packages/ptc/src/core/surfaced.inc

@@ -31,58 +31,7 @@
 }
 
 type
-  TPTCSurface = class(TPTCBaseSurface)
-  private
-    {data}
-    FWidth: Integer;
-    FHeight: Integer;
-    FPitch: Integer;
-    FArea: TPTCArea;
-    FClip: TPTCArea;
-    FFormat: TPTCFormat;
-    FLocked: Boolean;
-    FPixels: Pointer;
-    {objects}
-    FCopy: TPTCCopy;
-    FClear: TPTCClear;
-    FPalette: TPTCPalette;
+  TPTCSurfaceFactory = class
   public
-    constructor Create(AWidth, AHeight: Integer; const AFormat: TPTCFormat);
-    destructor Destroy; override;
-    procedure Copy(ASurface: TPTCBaseSurface); override;
-    procedure Copy(ASurface: TPTCBaseSurface;
-                   const ASource, ADestination: TPTCArea); override;
-    function Lock: Pointer; override;
-    procedure Unlock; override;
-    procedure Load(const APixels: Pointer;
-                   AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette); override;
-    procedure Load(const APixels: Pointer;
-                   AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette;
-                   const ASource, ADestination: TPTCArea); override;
-    procedure Save(APixels: Pointer;
-                   AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette); override;
-    procedure Save(APixels: Pointer;
-                   AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette;
-                   const ASource, ADestination: TPTCArea); override;
-    procedure Clear; override;
-    procedure Clear(const AColor: TPTCColor); override;
-    procedure Clear(const AColor: TPTCColor; const AArea: TPTCArea); override;
-    procedure Palette(const APalette: TPTCPalette); override;
-    function Palette: TPTCPalette; override;
-    procedure Clip(const AArea: TPTCArea); 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 AOption: string): Boolean; override;
+    class function CreateNew(AWidth, AHeight: Integer; AFormat: IPTCFormat): IPTCSurface;
   end;

packages/ptc/src/core/surfacei.inc

@@ -30,7 +30,75 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
-constructor TPTCSurface.Create(AWidth, AHeight: Integer; const AFormat: TPTCFormat);
+type
+  TPTCSurface = class(TInterfacedObject, IPTCSurface)
+  private
+    {data}
+    FWidth: Integer;
+    FHeight: Integer;
+    FPitch: Integer;
+    FArea: IPTCArea;
+    FClip: IPTCArea;
+    FFormat: IPTCFormat;
+    FLocked: Boolean;
+    FPixels: Pointer;
+    {objects}
+    FCopy: TPTCCopy;
+    FClear: TPTCClear;
+    FPalette: IPTCPalette;
+  public
+    constructor Create(AWidth, AHeight: Integer; AFormat: IPTCFormat);
+    destructor Destroy; override;
+    procedure Copy(ASurface: IPTCSurface);
+    procedure Copy(ASurface: IPTCSurface;
+                   ASource, ADestination: IPTCArea);
+    function Lock: Pointer;
+    procedure Unlock;
+    procedure Load(const APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette);
+    procedure Load(const APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea);
+    procedure Save(APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette);
+    procedure Save(APixels: Pointer;
+                   AWidth, AHeight, APitch: Integer;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea);
+    procedure Clear;
+    procedure Clear(AColor: IPTCColor);
+    procedure Clear(AColor: IPTCColor; AArea: IPTCArea);
+    procedure Palette(APalette: IPTCPalette);
+    function Palette: IPTCPalette;
+    procedure Clip(AArea: IPTCArea);
+    function GetWidth: Integer;
+    function GetHeight: Integer;
+    function GetPitch: Integer;
+    function GetArea: IPTCArea;
+    function Clip: IPTCArea;
+    function GetFormat: IPTCFormat;
+    function Option(const AOption: string): Boolean;
+
+    property Width: Integer read GetWidth;
+    property Height: Integer read GetHeight;
+    property Pitch: Integer read GetPitch;
+    property Area: IPTCArea read GetArea;
+    property Format: IPTCFormat read GetFormat;
+  end;
+
+class function TPTCSurfaceFactory.CreateNew(AWidth, AHeight: Integer; AFormat: IPTCFormat): IPTCSurface;
+begin
+  Result := TPTCSurface.Create(AWidth, AHeight, AFormat);
+end;
+
+constructor TPTCSurface.Create(AWidth, AHeight: Integer; AFormat: IPTCFormat);
 var
   size: Integer;
 begin
@@ -41,7 +109,7 @@ begin
   LOG('format', AFormat);
   FWidth := AWidth;
   FHeight := AHeight;
-  FFormat := TPTCFormat.Create(AFormat);
+  FFormat := AFormat;
   FArea := TPTCArea.Create(0, 0, AWidth, AHeight);
   FClip := TPTCArea.Create(FArea);
   FPitch := AWidth * AFormat.Bytes;
@@ -63,21 +131,17 @@ begin
   end;
   FCopy.Free;
   FClear.Free;
-  FPalette.Free;
-  FClip.Free;
-  FArea.Free;
-  FFormat.Free;
   FreeMem(FPixels);
   inherited Destroy;
 end;
 
-procedure TPTCSurface.Copy(ASurface: TPTCBaseSurface);
+procedure TPTCSurface.Copy(ASurface: IPTCSurface);
 begin
   ASurface.Load(FPixels, FWidth, FHeight, FPitch, FFormat, FPalette);
 end;
 
-procedure TPTCSurface.Copy(ASurface: TPTCBaseSurface;
-                           const ASource, ADestination: TPTCArea);
+procedure TPTCSurface.Copy(ASurface: IPTCSurface;
+                           ASource, ADestination: IPTCArea);
 begin
   ASurface.Load(FPixels, FWidth, FHeight, FPitch, FFormat, FPalette,
                 ASource, ADestination);
@@ -100,10 +164,8 @@ end;
 
 procedure TPTCSurface.Load(const APixels: Pointer;
                            AWidth, AHeight, APitch: Integer;
-                           const AFormat: TPTCFormat;
-                           const APalette: TPTCPalette);
-var
-  Area_: TPTCArea;
+                           AFormat: IPTCFormat;
+                           APalette: IPTCPalette);
 begin
   if FClip.Equals(FArea) then
   begin
@@ -113,51 +175,35 @@ begin
                FWidth, FHeight, FPitch);
   end
   else
-  begin
-    Area_ := TPTCArea.Create(0, 0, AWidth, AHeight);
-    try
-      Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, FArea);
-    finally
-      Area_.Free;
-    end;
-  end;
+    Load(APixels, AWidth, AHeight, APitch, AFormat, APalette,
+         TPTCArea.Create(0, 0, AWidth, AHeight), FArea);
 end;
 
 procedure TPTCSurface.Load(const APixels: Pointer;
                            AWidth, AHeight, APitch: Integer;
-                           const AFormat: TPTCFormat;
-                           const APalette: TPTCPalette;
-                           const ASource, ADestination: TPTCArea);
+                           AFormat: IPTCFormat;
+                           APalette: IPTCPalette;
+                           ASource, ADestination: IPTCArea);
 var
-  clipped_source: TPTCArea = nil;
-  clipped_destination: TPTCArea = nil;
-  area_: TPTCArea = nil;
+  clipped_source: IPTCArea;
+  clipped_destination: IPTCArea;
 begin
-  try
-    clipped_source := TPTCArea.Create;
-    clipped_destination := TPTCArea.Create;
-    area_ := TPTCArea.Create(0, 0, AWidth, AHeight);
-    TPTCClipper.Clip(ASource, area_, clipped_source, ADestination, FClip,
-                     clipped_destination);
-    FCopy.Request(AFormat, FFormat);
-    FCopy.Palette(APalette, FPalette);
-    FCopy.Copy(APixels, clipped_source.left, clipped_source.top,
-               clipped_source.width, clipped_source.height, APitch,
-               FPixels, clipped_destination.left, clipped_destination.top,
-               clipped_destination.width, clipped_destination.height, FPitch);
-  finally
-    clipped_source.Free;
-    clipped_destination.Free;
-    area_.Free;
-  end;
+  TPTCClipper.Clip(ASource, TPTCArea.Create(0, 0, AWidth, AHeight),
+                   clipped_source,
+                   ADestination, FClip,
+                   clipped_destination);
+  FCopy.Request(AFormat, FFormat);
+  FCopy.Palette(APalette, FPalette);
+  FCopy.Copy(APixels, clipped_source.left, clipped_source.top,
+             clipped_source.width, clipped_source.height, APitch,
+             FPixels, clipped_destination.left, clipped_destination.top,
+             clipped_destination.width, clipped_destination.height, FPitch);
 end;
 
 procedure TPTCSurface.Save(APixels: Pointer;
                            AWidth, AHeight, APitch: Integer;
-                           const AFormat: TPTCFormat;
-                           const APalette: TPTCPalette);
-var
-  area_: TPTCArea;
+                           AFormat: IPTCFormat;
+                           APalette: IPTCPalette);
 begin
   if FClip.Equals(FArea) then
   begin
@@ -167,99 +213,71 @@ begin
                AWidth, AHeight, APitch);
   end
   else
-  begin
-    area_ := TPTCArea.Create(0, 0, width, height);
-    try
-      Save(APixels, AWidth, AHeight, APitch, AFormat, APalette, FArea, area_);
-    finally
-      area_.Free;
-    end;
-  end;
+    Save(APixels, AWidth, AHeight, APitch, AFormat, APalette,
+         FArea, TPTCArea.Create(0, 0, width, height));
 end;
 
 procedure TPTCSurface.Save(APixels: Pointer;
                            AWidth, AHeight, APitch: Integer;
-                           const AFormat: TPTCFormat;
-                           const APalette: TPTCPalette;
-                           const ASource, ADestination: TPTCArea);
+                           AFormat: IPTCFormat;
+                           APalette: IPTCPalette;
+                           ASource, ADestination: IPTCArea);
 var
-  clipped_source: TPTCArea = nil;
-  clipped_destination: TPTCArea = nil;
-  area_: TPTCArea = nil;
+  clipped_source: IPTCArea;
+  clipped_destination: IPTCArea;
 begin
-  try
-    clipped_source := TPTCArea.Create;
-    clipped_destination := TPTCArea.Create;
-    area_ := TPTCArea.Create(0, 0, AWidth, AHeight);
-    TPTCClipper.Clip(ASource, FClip, clipped_source, ADestination, area_,
-                     clipped_destination);
-    FCopy.Request(FFormat, AFormat);
-    FCopy.Palette(FPalette, APalette);
-    FCopy.Copy(FPixels, clipped_source.left, clipped_source.top,
-               clipped_source.width, clipped_source.height, FPitch,
-               APixels, clipped_destination.left, clipped_destination.top,
-               clipped_destination.width, clipped_destination.height, APitch);
-  finally
-    clipped_source.Free;
-    clipped_destination.Free;
-    area_.Free;
-  end;
+  TPTCClipper.Clip(ASource, FClip,
+                   clipped_source,
+                   ADestination, TPTCArea.Create(0, 0, AWidth, AHeight),
+                   clipped_destination);
+  FCopy.Request(FFormat, AFormat);
+  FCopy.Palette(FPalette, APalette);
+  FCopy.Copy(FPixels, clipped_source.left, clipped_source.top,
+             clipped_source.width, clipped_source.height, FPitch,
+             APixels, clipped_destination.left, clipped_destination.top,
+             clipped_destination.width, clipped_destination.height, APitch);
 end;
 
 procedure TPTCSurface.Clear;
 var
-  Color: TPTCColor;
+  Color: IPTCColor;
 begin
   if Format.Direct then
     Color := TPTCColor.Create(0, 0, 0, 0)
   else
     Color := TPTCColor.Create(0);
-  try
-    Clear(Color);
-  finally
-    Color.Free;
-  end;
+
+  Clear(Color);
 end;
 
-procedure TPTCSurface.Clear(const AColor: TPTCColor);
+procedure TPTCSurface.Clear(AColor: IPTCColor);
 begin
   Clear(AColor, FArea);
 end;
 
-procedure TPTCSurface.Clear(const AColor: TPTCColor; const AArea: TPTCArea);
+procedure TPTCSurface.Clear(AColor: IPTCColor; AArea: IPTCArea);
 var
-  clipped_area: TPTCArea;
+  clipped_area: IPTCArea;
 begin
-  clipped_area := TPTCClipper.clip(AArea, FClip);
-  try
-    FClear.Request(FFormat);
-    FClear.Clear(FPixels, clipped_area.left, clipped_area.top,
-                 clipped_area.width, clipped_area.height, FPitch, AColor);
-  finally
-    clipped_area.Free;
-  end;
+  clipped_area := TPTCClipper.Clip(AArea, FClip);
+  FClear.Request(FFormat);
+  FClear.Clear(FPixels, clipped_area.left, clipped_area.top,
+               clipped_area.width, clipped_area.height, FPitch, AColor);
 end;
 
-procedure TPTCSurface.Palette(const APalette: TPTCPalette);
+procedure TPTCSurface.Palette(APalette: IPTCPalette);
 begin
-  FPalette.Load(APalette.data^);
+  FPalette.Load(APalette.Data^);
 end;
 
-function TPTCSurface.Palette: TPTCPalette;
+function TPTCSurface.Palette: IPTCPalette;
 begin
   Result := FPalette;
 end;
 
-procedure TPTCSurface.Clip(const AArea: TPTCArea);
-var
-  tmp: TPTCArea;
+procedure TPTCSurface.Clip(AArea: IPTCArea);
 begin
-  tmp := TPTCClipper.Clip(AArea, FArea);
-  try
-    FClip.Assign(tmp);
-  finally
-    tmp.Free;
-  end;
+  FClip := TPTCClipper.Clip(AArea, FArea);
 end;
 
 function TPTCSurface.GetWidth: Integer;
@@ -277,17 +295,17 @@ begin
   Result := FPitch;
 end;
 
-function TPTCSurface.GetArea: TPTCArea;
+function TPTCSurface.GetArea: IPTCArea;
 begin
   Result := FArea;
 end;
 
-function TPTCSurface.Clip: TPTCArea;
+function TPTCSurface.Clip: IPTCArea;
 begin
   Result := FClip;
 end;
 
-function TPTCSurface.GetFormat: TPTCFormat;
+function TPTCSurface.GetFormat: IPTCFormat;
 begin
   Result := FFormat;
 end;

packages/ptc/src/core/timerd.inc

@@ -31,25 +31,7 @@
 }
 
 type
-  TPTCTimer = class
-  private
-    FOld: Double;
-    FTime: Double;
-    FStart: Double;
-    FCurrent: Double;
-    FRunning: Boolean;
-    {$IF defined(WIN32) OR defined(WIN64)}
-    FFrequency: QWord;
-    {$ENDIF defined(WIN32) OR defined(WIN64)}
-    function Clock: Double;
-    procedure internal_init_timer;
-  public
-    constructor Create;
-    constructor Create(ATime: Double);
-    constructor Create(const ATimer: TPTCTimer);
-    destructor Destroy; override;
-    procedure Assign(const ATimer: TPTCTimer);
-    function Equals(const ATimer: TPTCTimer): Boolean;
+  IPTCTimer = interface
     procedure SetTime(ATime: Double); {was 'set' in the C++ version}
     procedure Start;
     procedure Stop;
@@ -57,3 +39,9 @@ type
     function Delta: Double;
     function Resolution: Double;
   end;
+
+  TPTCTimerFactory = class
+  public
+    class function CreateNew: IPTCTimer;
+    class function CreateNew(ATime: Double): IPTCTimer;
+  end;

packages/ptc/src/core/timeri.inc

@@ -30,6 +30,44 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
 
+type
+  TPTCTimer = class(TInterfacedObject, IPTCTimer)
+  private
+    FOld: Double;
+    FTime: Double;
+    FStart: Double;
+    FCurrent: Double;
+    FRunning: Boolean;
+    {$IF defined(WIN32) OR defined(WIN64)}
+    FFrequency: QWord;
+    {$ENDIF defined(WIN32) OR defined(WIN64)}
+    function Clock: Double;
+    procedure internal_init_timer;
+  public
+    constructor Create;
+    constructor Create(ATime: Double);
+//    constructor Create(ATimer: IPTCTimer);
+    destructor Destroy; override;
+{    procedure Assign(const ATimer: TPTCTimer);
+    function Equals(const ATimer: TPTCTimer): Boolean;}
+    procedure SetTime(ATime: Double); {was 'set' in the C++ version}
+    procedure Start;
+    procedure Stop;
+    function Time: Double;
+    function Delta: Double;
+    function Resolution: Double;
+  end;
+
+class function TPTCTimerFactory.CreateNew: IPTCTimer;
+begin
+  Result := TPTCTimer.Create;
+end;
+
+class function TPTCTimerFactory.CreateNew(ATime: Double): IPTCTimer;
+begin
+  Result := TPTCTimer.Create(ATime);
+end;
+
 {Function timeGetTime: DWord; StdCall; external 'WINMM' name 'timeGetTime';}
 
 constructor TPTCTimer.Create;
@@ -53,19 +91,24 @@ begin
   SetTime(ATime);
 end;
 
-constructor TPTCTimer.Create(const ATimer: TPTCTimer);
+{constructor TPTCTimer.Create(ATimer: IPTCTimer);
 begin
   internal_init_timer;
-  Assign(ATimer);
-end;
 
+  FOld := ATimer.FOld;
+  FTime := ATimer.FTime;
+  FStart := ATimer.FStart;
+  FCurrent := ATimer.FCurrent;
+  FRunning := ATimer.FRunning;
+end;
+}
 destructor TPTCTimer.Destroy;
 begin
   Stop;
   inherited Destroy;
 end;
 
-procedure TPTCTimer.Assign(const ATimer: TPTCTimer);
+{procedure TPTCTimer.Assign(const ATimer: TPTCTimer);
 begin
   if Self = ATimer then
     exit;
@@ -83,7 +126,7 @@ begin
             (FStart = ATimer.FStart) and (FCurrent = ATimer.FCurrent) and
             (FRunning = ATimer.FRunning);
 end;
-
+}
 procedure TPTCTimer.SetTime(ATime: Double);
 begin
   FCurrent := ATime;

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

@@ -30,10 +30,10 @@
 }
 
 type
-  TCGAConsole = Class(TPTCBaseConsole)
+  TCGAConsole = class(TPTCBaseConsole)
   private
     { data }
-    m_modes: array [0..255] of TPTCMode;
+    m_modes: array of IPTCMode;
     m_title: string;
     m_information: string;
 
@@ -44,7 +44,7 @@ type
     { option data }
     m_default_width: Integer;
     m_default_height: Integer;
-    m_default_format: TPTCFormat;
+    m_default_format: IPTCFormat;
 
     { objects }
     m_copy: TPTCCopy;
@@ -58,9 +58,9 @@ type
     m_primary: TPTCSurface;
 
     { internal console management routines }
-    procedure internal_pre_open_setup(const _title: String);
+    procedure internal_pre_open_setup(const _title: string);
     procedure internal_open_fullscreen_start;
-    procedure internal_open_fullscreen(_width, _height: Integer; const _format: TPTCFormat);
+    procedure internal_open_fullscreen(_width, _height: Integer; const _format: IPTCFormat);
     procedure internal_open_fullscreen_finish(_pages: Integer);
     procedure internal_post_open_setup;
     procedure internal_reset;
@@ -74,61 +74,61 @@ type
   public
     constructor Create; override;
     destructor Destroy; override;
-    procedure Configure(const AFileName: String); override;
-    function option(const _option: String): Boolean; override;
-    function modes: PPTCMode; override;
+    procedure Configure(const AFileName: string); override;
+    function option(const _option: string): Boolean; override;
+    function modes: TPTCModeList; override;
     procedure open(const _title: string; _pages: Integer); overload; override;
-    procedure open(const _title: string; const _format: TPTCFormat;
+    procedure open(const _title: string; _format: IPTCFormat;
                    _pages: Integer); overload; override;
     procedure open(const _title: string; _width, _height: Integer;
-                   const _format: TPTCFormat; _pages: Integer); overload; override;
-    procedure open(const _title: string; const _mode: TPTCMode;
+                   _format: IPTCFormat; _pages: Integer); overload; override;
+    procedure open(const _title: string; _mode: IPTCMode;
                    _pages: Integer); overload; override;
     procedure close; override;
     procedure flush; override;
     procedure finish; override;
     procedure update; override;
-    procedure update(const _area: TPTCArea); override;
-    procedure copy(surface: TPTCBaseSurface); override;
-    procedure copy(surface: TPTCBaseSurface;
-                   const source, destination: TPTCArea); override;
+    procedure update(_area: IPTCArea); override;
+    procedure copy(surface: IPTCSurface); override;
+    procedure copy(surface: IPTCSurface;
+                   source, destination: IPTCArea); override;
     function lock: Pointer; override;
     procedure unlock; override;
     procedure load(const pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette); override;
     procedure load(const pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette;
-                   const source, destination: TPTCArea); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette;
+                   source, destination: IPTCArea); override;
     procedure save(pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette); override;
     procedure save(pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette;
-                   const source, destination: TPTCArea); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette;
+                   source, destination: IPTCArea); override;
     procedure clear; override;
-    procedure clear(const color: TPTCColor); override;
-    procedure clear(const color: TPTCColor;
-                    const _area: TPTCArea); override;
-    procedure Palette(const _palette: TPTCPalette); override;
-    function Palette: TPTCPalette; override;
-    procedure Clip(const _area: TPTCArea); override;
+    procedure clear(color: IPTCColor); override;
+    procedure clear(color: IPTCColor;
+                    _area: IPTCArea); override;
+    procedure Palette(_palette: IPTCPalette); override;
+    function Palette: IPTCPalette; override;
+    procedure Clip(_area: IPTCArea); 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 GetArea: IPTCArea; override;
+    function Clip: IPTCArea; override;
+    function GetFormat: IPTCFormat; 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;
+    function NextEvent(out event: IPTCEvent; wait: Boolean; const EventMask: TPTCEventMask): Boolean; override;
+    function PeekEvent(wait: Boolean; const EventMask: TPTCEventMask): IPTCEvent; override;
   end;

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

@@ -36,54 +36,37 @@
 {$DEFINE DEFAULT_FORMAT:=TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF)}
 
 constructor TCGAConsole.Create;
-
-var
-  I: Integer;
-
 begin
   inherited Create;
 
   m_open := False;
   m_locked := False;
-  FillChar(m_modes, SizeOf(m_modes), 0);
   m_title := '';
   m_information := '';
   m_default_width := DEFAULT_WIDTH;
   m_default_height := DEFAULT_HEIGHT;
   m_default_format := DEFAULT_FORMAT;
 
-  for I := 0 to 255 do
-    m_modes[I] := TPTCMode.Create;
-
   m_copy := TPTCCopy.Create;
   m_clear := TPTCClear.Create;
   Configure('ptcpas.cfg');
 end;
 
 destructor TCGAConsole.Destroy;
-
-var
-  I: Integer;
-
 begin
   close;
-  for I := 0 to 255 do
-    m_modes[I].Free;
   m_keyboard.Free;
   FMouse.Free;
   FEventQueue.Free;
   m_copy.Free;
   m_clear.Free;
-  m_default_format.Free;
   inherited Destroy;
 end;
 
-procedure TCGAConsole.Configure(const AFileName: String);
-
+procedure TCGAConsole.Configure(const AFileName: string);
 var
-  F: Text;
+  F: TextFile;
   S: string;
-
 begin
   AssignFile(F, AFileName);
   {$I-}
@@ -103,8 +86,7 @@ begin
   CloseFile(F);
 end;
 
-function TCGAConsole.option(const _option: String): Boolean;
-
+function TCGAConsole.option(const _option: string): Boolean;
 begin
   {...}
   if _option = 'enable logging' then
@@ -123,47 +105,33 @@ begin
   Result := m_copy.option(_option);
 end;
 
-function TCGAConsole.modes: PPTCMode;
-
+function TCGAConsole.modes: TPTCModeList;
 begin
-  Result := @m_modes;
+  Result := m_modes;
 end;
 
-procedure TCGAConsole.open(const _title: string; _pages: Integer); overload;
-
+procedure TCGAConsole.Open(const _title: string; _pages: Integer); overload;
 begin
   open(_title, m_default_format, _pages);
 end;
 
-procedure TCGAConsole.open(const _title: string; const _format: TPTCFormat;
+procedure TCGAConsole.open(const _title: string; _format: IPTCFormat;
                            _pages: Integer); overload;
-
 begin
   open(_title, m_default_width, m_default_height, _format, _pages);
 end;
 
 procedure TCGAConsole.open(const _title: string; _width, _height: Integer;
-                           const _format: TPTCFormat; _pages: Integer); overload;
-
-var
-  m: TPTCMode;
-
+                           _format: IPTCFormat; _pages: Integer); overload;
 begin
-  m := TPTCMode.Create(_width, _height, _format);
-  try
-    open(_title, m, _pages);
-  finally
-    m.Free;
-  end;
+  open(_title, TPTCMode.Create(_width, _height, _format), _pages);
 end;
 
-procedure TCGAConsole.open(const _title: string; const _mode: TPTCMode;
+procedure TCGAConsole.open(const _title: string; _mode: IPTCMode;
                            _pages: Integer); overload;
-
 var
   _width, _height: Integer;
-  _format: TPTCFormat;
-
+  _format: IPTCFormat;
 begin
   if not _mode.valid then
     raise TPTCError.Create('invalid mode');
@@ -180,7 +148,6 @@ begin
 end;
 
 procedure TCGAConsole.close;
-
 begin
   if m_open then
   begin
@@ -194,24 +161,20 @@ begin
 end;
 
 procedure TCGAConsole.flush;
-
 begin
   check_open;
   check_unlocked;
 end;
 
 procedure TCGAConsole.finish;
-
 begin
   check_open;
   check_unlocked;
 end;
 
 procedure TCGAConsole.update;
-
 var
   framebuffer: PByte;
-
 begin
   check_open;
   check_unlocked;
@@ -224,17 +187,14 @@ begin
   end;
 end;
 
-procedure TCGAConsole.update(const _area: TPTCArea);
-
+procedure TCGAConsole.update(_area: IPTCArea);
 begin
   update;
 end;
 
-procedure TCGAConsole.copy(surface: TPTCBaseSurface);
-
+procedure TCGAConsole.Copy(surface: IPTCSurface);
 var
   pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -248,16 +208,13 @@ begin
   except
     on error: TPTCError do
       raise TPTCError.Create('failed to copy console to surface', error);
-
   end;
 end;
 
-procedure TCGAConsole.copy(surface: TPTCBaseSurface;
-                           const source, destination: TPTCArea);
-
+procedure TCGAConsole.Copy(surface: IPTCSurface;
+                           source, destination: IPTCArea);
 var
   pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -276,10 +233,8 @@ begin
 end;
 
 function TCGAConsole.lock: Pointer;
-
 var
   pixels: Pointer;
-
 begin
   check_open;
   if m_locked then
@@ -291,7 +246,6 @@ begin
 end;
 
 procedure TCGAConsole.unlock;
-
 begin
   check_open;
   if not m_locked then
@@ -303,12 +257,10 @@ end;
 
 procedure TCGAConsole.load(const pixels: Pointer;
                            _width, _height, _pitch: Integer;
-                           const _format: TPTCFormat;
-                           const _palette: TPTCPalette);
+                           _format: IPTCFormat;
+                           _palette: IPTCPalette);
 var
-  Area_: TPTCArea;
   console_pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -327,70 +279,46 @@ begin
     except
       on error: TPTCError do
         raise TPTCError.Create('failed to load pixels to console', error);
-
     end;
   end
   else
-  begin
-    Area_ := TPTCArea.Create(0, 0, width, height);
-    try
-      load(pixels, _width, _height, _pitch, _format, _palette, Area_, area);
-    finally
-      Area_.Free;
-    end;
-  end;
+    Load(pixels, _width, _height, _pitch, _format, _palette, TPTCArea.Create(0, 0, width, height), area);
 end;
 
 procedure TCGAConsole.load(const pixels: Pointer;
                            _width, _height, _pitch: Integer;
-                           const _format: TPTCFormat;
-                           const _palette: TPTCPalette;
-                           const source, destination: TPTCArea);
+                           _format: IPTCFormat;
+                           _palette: IPTCPalette;
+                           source, destination: IPTCArea);
 var
   console_pixels: Pointer;
-  clipped_source, clipped_destination: TPTCArea;
-  tmp: TPTCArea;
-
+  clipped_source, clipped_destination: IPTCArea;
 begin
   check_open;
   check_unlocked;
-  clipped_source := nil;
-  clipped_destination := nil;
   try
     console_pixels := lock;
     try
-      clipped_source := TPTCArea.Create;
-      clipped_destination := TPTCArea.Create;
-      tmp := TPTCArea.Create(0, 0, _width, _height);
-      try
-        TPTCClipper.clip(source, tmp, clipped_source, destination, clip, clipped_destination);
-      finally
-        tmp.Free;
-      end;
+      TPTCClipper.clip(source, TPTCArea.Create(0, 0, _width, _height), clipped_source, destination, clip, clipped_destination);
       m_copy.request(_format, format);
       m_copy.palette(_palette, palette);
       m_copy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch,
                   console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, pitch);
     finally
       unlock;
-      clipped_source.Free;
-      clipped_destination.Free;
     end;
   except
     on error:TPTCError do
       raise TPTCError.Create('failed to load pixels to console area', error);
-
   end;
 end;
 
 procedure TCGAConsole.save(pixels: Pointer;
                            _width, _height, _pitch: Integer;
-                           const _format: TPTCFormat;
-                           const _palette: TPTCPalette);
+                           _format: IPTCFormat;
+                           _palette: IPTCPalette);
 var
-  Area_: TPTCArea;
   console_pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -413,105 +341,66 @@ begin
     end;
   end
   else
-  begin
-    Area_ := TPTCArea.Create(0, 0, width, height);
-    try
-      save(pixels, _width, _height, _pitch, _format, _palette, area, Area_);
-    finally
-      Area_.Free;
-    end;
-  end;
+    Save(pixels, _width, _height, _pitch, _format, _palette, area, TPTCArea.Create(0, 0, width, height));
 end;
 
 procedure TCGAConsole.save(pixels: Pointer;
                            _width, _height, _pitch: Integer;
-                           const _format: TPTCFormat;
-                           const _palette: TPTCPalette;
-                           const source, destination: TPTCArea);
+                           _format: IPTCFormat;
+                           _palette: IPTCPalette;
+                           source, destination: IPTCArea);
 var
   console_pixels: Pointer;
-  clipped_source, clipped_destination: TPTCArea;
-  tmp: TPTCArea;
-
+  clipped_source, clipped_destination: IPTCArea;
 begin
   check_open;
   check_unlocked;
-  clipped_source := nil;
-  clipped_destination := nil;
   try
     console_pixels := lock;
     try
-      clipped_source := TPTCArea.Create;
-      clipped_destination := TPTCArea.Create;
-      tmp := TPTCArea.Create(0, 0, _width, _height);
-      try
-        TPTCClipper.clip(source, clip, clipped_source, destination, tmp, clipped_destination);
-      finally
-        tmp.Free;
-      end;
+      TPTCClipper.clip(source, clip, clipped_source, destination, TPTCArea.Create(0, 0, _width, _height), clipped_destination);
       m_copy.request(format, _format);
       m_copy.palette(palette, _palette);
       m_copy.copy(console_pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, pitch,
                   pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, _pitch);
     finally
       unlock;
-      clipped_source.Free;
-      clipped_destination.Free;
     end;
   except
     on error:TPTCError do
       raise TPTCError.Create('failed to save console area pixels', error);
-
   end;
 end;
 
-procedure TCGAConsole.clear;
-
+procedure TCGAConsole.Clear;
 var
-  tmp: TPTCColor;
-
+  Color: IPTCColor;
 begin
   check_open;
   check_unlocked;
   if format.direct then
-    tmp := TPTCColor.Create(0, 0, 0, 0)
+    Color := TPTCColor.Create(0, 0, 0, 0)
   else
-    tmp := TPTCColor.Create(0);
-  try
-    clear(tmp);
-  finally
-    tmp.Free;
-  end;
+    Color := TPTCColor.Create(0);
+  Clear(Color);
 end;
 
-procedure TCGAConsole.clear(const color: TPTCColor);
-
-var
-  tmp: TPTCArea;
-
+procedure TCGAConsole.Clear(color: IPTCColor);
 begin
   check_open;
   check_unlocked;
-  tmp := TPTCArea.Create;
-  try
-    clear(color, tmp);
-  finally
-    tmp.Free;
-  end;
+  Clear(color, TPTCArea.Create);
 end;
 
-procedure TCGAConsole.clear(const color: TPTCColor;
-                            const _area: TPTCArea);
-
+procedure TCGAConsole.clear(color: IPTCColor;
+                            _area: IPTCArea);
 var
   pixels: Pointer;
-  clipped_area: TPTCArea;
-
+  clipped_area: IPTCArea;
 begin
   check_open;
   check_unlocked;
   try
-    clipped_area := nil;
     pixels := lock;
     try
       clipped_area := TPTCClipper.clip(_area, clip);
@@ -519,139 +408,111 @@ begin
       m_clear.clear(pixels, clipped_area.left, clipped_area.right, clipped_area.width, clipped_area.height, pitch, color);
     finally
       unlock;
-      clipped_area.Free;
     end;
   except
     on error: TPTCError do
       raise TPTCError.Create('failed to clear console area', error);
-
   end;
 end;
 
-procedure TCGAConsole.Palette(const _palette: TPTCPalette);
-
+procedure TCGAConsole.Palette(_palette: IPTCPalette);
 begin
   check_open;
   m_primary.palette(_palette);
 end;
 
-function TCGAConsole.Palette: TPTCPalette;
-
+function TCGAConsole.Palette: IPTCPalette;
 begin
   check_open;
   Result := m_primary.palette;
 end;
 
-procedure TCGAConsole.Clip(const _area: TPTCArea);
-
+procedure TCGAConsole.Clip(_area: IPTCArea);
 begin
   check_open;
   m_primary.clip(_area);
 end;
 
 function TCGAConsole.GetWidth: Integer;
-
 begin
   check_open;
   Result := m_primary.width;
 end;
 
 function TCGAConsole.GetHeight: Integer;
-
 begin
   check_open;
   Result := m_primary.height;
 end;
 
 function TCGAConsole.GetPitch: Integer;
-
 begin
   check_open;
   Result := m_primary.pitch;
 end;
 
 function TCGAConsole.GetPages: Integer;
-
 begin
   check_open;
   Result := 2;
 end;
 
-function TCGAConsole.GetArea: TPTCArea;
-
+function TCGAConsole.GetArea: IPTCArea;
 begin
   check_open;
   Result := m_primary.area;
 end;
 
-function TCGAConsole.Clip: TPTCArea;
-
+function TCGAConsole.Clip: IPTCArea;
 begin
   check_open;
   Result := m_primary.clip;
 end;
 
-function TCGAConsole.GetFormat: TPTCFormat;
-
+function TCGAConsole.GetFormat: IPTCFormat;
 begin
   check_open;
   Result := m_primary.format;
 end;
 
 function TCGAConsole.GetName: string;
-
 begin
   Result := 'CGA';
 end;
 
 function TCGAConsole.GetTitle: string;
-
 begin
   Result := m_title;
 end;
 
 function TCGAConsole.GetInformation: string;
-
 begin
   Result := m_information;
 end;
 
-procedure TCGAConsole.internal_pre_open_setup(const _title: String);
-
+procedure TCGAConsole.internal_pre_open_setup(const _title: string);
 begin
   m_title := _title;
 end;
 
 procedure TCGAConsole.internal_open_fullscreen_start;
-
-var
-  f: TPTCFormat;
-
 begin
   CGAPrecalc;
 
-  f := TPTCFormat.Create(32, $FF0000, $00FF00, $0000FF);
-  try
-    m_primary := TPTCSurface.Create(320, 200, f);
-  finally
-    f.Free;
-  end;
+  m_primary := TPTCSurface.Create(320, 200, TPTCFormat.Create(32, $FF0000, $00FF00, $0000FF));
 
   CGA320;
 end;
 
-procedure TCGAConsole.internal_open_fullscreen(_width, _height: Integer; const _format: TPTCFormat);
-
+procedure TCGAConsole.internal_open_fullscreen(_width, _height: Integer; const _format: IPTCFormat);
 begin
 end;
 
 procedure TCGAConsole.internal_open_fullscreen_finish(_pages: Integer);
-
 begin
 end;
 
 procedure TCGAConsole.internal_post_open_setup;
-
 begin
   FreeAndNil(m_keyboard);
   FreeAndNil(FMouse);
@@ -668,7 +529,6 @@ begin
 end;
 
 procedure TCGAConsole.internal_reset;
-
 begin
   FreeAndNil(m_primary);
   FreeAndNil(m_keyboard);
@@ -677,7 +537,6 @@ begin
 end;
 
 procedure TCGAConsole.internal_close;
-
 begin
   FreeAndNil(m_primary);
   FreeAndNil(m_keyboard);
@@ -688,18 +547,15 @@ begin
 end;
 
 procedure TCGAConsole.HandleEvents;
-
 begin
   m_keyboard.GetPendingEvents(FEventQueue);
   FMouse.GetPendingEvents(FEventQueue);
 end;
 
-function TCGAConsole.NextEvent(var event: TPTCEvent; wait: Boolean; const EventMask: TPTCEventMask): Boolean;
-
+function TCGAConsole.NextEvent(out event: IPTCEvent; wait: Boolean; const EventMask: TPTCEventMask): Boolean;
 begin
   check_open;
 
-  FreeAndNil(event);
   repeat
     { get events }
     HandleEvents;
@@ -710,8 +566,7 @@ begin
   Result := event <> nil;
 end;
 
-function TCGAConsole.PeekEvent(wait: Boolean; const EventMask: TPTCEventMask): TPTCEvent;
-
+function TCGAConsole.PeekEvent(wait: Boolean; const EventMask: TPTCEventMask): IPTCEvent;
 begin
   check_open;
 
@@ -725,14 +580,12 @@ begin
 end;
 
 procedure TCGAConsole.check_open;
-
 begin
   if not m_open then
     raise TPTCError.Create('console is not open');
 end;
 
 procedure TCGAConsole.check_unlocked;
-
 begin
   if m_locked then
     raise TPTCError.Create('console is not unlocked');

packages/ptc/src/dos/textfx2/textfx2.pp

@@ -69,7 +69,7 @@ const
   use_charset: Pbyte = @charset_b7asc;
   { Character set to use. Can be changed run-time. }
 
-  colmap: PSmallInt = nil;
+  colmap: PWord = nil;
 
 procedure set80x43; { Sets up 80x43, no blink, no cursor. }
 procedure set80x50; { Sets up 80x50, no blink, no cursor. }
@@ -447,7 +447,7 @@ begin
   if colmap <> nil then
     FreeMem(colmap);
   f := 64.0 / COLMAPDIM;
-  colmap := GetMem(SizeOf(SmallInt) * COLMAPDIM * COLMAPDIM * COLMAPDIM);
+  colmap := GetMem(SizeOf(Word) * COLMAPDIM * COLMAPDIM * COLMAPDIM);
   for r := 0 to COLMAPDIM - 1 do
   begin
     for g := 0 to COLMAPDIM - 1 do

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

@@ -30,38 +30,38 @@
 }
 
 type
-  TTextFX2Console = Class(TPTCBaseConsole)
+  TTextFX2Console = class(TPTCBaseConsole)
   private
     { data }
-    m_modes: array [0..255] of TPTCMode;
-    m_title: string;
-    m_information: string;
+    FModes: array of IPTCMode;
+    FTitle: string;
+    FInformation: string;
 
     { flags }
-    m_open: Boolean;
-    m_locked: Boolean;
+    FOpen: Boolean;
+    FLocked: Boolean;
 
     { option data }
-    m_default_width: Integer;
-    m_default_height: Integer;
-    m_default_format: TPTCFormat;
+    FDefaultWidth: Integer;
+    FDefaultHeight: Integer;
+    FDefaultFormat: IPTCFormat;
 
     { objects }
-    m_copy: TPTCCopy;
-    m_clear: TPTCClear;
+    FCopy: TPTCCopy;
+    FClear: TPTCClear;
 
     FEventQueue: TEventQueue;
 
     { Dos objects }
-    m_keyboard: TDosKeyboard;
+    FKeyboard: TDosKeyboard;
     FMouse: TDosMouse;
-    m_primary: TPTCSurface;
-    m_160x100buffer: TPTCSurface;
+    FPrimary: TPTCSurface;
+    F160x100buffer: TPTCSurface;
 
     { internal console management routines }
     procedure internal_pre_open_setup(const _title: String);
     procedure internal_open_fullscreen_start;
-    procedure internal_open_fullscreen(_width, _height: Integer; const _format: TPTCFormat);
+    procedure internal_open_fullscreen(_width, _height: Integer; _format: IPTCFormat);
     procedure internal_open_fullscreen_finish(_pages: Integer);
     procedure internal_post_open_setup;
     procedure internal_reset;
@@ -75,61 +75,61 @@ type
   public
     constructor Create; override;
     destructor Destroy; override;
-    procedure Configure(const AFileName: String); override;
-    function option(const _option: String): Boolean; override;
-    function modes: PPTCMode; override;
+    procedure Configure(const AFileName: string); override;
+    function Option(const AOption: string): Boolean; override;
+    function Modes: TPTCModeList; override;
     procedure open(const _title: string; _pages: Integer); overload; override;
-    procedure open(const _title: string; const _format: TPTCFormat;
+    procedure open(const _title: string; _format: IPTCFormat;
                    _pages: Integer); overload; override;
     procedure open(const _title: string; _width, _height: Integer;
-                   const _format: TPTCFormat; _pages: Integer); overload; override;
-    procedure open(const _title: string; const _mode: TPTCMode;
+                   _format: IPTCFormat; _pages: Integer); overload; override;
+    procedure open(const _title: string; _mode: IPTCMode;
                    _pages: Integer); overload; override;
     procedure close; override;
     procedure flush; override;
     procedure finish; override;
     procedure update; override;
-    procedure update(const _area: TPTCArea); override;
-    procedure copy(surface: TPTCBaseSurface); override;
-    procedure copy(surface: TPTCBaseSurface;
-                   const source, destination: TPTCArea); override;
+    procedure update(_area: IPTCArea); override;
+    procedure copy(surface: IPTCSurface); override;
+    procedure copy(surface: IPTCSurface;
+                   source, destination: IPTCArea); override;
     function lock: Pointer; override;
     procedure unlock; override;
     procedure load(const pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette); override;
     procedure load(const pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette;
-                   const source, destination: TPTCArea); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette;
+                   source, destination: IPTCArea); override;
     procedure save(pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette); override;
     procedure save(pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette;
-                   const source, destination: TPTCArea); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette;
+                   source, destination: IPTCArea); override;
     procedure clear; override;
-    procedure clear(const color: TPTCColor); override;
-    procedure clear(const color: TPTCColor;
-                    const _area: TPTCArea); override;
-    procedure Palette(const _palette: TPTCPalette); override;
-    function Palette: TPTCPalette; override;
-    procedure Clip(const _area: TPTCArea); override;
+    procedure Clear(AColor: IPTCColor); override;
+    procedure clear(color: IPTCColor;
+                    _area: IPTCArea); override;
+    procedure Palette(_palette: IPTCPalette); override;
+    function Palette: IPTCPalette; override;
+    procedure Clip(_area: IPTCArea); 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 GetArea: IPTCArea; override;
+    function Clip: IPTCArea; override;
+    function GetFormat: IPTCFormat; 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;
+    function NextEvent(out event: IPTCEvent; wait: Boolean; const EventMask: TPTCEventMask): Boolean; override;
+    function PeekEvent(wait: Boolean; const EventMask: TPTCEventMask): IPTCEvent; override;
   end;

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

@@ -36,61 +36,44 @@
 {$DEFINE DEFAULT_FORMAT:=TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF)}
 
 constructor TTextFX2Console.Create;
-
-var
-  I: Integer;
-
 begin
   inherited Create;
 
-  m_open := False;
-  m_locked := False;
-  FillChar(m_modes, SizeOf(m_modes), 0);
-  m_title := '';
-  m_information := '';
-  m_default_width := DEFAULT_WIDTH;
-  m_default_height := DEFAULT_HEIGHT;
-  m_default_format := DEFAULT_FORMAT;
-
-  for I := Low(m_modes) to High(m_modes) do
-    m_modes[I] := TPTCMode.Create;
+  FOpen := False;
+  FLocked := False;
+  FTitle := '';
+  FInformation := '';
+  FDefaultWidth := DEFAULT_WIDTH;
+  FDefaultHeight := DEFAULT_HEIGHT;
+  FDefaultFormat := DEFAULT_FORMAT;
 
   calcpal := @calcpal_colorbase;
   use_charset := @charset_b7asc;
   build_colormap(0);
-  m_copy := TPTCCopy.Create;
-  m_clear := TPTCClear.Create;
-  configure('ptcpas.cfg');
+  FCopy := TPTCCopy.Create;
+  FClear := TPTCClear.Create;
+  Configure('ptcpas.cfg');
 end;
 
 destructor TTextFX2Console.Destroy;
-
-var
-  I: Integer;
-
 begin
-  close;
-  m_160x100buffer.Free;
-  m_primary.Free;
+  Close;
+  F160x100buffer.Free;
+  FPrimary.Free;
 
-  for I := Low(m_modes) to High(m_modes) do
-    m_modes[I].Free;
-  m_keyboard.Free;
+  FKeyboard.Free;
   FMouse.Free;
   FEventQueue.Free;
-  m_copy.Free;
-  m_clear.Free;
-  m_default_format.Free;
+  FCopy.Free;
+  FClear.Free;
   dispose_colormap;
   inherited Destroy;
 end;
 
-procedure TTextFX2Console.Configure(const AFileName: String);
-
+procedure TTextFX2Console.Configure(const AFileName: string);
 var
-  F: Text;
+  F: TextFile;
   S: string;
-
 begin
   AssignFile(F, AFileName);
   {$I-}
@@ -110,111 +93,96 @@ begin
   CloseFile(F);
 end;
 
-function TTextFX2Console.option(const _option: String): Boolean;
-
+function TTextFX2Console.Option(const AOption: string): Boolean;
 begin
   {...}
   Result := True;
-  if _option = 'charset_b8ibm' then
+  if AOption = 'charset_b8ibm' then
   begin
     use_charset := @charset_b8ibm;
     exit;
   end;
-  if _option = 'charset_b7asc' then
+  if AOption = 'charset_b7asc' then
   begin
     use_charset := @charset_b7asc;
     exit;
   end;
-  if _option = 'charset_b7sml' then
+  if AOption = 'charset_b7sml' then
   begin
     use_charset := @charset_b7sml;
     exit;
   end;
-  if _option = 'charset_b8gry' then
+  if AOption = 'charset_b8gry' then
   begin
     use_charset := @charset_b8gry;
     exit;
   end;
-  if _option = 'charset_b7nws' then
+  if AOption = 'charset_b7nws' then
   begin
     use_charset := @charset_b7nws;
     exit;
   end;
-  if _option = 'calcpal_colorbase' then
+  if AOption = 'calcpal_colorbase' then
   begin
     calcpal := @calcpal_colorbase;
     build_colormap(0);
     exit;
   end;
-  if _option = 'calcpal_lightbase' then
+  if AOption = 'calcpal_lightbase' then
   begin
     calcpal := @calcpal_lightbase;
     build_colormap(0);
     exit;
   end;
-  if _option = 'calcpal_lightbase_g' then
+  if AOption = 'calcpal_lightbase_g' then
   begin
     calcpal := @calcpal_lightbase_g;
     build_colormap(0);
     exit;
   end;
-  if _option = 'enable logging' then
+  if AOption = 'enable logging' then
   begin
     LOG_enabled := True;
     Result := True;
     exit;
   end;
-  if _option = 'disable logging' then
+  if AOption = 'disable logging' then
   begin
     LOG_enabled := False;
     Result := True;
     exit;
   end;
 
-  Result := m_copy.option(_option);
+  Result := FCopy.Option(AOption);
 end;
 
-function TTextFX2Console.modes: PPTCMode;
-
+function TTextFX2Console.Modes: TPTCModeList;
 begin
-  Result := @m_modes;
+  Result := FModes;
 end;
 
-procedure TTextFX2Console.open(const _title: string; _pages: Integer); overload;
-
+procedure TTextFX2Console.Open(const _title: string; _pages: Integer); overload;
 begin
-  open(_title, m_default_format, _pages);
+  Open(_title, FDefaultFormat, _pages);
 end;
 
-procedure TTextFX2Console.open(const _title: string; const _format: TPTCFormat;
+procedure TTextFX2Console.open(const _title: string; _format: IPTCFormat;
                                _pages: Integer); overload;
-
 begin
-  open(_title, m_default_width, m_default_height, _format, _pages);
+  open(_title, FDefaultWidth, FDefaultHeight, _format, _pages);
 end;
 
 procedure TTextFX2Console.open(const _title: string; _width, _height: Integer;
-                               const _format: TPTCFormat; _pages: Integer); overload;
-
-var
-  m: TPTCMode;
-
+                               _format: IPTCFormat; _pages: Integer); overload;
 begin
-  m := TPTCMode.Create(_width, _height, _format);
-  try
-    open(_title, m, _pages);
-  finally
-    m.Free;
-  end;
+  open(_title, TPTCMode.Create(_width, _height, _format), _pages);
 end;
 
-procedure TTextFX2Console.open(const _title: string; const _mode: TPTCMode;
+procedure TTextFX2Console.open(const _title: string; _mode: IPTCMode;
                                _pages: Integer); overload;
-
 var
   _width, _height: Integer;
-  _format: TPTCFormat;
-
+  _format: IPTCFormat;
 begin
   if not _mode.valid then
     raise TPTCError.Create('invalid mode');
@@ -228,61 +196,53 @@ begin
   internal_post_open_setup;
 end;
 
-procedure TTextFX2Console.close;
-
+procedure TTextFX2Console.Close;
 begin
-  if m_open then
+  if FOpen then
   begin
-    if m_locked then
+    if FLocked then
       raise TPTCError.Create('console is still locked');
     {flush all key presses}
     while KeyPressed do ReadKey;
     internal_close;
-    m_open := False;
+    FOpen := False;
   end;
 end;
 
 procedure TTextFX2Console.flush;
-
 begin
   check_open;
   check_unlocked;
 end;
 
 procedure TTextFX2Console.finish;
-
 begin
   check_open;
   check_unlocked;
 end;
 
 procedure TTextFX2Console.update;
-
 var
   framebuffer: PInteger;
-
 begin
   check_open;
   check_unlocked;
 
-  m_primary.copy(m_160x100buffer);
-  framebuffer := m_160x100buffer.lock;
+  FPrimary.copy(F160x100buffer);
+  framebuffer := F160x100buffer.Lock;
   vrc;
   dump_160x(0, 50, framebuffer);
-  m_160x100buffer.unlock;
+  F160x100buffer.Unlock;
 end;
 
-procedure TTextFX2Console.update(const _area: TPTCArea);
-
+procedure TTextFX2Console.update(_area: IPTCArea);
 begin
   update;
 end;
 
-procedure TTextFX2Console.copy(surface: TPTCBaseSurface);
-
+procedure TTextFX2Console.copy(surface: IPTCSurface);
 var
   pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -296,16 +256,13 @@ begin
   except
     on error: TPTCError do
       raise TPTCError.Create('failed to copy console to surface', error);
-
   end;
 end;
 
-procedure TTextFX2Console.copy(surface: TPTCBaseSurface;
-                               const source, destination: TPTCArea);
-
+procedure TTextFX2Console.copy(surface: IPTCSurface;
+                               source, destination: IPTCArea);
 var
   pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -319,43 +276,37 @@ begin
   except
     on error: TPTCError do
       raise TPTCError.Create('failed to copy console to surface', error);
-
   end;
 end;
 
-function TTextFX2Console.lock: Pointer;
-
+function TTextFX2Console.Lock: Pointer;
 var
   pixels: Pointer;
-
 begin
   check_open;
-  if m_locked then
+  if FLocked then
     raise TPTCError.Create('console is already locked');
-  pixels := m_primary.lock;
-  m_locked := True;
+  pixels := FPrimary.lock;
+  FLocked := True;
   Result := pixels;
 end;
 
-procedure TTextFX2Console.unlock;
-
+procedure TTextFX2Console.Unlock;
 begin
   check_open;
-  if not m_locked then
+  if not FLocked then
     raise TPTCError.Create('console is not locked');
 
-  m_primary.unlock;
-  m_locked := False;
+  FPrimary.unlock;
+  FLocked := False;
 end;
 
-procedure TTextFX2Console.load(const pixels: Pointer;
+procedure TTextFX2Console.Load(const pixels: Pointer;
                                _width, _height, _pitch: Integer;
-                               const _format: TPTCFormat;
-                               const _palette: TPTCPalette);
+                               _format: IPTCFormat;
+                               _palette: IPTCPalette);
 var
-  Area_: TPTCArea;
   console_pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -364,9 +315,9 @@ begin
     try
       console_pixels := lock;
       try
-        m_copy.request(_format, format);
-        m_copy.palette(_palette, palette);
-        m_copy.copy(pixels, 0, 0, _width, _height, _pitch, console_pixels, 0, 0,
+        FCopy.request(_format, format);
+        FCopy.palette(_palette, palette);
+        FCopy.copy(pixels, 0, 0, _width, _height, _pitch, console_pixels, 0, 0,
                     width, height, pitch);
       finally
         unlock;
@@ -374,54 +325,33 @@ begin
     except
       on error: TPTCError do
         raise TPTCError.Create('failed to load pixels to console', error);
-
     end;
   end
   else
-  begin
-    Area_ := TPTCArea.Create(0, 0, width, height);
-    try
-      load(pixels, _width, _height, _pitch, _format, _palette, Area_, area);
-    finally
-      Area_.Free;
-    end;
-  end;
+    Load(pixels, _width, _height, _pitch, _format, _palette, TPTCArea.Create(0, 0, width, height), area);
 end;
 
 procedure TTextFX2Console.load(const pixels: Pointer;
                                _width, _height, _pitch: Integer;
-                               const _format: TPTCFormat;
-                               const _palette: TPTCPalette;
-                               const source, destination: TPTCArea);
+                               _format: IPTCFormat;
+                               _palette: IPTCPalette;
+                               source, destination: IPTCArea);
 var
   console_pixels: Pointer;
-  clipped_source, clipped_destination: TPTCArea;
-  tmp: TPTCArea;
-
+  clipped_source, clipped_destination: IPTCArea;
 begin
   check_open;
   check_unlocked;
-  clipped_source := nil;
-  clipped_destination := nil;
   try
     console_pixels := lock;
     try
-      clipped_source := TPTCArea.Create;
-      clipped_destination := TPTCArea.Create;
-      tmp := TPTCArea.Create(0, 0, _width, _height);
-      try
-        TPTCClipper.clip(source, tmp, clipped_source, destination, clip, clipped_destination);
-      finally
-        tmp.Free;
-      end;
-      m_copy.request(_format, format);
-      m_copy.palette(_palette, palette);
-      m_copy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch,
+      TPTCClipper.clip(source, TPTCArea.Create(0, 0, _width, _height), clipped_source, destination, clip, clipped_destination);
+      FCopy.request(_format, format);
+      FCopy.palette(_palette, palette);
+      FCopy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch,
                   console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, pitch);
     finally
       unlock;
-      clipped_source.Free;
-      clipped_destination.Free;
     end;
   except
     on error:TPTCError do
@@ -432,12 +362,10 @@ end;
 
 procedure TTextFX2Console.save(pixels: Pointer;
                                _width, _height, _pitch: Integer;
-                               const _format: TPTCFormat;
-                               const _palette: TPTCPalette);
+                               _format: IPTCFormat;
+                               _palette: IPTCPalette);
 var
-  Area_: TPTCArea;
   console_pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -446,9 +374,9 @@ begin
     try
       console_pixels := lock;
       try
-        m_copy.request(format, _format);
-        m_copy.palette(palette, _palette);
-        m_copy.copy(console_pixels, 0, 0, width, height, pitch, pixels, 0, 0,
+        FCopy.request(format, _format);
+        FCopy.palette(palette, _palette);
+        FCopy.copy(console_pixels, 0, 0, width, height, pitch, pixels, 0, 0,
                     _width, _height, _pitch);
       finally
         unlock;
@@ -456,117 +384,76 @@ begin
     except
       on error: TPTCError do
         raise TPTCError.Create('failed to save console pixels', error);
-
     end;
   end
   else
-  begin
-    Area_ := TPTCArea.Create(0, 0, width, height);
-    try
-      save(pixels, _width, _height, _pitch, _format, _palette, area, Area_);
-    finally
-      Area_.Free;
-    end;
-  end;
+    Save(pixels, _width, _height, _pitch, _format, _palette, area, TPTCArea.Create(0, 0, width, height));
 end;
 
 procedure TTextFX2Console.save(pixels: Pointer;
                                _width, _height, _pitch: Integer;
-                               const _format: TPTCFormat;
-                               const _palette: TPTCPalette;
-                               const source, destination: TPTCArea);
+                               _format: IPTCFormat;
+                               _palette: IPTCPalette;
+                               source, destination: IPTCArea);
 var
   console_pixels: Pointer;
-  clipped_source, clipped_destination: TPTCArea;
-  tmp: TPTCArea;
-
+  clipped_source, clipped_destination: IPTCArea;
 begin
   check_open;
   check_unlocked;
-  clipped_source := nil;
-  clipped_destination := nil;
   try
     console_pixels := lock;
     try
-      clipped_source := TPTCArea.Create;
-      clipped_destination := TPTCArea.Create;
-      tmp := TPTCArea.Create(0, 0, _width, _height);
-      try
-        TPTCClipper.clip(source, clip, clipped_source, destination, tmp, clipped_destination);
-      finally
-        tmp.Free;
-      end;
-      m_copy.request(format, _format);
-      m_copy.palette(palette, _palette);
-      m_copy.copy(console_pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, pitch,
-                  pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, _pitch);
+      TPTCClipper.clip(source, clip, clipped_source, destination, TPTCArea.Create(0, 0, _width, _height), clipped_destination);
+      FCopy.request(format, _format);
+      FCopy.palette(palette, _palette);
+      FCopy.copy(console_pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, pitch,
+                 pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, _pitch);
     finally
       unlock;
-      clipped_source.Free;
-      clipped_destination.Free;
     end;
   except
     on error:TPTCError do
       raise TPTCError.Create('failed to save console area pixels', error);
-
   end;
 end;
 
 procedure TTextFX2Console.clear;
-
 var
-  tmp: TPTCColor;
-
+  Color: IPTCColor;
 begin
   check_open;
   check_unlocked;
   if format.direct then
-    tmp := TPTCColor.Create(0, 0, 0, 0)
+    Color := TPTCColor.Create(0, 0, 0, 0)
   else
-    tmp := TPTCColor.Create(0);
-  try
-    clear(tmp);
-  finally
-    tmp.Free;
-  end;
+    Color := TPTCColor.Create(0);
+  Clear(Color);
 end;
 
-procedure TTextFX2Console.clear(const color: TPTCColor);
-
-var
-  tmp: TPTCArea;
-
+procedure TTextFX2Console.Clear(AColor: IPTCColor);
 begin
   check_open;
   check_unlocked;
-  tmp := TPTCArea.Create;
-  try
-    clear(color, tmp);
-  finally
-    tmp.Free;
-  end;
+  Clear(AColor, TPTCArea.Create);
 end;
 
-procedure TTextFX2Console.clear(const color: TPTCColor;
-                                const _area: TPTCArea);
-
+procedure TTextFX2Console.clear(color: IPTCColor;
+                                _area: IPTCArea);
 var
   pixels: Pointer;
-  clipped_area: TPTCArea;
-
+  clipped_area: IPTCArea;
 begin
   check_open;
   check_unlocked;
   try
-    clipped_area := nil;
     pixels := lock;
     try
       clipped_area := TPTCClipper.clip(_area, clip);
-      m_clear.request(format);
-      m_clear.clear(pixels, clipped_area.left, clipped_area.right, clipped_area.width, clipped_area.height, pitch, color);
+      FClear.request(format);
+      FClear.clear(pixels, clipped_area.left, clipped_area.right, clipped_area.width, clipped_area.height, pitch, color);
     finally
       unlock;
-      clipped_area.Free;
     end;
   except
     on error: TPTCError do
@@ -575,176 +462,145 @@ begin
   end;
 end;
 
-procedure TTextFX2Console.Palette(const _palette: TPTCPalette);
-
+procedure TTextFX2Console.Palette(_palette: IPTCPalette);
 begin
   check_open;
-  m_primary.palette(_palette);
+  FPrimary.palette(_palette);
 end;
 
-function TTextFX2Console.Palette: TPTCPalette;
-
+function TTextFX2Console.Palette: IPTCPalette;
 begin
   check_open;
-  Result := m_primary.palette;
+  Result := FPrimary.palette;
 end;
 
-procedure TTextFX2Console.Clip(const _area: TPTCArea);
-
+procedure TTextFX2Console.Clip(_area: IPTCArea);
 begin
   check_open;
-  m_primary.clip(_area);
+  FPrimary.clip(_area);
 end;
 
 function TTextFX2Console.GetWidth: Integer;
-
 begin
   check_open;
-  Result := m_primary.width;
+  Result := FPrimary.width;
 end;
 
 function TTextFX2Console.GetHeight: Integer;
-
 begin
   check_open;
-  Result := m_primary.height;
+  Result := FPrimary.height;
 end;
 
 function TTextFX2Console.GetPitch: Integer;
-
 begin
   check_open;
-  Result := m_primary.pitch;
+  Result := FPrimary.pitch;
 end;
 
 function TTextFX2Console.GetPages: Integer;
-
 begin
   check_open;
-  Result := 2;{m_primary.pages;}
+  Result := 2;{FPrimary.pages;}
 end;
 
-function TTextFX2Console.GetArea: TPTCArea;
-
+function TTextFX2Console.GetArea: IPTCArea;
 begin
   check_open;
-  Result := m_primary.area;
+  Result := FPrimary.area;
 end;
 
-function TTextFX2Console.Clip: TPTCArea;
-
+function TTextFX2Console.Clip: IPTCArea;
 begin
   check_open;
-  Result := m_primary.clip;
+  Result := FPrimary.clip;
 end;
 
-function TTextFX2Console.GetFormat: TPTCFormat;
-
+function TTextFX2Console.GetFormat: IPTCFormat;
 begin
   check_open;
-  Result := m_primary.format;
+  Result := FPrimary.format;
 end;
 
 function TTextFX2Console.GetName: string;
-
 begin
   Result := 'TextFX2';
 end;
 
 function TTextFX2Console.GetTitle: string;
-
 begin
-  Result := m_title;
+  Result := FTitle;
 end;
 
 function TTextFX2Console.GetInformation: string;
-
 begin
-  Result := m_information;
+  Result := FInformation;
 end;
 
-procedure TTextFX2Console.internal_pre_open_setup(const _title: String);
-
+procedure TTextFX2Console.internal_pre_open_setup(const _title: string);
 begin
-  m_title := _title;
+  FTitle := _title;
 end;
 
 procedure TTextFX2Console.internal_open_fullscreen_start;
-
-var
-  f: TPTCFormat;
-
 begin
-  f := TPTCFormat.Create(32, $0000FF, $00FF00, $FF0000);
-  try
-    m_160x100buffer := TPTCSurface.Create(160, 100, f);
-  finally
-    f.Free;
-  end;
+  F160x100buffer := TPTCSurface.Create(160, 100, TPTCFormat.Create(32, $0000FF, $00FF00, $FF0000));
   set80x50;
 end;
 
-procedure TTextFX2Console.internal_open_fullscreen(_width, _height: Integer; const _format: TPTCFormat);
-
+procedure TTextFX2Console.internal_open_fullscreen(_width, _height: Integer; _format: IPTCFormat);
 begin
-  m_primary := TPTCSurface.Create(_width, _height, _format);
+  FPrimary := TPTCSurface.Create(_width, _height, _format);
 end;
 
 procedure TTextFX2Console.internal_open_fullscreen_finish(_pages: Integer);
-
 begin
 end;
 
 procedure TTextFX2Console.internal_post_open_setup;
-
 begin
-  FreeAndNil(m_keyboard);
+  FreeAndNil(FKeyboard);
   FreeAndNil(FMouse);
   FreeAndNil(FEventQueue);
-  m_keyboard := TDosKeyboard.Create;
-  FMouse := TDosMouse.Create(m_primary.width, m_primary.height);
+  FKeyboard := TDosKeyboard.Create;
+  FMouse := TDosMouse.Create(FPrimary.width, FPrimary.height);
   FEventQueue := TEventQueue.Create;
 
   { temporary platform dependent information fudge }
-  m_information := 'dos version x.xx.x, TextFX2, ...';
+  FInformation := 'dos version x.xx.x, TextFX2, ...';
 
   { set open flag }
-  m_open := True;
+  FOpen := True;
 end;
 
 procedure TTextFX2Console.internal_reset;
-
 begin
-  FreeAndNil(m_primary);
-  FreeAndNil(m_keyboard);
+  FreeAndNil(FPrimary);
+  FreeAndNil(FKeyboard);
   FreeAndNil(FMouse);
   FreeAndNil(FEventQueue);
 end;
 
 procedure TTextFX2Console.internal_close;
-
 begin
-  FreeAndNil(m_primary);
-  FreeAndNil(m_160x100buffer);
-  FreeAndNil(m_keyboard);
+  FreeAndNil(FPrimary);
+  FreeAndNil(F160x100buffer);
+  FreeAndNil(FKeyboard);
   FreeAndNil(FMouse);
   FreeAndNil(FEventQueue);
   set80x25;
 end;
 
 procedure TTextFX2Console.HandleEvents;
-
 begin
-  m_keyboard.GetPendingEvents(FEventQueue);
+  FKeyboard.GetPendingEvents(FEventQueue);
   FMouse.GetPendingEvents(FEventQueue);
 end;
 
-function TTextFX2Console.NextEvent(var event: TPTCEvent; wait: Boolean; const EventMask: TPTCEventMask): Boolean;
-
+function TTextFX2Console.NextEvent(out event: IPTCEvent; wait: Boolean; const EventMask: TPTCEventMask): Boolean;
 begin
   check_open;
 
-  FreeAndNil(event);
   repeat
     { get events }
     HandleEvents;
@@ -755,8 +611,7 @@ begin
   Result := event <> nil;
 end;
 
-function TTextFX2Console.PeekEvent(wait: Boolean; const EventMask: TPTCEventMask): TPTCEvent;
-
+function TTextFX2Console.PeekEvent(wait: Boolean; const EventMask: TPTCEventMask): IPTCEvent;
 begin
   check_open;
 
@@ -770,15 +625,13 @@ begin
 end;
 
 procedure TTextFX2Console.check_open;
-
 begin
-  if not m_open then
+  if not FOpen then
     raise TPTCError.Create('console is not open');
 end;
 
 procedure TTextFX2Console.check_unlocked;
-
 begin
-  if m_locked then
+  if FLocked then
     raise TPTCError.Create('console is not unlocked');
 end;

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

@@ -33,7 +33,7 @@ type
   TVESAConsole = class(TPTCBaseConsole)
   private
     { data }
-    FModes: array of TPTCMode;
+    FModes: array of IPTCMode;
     FModesLast: Integer;
     FModesN: array of record
       Index: Integer;
@@ -66,16 +66,16 @@ type
     FDefaultWidth: Integer;
     FDefaultHeight: Integer;
 //    FDefaultPages: Integer;
-    FDefaultFormat: TPTCFormat;
+    FDefaultFormat: IPTCFormat;
 
     { objects }
     FCopy: TPTCCopy;
-    FArea: TPTCArea;
-    FClip: TPTCArea;
-//    FFormat: TPTCFormat;
+    FArea: IPTCArea;
+    FClip: IPTCArea;
+//    FFormat: IPTCFormat;
 
 //    FClear: TPTCClear;
-    FPalette: TPTCPalette;
+    FPalette: IPTCPalette;
 
     FEventQueue: TEventQueue;
 
@@ -85,7 +85,7 @@ type
 
     { internal console management routines }
     procedure internal_close;
-    function FindBestMode(const AMode: TPTCMode): Integer;
+    function FindBestMode(const AMode: IPTCMode): Integer;
     
     procedure UpdateModeList;
     procedure EnableLFB;
@@ -101,61 +101,61 @@ type
   public
     constructor Create; override;
     destructor Destroy; override;
-    procedure Configure(const AFileName: String); override;
-    function Option(const AOption: String): Boolean; override;
-    function Modes: PPTCMode; override;
+    procedure Configure(const AFileName: string); override;
+    function Option(const AOption: string): Boolean; override;
+    function Modes: TPTCModeList; override;
     procedure Open(const ATitle: string; APages: Integer); overload; override;
-    procedure Open(const ATitle: string; const AFormat: TPTCFormat;
+    procedure Open(const ATitle: string; AFormat: IPTCFormat;
                    APages: Integer); overload; override;
     procedure Open(const ATitle: string; AWidth, AHeight: Integer;
-                   const AFormat: TPTCFormat; APages: Integer); overload; override;
-    procedure Open(const ATitle: string; const AMode: TPTCMode;
+                   AFormat: IPTCFormat; APages: Integer); overload; override;
+    procedure Open(const ATitle: string; AMode: IPTCMode;
                    APages: Integer); overload; override;
     procedure Close; override;
     procedure Flush; override;
     procedure Finish; override;
     procedure Update; override;
-    procedure Update(const AArea: TPTCArea); override;
-    procedure Copy(ASurface: TPTCBaseSurface); override;
-    procedure Copy(ASurface: TPTCBaseSurface;
-                   const ASource, ADestination: TPTCArea); override;
+    procedure Update(AArea: IPTCArea); override;
+    procedure Copy(ASurface: IPTCSurface); override;
+    procedure Copy(ASurface: IPTCSurface;
+                   ASource, ADestination: IPTCArea); override;
     function Lock: Pointer; override;
     procedure Unlock; override;
     procedure Load(const APixels: Pointer;
                    AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette); override;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette); override;
     procedure Load(const APixels: Pointer;
                    AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette;
-                   const ASource, ADestination: TPTCArea); override;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea); override;
     procedure Save(APixels: Pointer;
                    AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette); override;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette); override;
     procedure Save(APixels: Pointer;
                    AWidth, AHeight, APitch: Integer;
-                   const AFormat: TPTCFormat;
-                   const APalette: TPTCPalette;
-                   const ASource, ADestination: TPTCArea); override;
+                   AFormat: IPTCFormat;
+                   APalette: IPTCPalette;
+                   ASource, ADestination: IPTCArea); override;
     procedure Clear; override;
-    procedure Clear(const AColor: TPTCColor); override;
-    procedure Clear(const AColor: TPTCColor;
-                    const AArea: TPTCArea); override;
-    procedure Palette(const APalette: TPTCPalette); override;
-    function Palette: TPTCPalette; override;
-    procedure Clip(const AArea: TPTCArea); override;
+    procedure Clear(AColor: IPTCColor); override;
+    procedure Clear(AColor: IPTCColor;
+                    AArea: IPTCArea); override;
+    procedure Palette(APalette: IPTCPalette); override;
+    function Palette: IPTCPalette; override;
+    procedure Clip(AArea: IPTCArea); 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 GetArea: IPTCArea; override;
+    function Clip: IPTCArea; override;
+    function GetFormat: IPTCFormat; override;
     function GetName: string; override;
     function GetTitle: string; override;
     function GetInformation: string; override;
-    function NextEvent(var AEvent: TPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
-    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): TPTCEvent; override;
+    function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
+    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
   end;

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

@@ -73,24 +73,13 @@ begin
 end;
 
 destructor TVESAConsole.Destroy;
-var
-  I: Integer;
 begin
   Close;
   
-  for I := Low(FModes) to High(FModes) do
-    FreeAndNil(FModes[I]);
-  SetLength(FModes, 0);
-  SetLength(FModesN, 0);
-  
   FKeyboard.Free;
   FMouse.Free;
   FEventQueue.Free;
   FCopy.Free;
-  FDefaultFormat.Free;
-  FPalette.Free;
-  FArea.Free;
-  FClip.Free;
   inherited Destroy;
 end;
 
@@ -99,10 +88,7 @@ var
   I, J: Integer;
   r, g, b, a: DWord;
   tmpbpp: Integer;
-  tmp: TPTCFormat;
 begin
-  for I := Low(FModes) to High(FModes) do
-    FreeAndNil(FModes[I]);
   SetLength(FModes, 0);
   SetLength(FModesN, 0);
 
@@ -134,8 +120,8 @@ begin
             (BitsPerPixel = 24) or
             (BitsPerPixel = 32)) then
         begin
-	  if FTryWindowed and SupportsWindowed then
-	  begin
+          if FTryWindowed and SupportsWindowed then
+          begin
             Inc(J);
             r := MakeMask(WindowedRedMaskSize, WindowedRedFieldPosition);
             g := MakeMask(WindowedGreenMaskSize, WindowedGreenFieldPosition);
@@ -146,17 +132,12 @@ begin
               tmpbpp := 16
             else
               tmpbpp := BitsPerPixel;
-            tmp := TPTCFormat.Create(tmpbpp, r, g, b, a);
-            try
-	      SetLength(FModes, J + 1);
-	      SetLength(FModesN, J + 1);
-              FModes[J] := TPTCMode.Create(XResolution, YResolution, tmp);
-              FModesN[J].Index := I;
-	      FModesN[J].SupportsWindowed := true;
-            finally
-              tmp.Free;
-            end;
-	  end;
+            SetLength(FModes, J + 1);
+            SetLength(FModesN, J + 1);
+            FModes[J] := TPTCMode.Create(XResolution, YResolution, TPTCFormat.Create(tmpbpp, r, g, b, a));
+            FModesN[J].Index := I;
+            FModesN[J].SupportsWindowed := true;
+          end;
 	  
 	  if FTryLFB and SupportsLFB then
 	  begin
@@ -184,16 +165,11 @@ begin
                 tmpbpp := 16
               else
                 tmpbpp := BitsPerPixel;
-              tmp := TPTCFormat.Create(tmpbpp, r, g, b, a);
-              try
-	        SetLength(FModes, J + 1);
-	        SetLength(FModesN, J + 1);
-                FModes[J] := TPTCMode.Create(XResolution, YResolution, tmp);
-                FModesN[J].Index := I;
-  	        FModesN[J].SupportsLFB := true;
-              finally
-                tmp.Free;
-              end;
+              SetLength(FModes, J + 1);
+              SetLength(FModesN, J + 1);
+              FModes[J] := TPTCMode.Create(XResolution, YResolution, TPTCFormat.Create(tmpbpp, r, g, b, a));
+              FModesN[J].Index := I;
+              FModesN[J].SupportsLFB := true;
 	    end;
 	  end;
 {          Inc(FModesLast)}
@@ -202,38 +178,28 @@ begin
           if (MemoryModel = vmmmPackedPixel) and (BitsPerPixel = 8) then
           begin
             Inc(J);
-            tmp := TPTCFormat.Create(8);
-            try
-              SetLength(FModes, J + 1);
-              SetLength(FModesN, J + 1);
-              FModes[J] := TPTCMode.Create(XResolution, YResolution, tmp);
-              FModesN[J].Index := I;
-	      FModesN[J].SupportsWindowed := FTryWindowed and SupportsWindowed;
-	      FModesN[J].SupportsLFB := FTryLFB and SupportsLFB;
-            finally
-              tmp.Free;
-            end;
+            SetLength(FModes, J + 1);
+            SetLength(FModesN, J + 1);
+            FModes[J] := TPTCMode.Create(XResolution, YResolution, TPTCFormat.Create(8));
+            FModesN[J].Index := I;
+            FModesN[J].SupportsWindowed := FTryWindowed and SupportsWindowed;
+            FModesN[J].SupportsLFB := FTryLFB and SupportsLFB;
             Inc(J);
-            tmp := TPTCFormat.Create(8, $E0, $1C, $03); {RGB 332}
-            try
-              SetLength(FModes, J + 1);
-              SetLength(FModesN, J + 1);
-              FModes[J] := TPTCMode.Create(XResolution, YResolution, tmp);
-              FModesN[J].Index := I;
-	      FModesN[J].SupportsWindowed := FTryWindowed and SupportsWindowed;
-	      FModesN[J].SupportsLFB := FTryLFB and SupportsLFB;
-            finally
-              tmp.Free;
-            end;
+			
+            {RGB 332}
+            SetLength(FModes, J + 1);
+            SetLength(FModesN, J + 1);
+            FModes[J] := TPTCMode.Create(XResolution, YResolution, TPTCFormat.Create(8, $E0, $1C, $03));
+            FModesN[J].Index := I;
+            FModesN[J].SupportsWindowed := FTryWindowed and SupportsWindowed;
+            FModesN[J].SupportsLFB := FTryLFB and SupportsLFB;
 {           Inc(FModesLast, 2);}
           end;
 
   FModesLast := J;
-  SetLength(FModes, FModesLast + 2);
-  FModes[FModesLast + 1] := TPTCMode.Create; {mark end of list!}
 end;
 
-procedure TVESAConsole.Configure(const AFileName: String);
+procedure TVESAConsole.Configure(const AFileName: string);
 var
   F: TextFile;
   S: string;
@@ -394,12 +360,12 @@ begin
   Result := FCopy.Option(AOption);
 end;
 
-function TVESAConsole.Modes: PPTCMode;
+function TVESAConsole.Modes: TPTCModeList;
 begin
-  Result := @FModes[0];
+  Result := FModes;
 end;
 
-function TVESAConsole.FindBestMode(const AMode: TPTCMode): Integer;
+function TVESAConsole.FindBestMode(const AMode: IPTCMode): Integer;
 var
   I: Integer;
   modefound, bestmodefound: Integer;
@@ -491,26 +457,19 @@ begin
   Open(ATitle, FDefaultFormat, APages);
 end;
 
-procedure TVESAConsole.Open(const ATitle: string; const AFormat: TPTCFormat;
+procedure TVESAConsole.Open(const ATitle: string; AFormat: IPTCFormat;
                             APages: Integer); overload;
 begin
   Open(ATitle, FDefaultWidth, FDefaultHeight, AFormat, APages);
 end;
 
 procedure TVESAConsole.Open(const ATitle: string; AWidth, AHeight: Integer;
-                            const AFormat: TPTCFormat; APages: Integer); overload;
-var
-  m: TPTCMode;
+                            AFormat: IPTCFormat; APages: Integer); overload;
 begin
-  m := TPTCMode.Create(AWidth, AHeight, AFormat);
-  try
-    Open(ATitle, m, APages);
-  finally
-    m.Free;
-  end;
+  Open(ATitle, TPTCMode.Create(AWidth, AHeight, AFormat), APages);
 end;
 
-procedure TVESAConsole.Open(const ATitle: string; const AMode: TPTCMode;
+procedure TVESAConsole.Open(const ATitle: string; AMode: IPTCMode;
                             APages: Integer); overload;
 
   procedure SetRGB332Palette;
@@ -556,7 +515,6 @@ procedure TVESAConsole.Open(const ATitle: string; const AMode: TPTCMode;
 
 var
   ModeFound: Integer;
-  tmpa: TPTCArea;
 begin
   ModeFound := FindBestMode(AMode);
 
@@ -592,7 +550,7 @@ begin
   
   FVESACurrentMode := FModesN[ModeFound].Index;
 
-  with FModes[FCurrentMode].FFormat do
+  with FModes[FCurrentMode].Format do
     if (Bits = 8) and Direct and (R = $E0) and (G = $1C) and (B = $03) then
       SetRGB332Palette;
 
@@ -622,13 +580,8 @@ begin
     else
       FNextVideoPage := 0;
   end;
-  tmpa := TPTCArea.Create(0, 0, FWidth, FHeight);
-  try
-    FArea.Assign(tmpa);
-    FClip.Assign(tmpa);
-  finally
-    tmpa.Free;
-  end;
+  FArea := TPTCArea.Create(0, 0, FWidth, FHeight);
+  FClip := FArea;
 
   FLFBNearPtrAccessAvailable := LFBNearPtrAccessAvailable;
   if not FLFBNearPtrAccessAvailable then
@@ -710,12 +663,12 @@ begin
   end;
 end;
 
-procedure TVESAConsole.Update(const AArea: TPTCArea);
+procedure TVESAConsole.Update(AArea: IPTCArea);
 begin
   Update;
 end;
 
-procedure TVESAConsole.Copy(ASurface: TPTCBaseSurface);
+procedure TVESAConsole.Copy(ASurface: IPTCSurface);
 var
   Pixels: Pointer;
 begin
@@ -734,8 +687,8 @@ begin
   end;
 end;
 
-procedure TVESAConsole.Copy(ASurface: TPTCBaseSurface;
-                            const ASource, ADestination: TPTCArea);
+procedure TVESAConsole.Copy(ASurface: IPTCSurface;
+                            ASource, ADestination: IPTCArea);
 var
   pixels: Pointer;
 begin
@@ -780,10 +733,9 @@ end;
 
 procedure TVESAConsole.Load(const APixels: Pointer;
                             AWidth, AHeight, APitch: Integer;
-                            const AFormat: TPTCFormat;
-                            const APalette: TPTCPalette);
+                            AFormat: IPTCFormat;
+                            APalette: IPTCPalette);
 var
-  Area_: TPTCArea;
   ConsolePixels: Pointer;
 begin
   check_open;
@@ -808,66 +760,44 @@ begin
     end;
   end
   else
-  begin
-    Area_ := TPTCArea.Create(0, 0, Width, Height);
-    try
-      Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area_, Area);
-    finally
-      Area_.Free;
-    end;
-  end;
+    Load(APixels, AWidth, AHeight, APitch, AFormat, APalette, TPTCArea.Create(0, 0, Width, Height), Area);
 end;
 
 procedure TVESAConsole.Load(const APixels: Pointer;
                             AWidth, AHeight, APitch: Integer;
-                            const AFormat: TPTCFormat;
-                            const APalette: TPTCPalette;
-                            const ASource, ADestination: TPTCArea);
+                            AFormat: IPTCFormat;
+                            APalette: IPTCPalette;
+                            ASource, ADestination: IPTCArea);
 var
   ConsolePixels: Pointer;
-  ClippedSource: TPTCArea = nil;
-  ClippedDestination: TPTCArea = nil;
-  tmp: TPTCArea;
+  ClippedSource, ClippedDestination: IPTCArea;
 begin
   check_open;
   check_unlocked;
+  ConsolePixels := Lock;
   try
-    ClippedSource := TPTCArea.Create;
-    ClippedDestination := TPTCArea.Create;
-    ConsolePixels := Lock;
     try
-      try
-        tmp := TPTCArea.Create(0, 0, AWidth, AHeight);
-        try
-          TPTCClipper.Clip(ASource, tmp, ClippedSource, ADestination, Clip, ClippedDestination);
-        finally
-          tmp.Free;
-        end;
-        FCopy.Request(AFormat, Format);
-        FCopy.Palette(APalette, Palette);
-        FCopy.Copy(APixels, ClippedSource.Left, ClippedSource.Top, ClippedSource.Width, ClippedSource.Height, APitch,
-                    ConsolePixels, ClippedDestination.Left, ClippedDestination.Top, ClippedDestination.Width, ClippedDestination.Height, Pitch);
-      except
-        on error:TPTCError do
-        begin
-          raise TPTCError.Create('failed to load pixels to console area', error);
-        end;
+      TPTCClipper.Clip(ASource, TPTCArea.Create(0, 0, AWidth, AHeight), ClippedSource, ADestination, Clip, ClippedDestination);
+      FCopy.Request(AFormat, Format);
+      FCopy.Palette(APalette, Palette);
+      FCopy.Copy(APixels, ClippedSource.Left, ClippedSource.Top, ClippedSource.Width, ClippedSource.Height, APitch,
+                 ConsolePixels, ClippedDestination.Left, ClippedDestination.Top, ClippedDestination.Width, ClippedDestination.Height, Pitch);
+    except
+      on error:TPTCError do
+      begin
+        raise TPTCError.Create('failed to load pixels to console area', error);
       end;
-    finally
-      Unlock;
     end;
   finally
-    ClippedSource.Free;
-    ClippedDestination.Free;
+    Unlock;
   end;
 end;
 
 procedure TVESAConsole.Save(APixels: Pointer;
                             AWidth, AHeight, APitch: Integer;
-                            const AFormat: TPTCFormat;
-                            const APalette: TPTCPalette);
+                            AFormat: IPTCFormat;
+                            APalette: IPTCPalette);
 var
-  Area_: TPTCArea;
   ConsolePixels: Pointer;
 begin
   check_open;
@@ -892,100 +822,70 @@ begin
     end;
   end
   else
-  begin
-    Area_ := TPTCArea.Create(0, 0, Width, Height);
-    try
-      Save(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area, Area_);
-    finally
-      Area_.Free;
-    end;
-  end;
+    Save(APixels, AWidth, AHeight, APitch, AFormat, APalette, Area, TPTCArea.Create(0, 0, Width, Height));
 end;
 
 procedure TVESAConsole.Save(APixels: Pointer;
                             AWidth, AHeight, APitch: Integer;
-                            const AFormat: TPTCFormat;
-                            const APalette: TPTCPalette;
-                            const ASource, ADestination: TPTCArea);
+                            AFormat: IPTCFormat;
+                            APalette: IPTCPalette;
+                            ASource, ADestination: IPTCArea);
 var
   ConsolePixels: Pointer;
-  ClippedSource: TPTCArea = nil;
-  ClippedDestination: TPTCArea = nil;
-  tmp: TPTCArea;
+  ClippedSource, ClippedDestination: IPTCArea;
 begin
   check_open;
   check_unlocked;
+  ConsolePixels := Lock;
   try
-    ClippedSource := TPTCArea.Create;
-    ClippedDestination := TPTCArea.Create;
-    ConsolePixels := Lock;
     try
-      try
-        tmp := TPTCArea.Create(0, 0, AWidth, AHeight);
-        try
-          TPTCClipper.Clip(ASource, Clip, ClippedSource, ADestination, tmp, ClippedDestination);
-        finally
-          tmp.Free;
-        end;
-        FCopy.Request(Format, AFormat);
-        FCopy.Palette(Palette, APalette);
-        FCopy.Copy(ConsolePixels, ClippedSource.Left, ClippedSource.Top, ClippedSource.Width, ClippedSource.Height, Pitch,
-                    APixels, ClippedDestination.Left, ClippedDestination.Top, ClippedDestination.Width, ClippedDestination.Height, APitch);
-      except
-        on error:TPTCError do
-        begin
-          raise TPTCError.Create('failed to save console area pixels', error);
-        end;
+      TPTCClipper.Clip(ASource, Clip, ClippedSource, ADestination, TPTCArea.Create(0, 0, AWidth, AHeight), ClippedDestination);
+      FCopy.Request(Format, AFormat);
+      FCopy.Palette(Palette, APalette);
+      FCopy.Copy(ConsolePixels, ClippedSource.Left, ClippedSource.Top, ClippedSource.Width, ClippedSource.Height, Pitch,
+                 APixels, ClippedDestination.Left, ClippedDestination.Top, ClippedDestination.Width, ClippedDestination.Height, APitch);
+    except
+      on error:TPTCError do
+      begin
+        raise TPTCError.Create('failed to save console area pixels', error);
       end;
-    finally
-      Unlock;
     end;
   finally
-    ClippedSource.Free;
-    ClippedDestination.Free;
+    Unlock;
   end;
 end;
 
 procedure TVESAConsole.Clear;
 var
-  tmp: TPTCColor;
+  Color: IPTCColor;
 begin
   check_open;
   check_unlocked;
   if Format.Direct then
-    tmp := TPTCColor.Create(0, 0, 0, 0)
+    Color := TPTCColor.Create(0, 0, 0, 0)
   else
-    tmp := TPTCColor.Create(0);
-  try
-    Clear(tmp);
-  finally
-    tmp.Free;
-  end;
+    Color := TPTCColor.Create(0);
+  Clear(Color);
 end;
 
-procedure TVESAConsole.Clear(const AColor: TPTCColor);
+procedure TVESAConsole.Clear(AColor: IPTCColor);
 var
   tmp: TPTCArea;
 begin
   check_open;
   check_unlocked;
-  tmp := TPTCArea.Create;
-  try
-    Clear(AColor, tmp);
-  finally
-    tmp.Free;
-  end;
+  Clear(AColor, TPTCArea.Create);
 end;
 
-procedure TVESAConsole.Clear(const AColor: TPTCColor;
-                             const AArea: TPTCArea);
+procedure TVESAConsole.Clear(AColor: IPTCColor;
+                             AArea: IPTCArea);
 begin
   check_open;
   check_unlocked;
   {...}
 end;
 
-procedure TVESAConsole.Palette(const APalette: TPTCPalette);
+procedure TVESAConsole.Palette(APalette: IPTCPalette);
 begin
   check_open;
 
@@ -996,23 +896,18 @@ begin
   end;
 end;
 
-function TVESAConsole.Palette: TPTCPalette;
+function TVESAConsole.Palette: IPTCPalette;
 begin
   check_open;
   Result := FPalette;
 end;
 
-procedure TVESAConsole.Clip(const AArea: TPTCArea);
+procedure TVESAConsole.Clip(AArea: IPTCArea);
 var
   tmp: TPTCArea;
 begin
   check_open;
-  tmp := TPTCClipper.Clip(AArea, FArea);
-  try
-    FClip.Assign(tmp);
-  finally
-    tmp.Free;
-  end;
+  FClip := TPTCClipper.Clip(AArea, FArea);
 end;
 
 function TVESAConsole.GetWidth: Integer;
@@ -1039,19 +934,19 @@ begin
   Result := 2;{FPrimary.pages;}
 end;
 
-function TVESAConsole.GetArea: TPTCArea;
+function TVESAConsole.GetArea: IPTCArea;
 begin
   check_open;
   Result := FArea;
 end;
 
-function TVESAConsole.Clip: TPTCArea;
+function TVESAConsole.Clip: IPTCArea;
 begin
   check_open;
   Result := FClip;
 end;
 
-function TVESAConsole.GetFormat: TPTCFormat;
+function TVESAConsole.GetFormat: IPTCFormat;
 begin
   check_open;
   Result := FModes[FCurrentMode].Format;
@@ -1087,11 +982,10 @@ begin
   FMouse.GetPendingEvents(FEventQueue);
 end;
 
-function TVESAConsole.NextEvent(var AEvent: TPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
+function TVESAConsole.NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
 begin
   check_open;
 
-  FreeAndNil(AEvent);
   repeat
     { get events }
     HandleEvents;
@@ -1102,7 +996,7 @@ begin
   Result := AEvent <> nil;
 end;
 
-function TVESAConsole.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): TPTCEvent;
+function TVESAConsole.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent;
 begin
   check_open;
 

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

@@ -30,10 +30,10 @@
 }
 
 type
-  TVGAConsole = Class(TPTCBaseConsole)
+  TVGAConsole = class(TPTCBaseConsole)
   private
     { data }
-    m_modes: array [0..31{255}] of TPTCMode;
+    m_modes: array of IPTCMode;
     m_title: string;
     m_information: string;
     m_CurrentMode: Integer;
@@ -48,15 +48,15 @@ type
     { option data }
     m_default_width: Integer;
     m_default_height: Integer;
-    m_default_format: TPTCFormat;
+    m_default_format: IPTCFormat;
 
     { objects }
     m_copy: TPTCCopy;
-    m_area: TPTCArea;
-    m_clip: TPTCArea;
+    m_area: IPTCArea;
+    m_clip: IPTCArea;
 
     m_clear: TPTCClear;
-    m_palette: TPTCPalette;
+    m_palette: IPTCPalette;
 
     FEventQueue: TEventQueue;
 
@@ -65,7 +65,7 @@ type
     FMouse: TDosMouse;
 
     { internal console management routines }
-    procedure internal_pre_open_setup(const _title: String);
+    procedure internal_pre_open_setup(const _title: string);
     procedure internal_open_fullscreen_start;
     procedure internal_open_fullscreen(ModeType: Integer);
     procedure internal_open_fullscreen_finish(_pages: Integer);
@@ -85,61 +85,61 @@ type
   public
     constructor Create; override;
     destructor Destroy; override;
-    procedure Configure(const AFileName: String); override;
-    function option(const _option: String): Boolean; override;
-    function modes: PPTCMode; override;
+    procedure Configure(const AFileName: string); override;
+    function Option(const _option: string): Boolean; override;
+    function modes: TPTCModeList; override;
     procedure open(const _title: string; _pages: Integer); overload; override;
-    procedure open(const _title: string; const _format: TPTCFormat;
+    procedure open(const _title: string; _format: IPTCFormat;
                    _pages: Integer); overload; override;
     procedure open(const _title: string; _width, _height: Integer;
-                   const _format: TPTCFormat; _pages: Integer); overload; override;
-    procedure open(const _title: string; const _mode: TPTCMode;
+                   _format: IPTCFormat; _pages: Integer); overload; override;
+    procedure open(const _title: string; _mode: IPTCMode;
                    _pages: Integer); overload; override;
     procedure close; override;
     procedure flush; override;
     procedure finish; override;
     procedure update; override;
-    procedure update(const _area: TPTCArea); override;
-    procedure copy(surface: TPTCBaseSurface); override;
-    procedure copy(surface: TPTCBaseSurface;
-                   const source, destination: TPTCArea); override;
+    procedure update(_area: IPTCArea); override;
+    procedure copy(surface: IPTCSurface); override;
+    procedure copy(surface: IPTCSurface;
+                   source, destination: IPTCArea); override;
     function lock: Pointer; override;
     procedure unlock; override;
     procedure load(const pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette); override;
     procedure load(const pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette;
-                   const source, destination: TPTCArea); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette;
+                   source, destination: IPTCArea); override;
     procedure save(pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette); override;
     procedure save(pixels: Pointer;
                    _width, _height, _pitch: Integer;
-                   const _format: TPTCFormat;
-                   const _palette: TPTCPalette;
-                   const source, destination: TPTCArea); override;
+                   _format: IPTCFormat;
+                   _palette: IPTCPalette;
+                   source, destination: IPTCArea); override;
     procedure clear; override;
-    procedure clear(const color: TPTCColor); override;
-    procedure clear(const color: TPTCColor;
-                    const _area: TPTCArea); override;
-    procedure Palette(const _palette: TPTCPalette); override;
-    function Palette: TPTCPalette; override;
-    procedure Clip(const _area: TPTCArea); override;
+    procedure Clear(AColor: IPTCColor); override;
+    procedure clear(color: IPTCColor;
+                    _area: IPTCArea); override;
+    procedure Palette(_palette: IPTCPalette); override;
+    function Palette: IPTCPalette; override;
+    procedure Clip(_area: IPTCArea); 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 GetArea: IPTCArea; override;
+    function Clip: IPTCArea; override;
+    function GetFormat: IPTCFormat; 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;
+    function NextEvent(out event: IPTCEvent; wait: Boolean; const EventMask: TPTCEventMask): Boolean; override;
+    function PeekEvent(wait: Boolean; const EventMask: TPTCEventMask): IPTCEvent; override;
   end;

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

@@ -38,10 +38,6 @@
 {$ASMMODE intel}
 
 constructor TVGAConsole.Create;
-
-var
-  fmt1, fmt2, fmt3: TPTCFormat;
-
 begin
   inherited Create;
 
@@ -61,29 +57,17 @@ begin
   m_clear := TPTCClear.Create;
   m_palette := TPTCPalette.Create;
 
-  fmt1 := nil;
-  fmt2 := nil;
-  fmt3 := nil;
-  try
-    fmt1 := TPTCFormat.Create(8);
-    fmt2 := TPTCFormat.Create(8, $E0, $1C, $03);
-    fmt3 := TPTCFormat.Create(16, $F800, $7E0, $1F);
-    m_modes[0] := TPTCMode.Create(320, 200, fmt1);
-    m_modes[1] := TPTCMode.Create(320, 200, fmt2);
-    m_modes[2] := TPTCMode.Create(320, 200, fmt3);
-    m_modes[3] := TPTCMode.Create;
-  finally
-    fmt1.Free;
-    fmt2.Free;
-    fmt3.Free;
-  end;
+  SetLength(m_modes, 3);
+  m_modes[0] := TPTCMode.Create(320, 200, TPTCFormat.Create(8));
+  m_modes[1] := TPTCMode.Create(320, 200, TPTCFormat.Create(8, $E0, $1C, $03));
+  m_modes[2] := TPTCMode.Create(320, 200, TPTCFormat.Create(16, $F800, $7E0, $1F));
+
   m_faketype := FAKEMODE2A;
 
   configure('ptcpas.cfg');
 end;
 
 destructor TVGAConsole.Destroy;
-
 begin
   close;
   internal_clear_mode_list;
@@ -92,19 +76,13 @@ begin
   FEventQueue.Free;
   m_copy.Free;
   m_clear.Free;
-  m_default_format.Free;
-  m_palette.Free;
-  m_clip.Free;
-  m_area.Free;
   inherited Destroy;
 end;
 
-procedure TVGAConsole.Configure(const AFileName: String);
-
+procedure TVGAConsole.Configure(const AFileName: string);
 var
-  F: Text;
+  F: TextFile;
   S: string;
-
 begin
   AssignFile(F, AFileName);
   {$I-}
@@ -124,8 +102,7 @@ begin
   CloseFile(F);
 end;
 
-function TVGAConsole.option(const _option: String): Boolean;
-
+function TVGAConsole.option(const _option: string): Boolean;
 begin
   {...}
   if (System.Copy(_option, 1, 8) = 'FAKEMODE') and (Length(_option) = 10) and
@@ -169,62 +146,37 @@ begin
 end;
 
 procedure TVGAConsole.internal_clear_mode_list;
-
-var
-  I: Integer;
-  Done: Boolean;
-
 begin
-  I := 0;
-  Done := False;
-  repeat
-    Done := not m_modes[I].valid;
-    m_modes[I].Free;
-    Inc(I);
-  until Done;
+  SetLength(m_modes, 0);
 end;
 
-function TVGAConsole.modes: PPTCMode;
-
+function TVGAConsole.modes: TPTCModeList;
 begin
   Result := m_modes;
 end;
 
 procedure TVGAConsole.open(const _title: string; _pages: Integer); overload;
-
 begin
   open(_title, m_default_format, _pages);
 end;
 
-procedure TVGAConsole.open(const _title: string; const _format: TPTCFormat;
+procedure TVGAConsole.open(const _title: string; _format: IPTCFormat;
                            _pages: Integer); overload;
-
 begin
   open(_title, m_default_width, m_default_height, _format, _pages);
 end;
 
 procedure TVGAConsole.open(const _title: string; _width, _height: Integer;
-                           const _format: TPTCFormat; _pages: Integer); overload;
-
-var
-  m: TPTCMode;
-
+                           _format: IPTCFormat; _pages: Integer); overload;
 begin
-  m := TPTCMode.Create(_width, _height, _format);
-  try
-    open(_title, m, _pages);
-  finally
-    m.Free;
-  end;
+  open(_title, TPTCMode.Create(_width, _height, _format), _pages);
 end;
 
-procedure TVGAConsole.open(const _title: string; const _mode: TPTCMode;
+procedure TVGAConsole.open(const _title: string; _mode: IPTCMode;
                            _pages: Integer); overload;
-
 var
   I: Integer;
   modetype: Integer;
-
 begin
   if not _mode.valid then
     raise TPTCError.Create('invalid mode');
@@ -243,7 +195,6 @@ begin
 end;
 
 procedure TVGAConsole.close;
-
 begin
   if m_open then
   begin
@@ -257,22 +208,19 @@ begin
 end;
 
 procedure TVGAConsole.flush;
-
 begin
   check_open;
   check_unlocked;
 end;
 
 procedure TVGAConsole.finish;
-
 begin
   check_open;
   check_unlocked;
 end;
 
-procedure TVGAConsole.vga_load(data: Pointer); ASSembler; Register;
-
-Asm
+procedure TVGAConsole.vga_load(data: Pointer); ASSembler; register;
+asm
   push es
   mov esi, data
   mov ax, fs
@@ -285,7 +233,6 @@ Asm
 end;
 
 procedure TVGAConsole.update;
-
 begin
   check_open;
   check_unlocked;
@@ -299,17 +246,14 @@ begin
   end;
 end;
 
-procedure TVGAConsole.update(const _area: TPTCArea);
-
+procedure TVGAConsole.update(_area: IPTCArea);
 begin
   update;
 end;
 
-procedure TVGAConsole.copy(surface: TPTCBaseSurface);
-
+procedure TVGAConsole.copy(surface: IPTCSurface);
 var
   pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -323,16 +267,13 @@ begin
   except
     on error: TPTCError do
       raise TPTCError.Create('failed to copy console to surface', error);
-
   end;
 end;
 
-procedure TVGAConsole.copy(surface: TPTCBaseSurface;
-                           const source, destination: TPTCArea);
-
+procedure TVGAConsole.copy(surface: IPTCSurface;
+                           source, destination: IPTCArea);
 var
   pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -346,12 +287,10 @@ begin
   except
     on error: TPTCError do
       raise TPTCError.Create('failed to copy console to surface', error);
-
   end;
 end;
 
 function TVGAConsole.lock: Pointer;
-
 begin
   check_open;
   if m_locked then
@@ -362,7 +301,6 @@ begin
 end;
 
 procedure TVGAConsole.unlock;
-
 begin
   check_open;
   if not m_locked then
@@ -371,14 +309,12 @@ begin
   m_locked := False;
 end;
 
-procedure TVGAConsole.load(const pixels: Pointer;
+procedure TVGAConsole.Load(const pixels: Pointer;
                            _width, _height, _pitch: Integer;
-                           const _format: TPTCFormat;
-                           const _palette: TPTCPalette);
+                           _format: IPTCFormat;
+                           _palette: IPTCPalette);
 var
-  Area_: TPTCArea;
   console_pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -397,70 +333,46 @@ begin
     except
       on error: TPTCError do
         raise TPTCError.Create('failed to load pixels to console', error);
-
     end;
   end
   else
-  begin
-    Area_ := TPTCArea.Create(0, 0, width, height);
-    try
-      load(pixels, _width, _height, _pitch, _format, _palette, Area_, area);
-    finally
-      Area_.Free;
-    end;
-  end;
+    Load(pixels, _width, _height, _pitch, _format, _palette, TPTCArea.Create(0, 0, width, height), area);
 end;
 
-procedure TVGAConsole.load(const pixels: Pointer;
+procedure TVGAConsole.Load(const pixels: Pointer;
                            _width, _height, _pitch: Integer;
-                           const _format: TPTCFormat;
-                           const _palette: TPTCPalette;
-                           const source, destination: TPTCArea);
+                           _format: IPTCFormat;
+                           _palette: IPTCPalette;
+                           source, destination: IPTCArea);
 var
   console_pixels: Pointer;
-  clipped_source, clipped_destination: TPTCArea;
-  tmp: TPTCArea;
-
+  clipped_source, clipped_destination: IPTCArea;
 begin
   check_open;
   check_unlocked;
-  clipped_source := nil;
-  clipped_destination := nil;
   try
     console_pixels := lock;
     try
-      clipped_source := TPTCArea.Create;
-      clipped_destination := TPTCArea.Create;
-      tmp := TPTCArea.Create(0, 0, _width, _height);
-      try
-        TPTCClipper.clip(source, tmp, clipped_source, destination, clip, clipped_destination);
-      finally
-        tmp.Free;
-      end;
+      TPTCClipper.clip(source, TPTCArea.Create(0, 0, _width, _height), clipped_source, destination, clip, clipped_destination);
       m_copy.request(_format, format);
       m_copy.palette(_palette, palette);
       m_copy.copy(pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, _pitch,
                   console_pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, pitch);
     finally
       unlock;
-      clipped_source.Free;
-      clipped_destination.Free;
     end;
   except
     on error:TPTCError do
       raise TPTCError.Create('failed to load pixels to console area', error);
-
   end;
 end;
 
 procedure TVGAConsole.save(pixels: Pointer;
                            _width, _height, _pitch: Integer;
-                           const _format: TPTCFormat;
-                           const _palette: TPTCPalette);
+                           _format: IPTCFormat;
+                           _palette: IPTCPalette);
 var
-  Area_: TPTCArea;
   console_pixels: Pointer;
-
 begin
   check_open;
   check_unlocked;
@@ -479,109 +391,69 @@ begin
     except
       on error: TPTCError do
         raise TPTCError.Create('failed to save console pixels', error);
-
     end;
   end
   else
-  begin
-    Area_ := TPTCArea.Create(0, 0, width, height);
-    try
-      save(pixels, _width, _height, _pitch, _format, _palette, area, Area_);
-    finally
-      Area_.Free;
-    end;
-  end;
+    Save(pixels, _width, _height, _pitch, _format, _palette, area, TPTCArea.Create(0, 0, width, height));
 end;
 
-procedure TVGAConsole.save(pixels: Pointer;
+procedure TVGAConsole.Save(pixels: Pointer;
                            _width, _height, _pitch: Integer;
-                           const _format: TPTCFormat;
-                           const _palette: TPTCPalette;
-                           const source, destination: TPTCArea);
+                           _format: IPTCFormat;
+                           _palette: IPTCPalette;
+                           source, destination: IPTCArea);
 var
   console_pixels: Pointer;
-  clipped_source, clipped_destination: TPTCArea;
-  tmp: TPTCArea;
-
+  clipped_source, clipped_destination: IPTCArea;
 begin
   check_open;
   check_unlocked;
-  clipped_source := nil;
-  clipped_destination := nil;
   try
     console_pixels := lock;
     try
-      clipped_source := TPTCArea.Create;
-      clipped_destination := TPTCArea.Create;
-      tmp := TPTCArea.Create(0, 0, _width, _height);
-      try
-        TPTCClipper.clip(source, clip, clipped_source, destination, tmp, clipped_destination);
-      finally
-        tmp.Free;
-      end;
+      TPTCClipper.clip(source, clip, clipped_source, destination, TPTCArea.Create(0, 0, _width, _height), clipped_destination);
       m_copy.request(format, _format);
       m_copy.palette(palette, _palette);
       m_copy.copy(console_pixels, clipped_source.left, clipped_source.top, clipped_source.width, clipped_source.height, pitch,
                   pixels, clipped_destination.left, clipped_destination.top, clipped_destination.width, clipped_destination.height, _pitch);
     finally
       unlock;
-      clipped_source.Free;
-      clipped_destination.Free;
     end;
   except
     on error:TPTCError do
       raise TPTCError.Create('failed to save console area pixels', error);
-
   end;
 end;
 
 procedure TVGAConsole.clear;
-
 var
-  tmp: TPTCColor;
-
+  Color: IPTCColor;
 begin
   check_open;
   check_unlocked;
   if format.direct then
-    tmp := TPTCColor.Create(0, 0, 0, 0)
+    Color := TPTCColor.Create(0, 0, 0, 0)
   else
-    tmp := TPTCColor.Create(0);
-  try
-    clear(tmp);
-  finally
-    tmp.Free;
-  end;
+    Color := TPTCColor.Create(0);
+  Clear(Color);
 end;
 
-procedure TVGAConsole.clear(const color: TPTCColor);
-
-var
-  tmp: TPTCArea;
-
+procedure TVGAConsole.clear(AColor: IPTCColor);
 begin
   check_open;
   check_unlocked;
-  tmp := TPTCArea.Create;
-  try
-    clear(color, tmp);
-  finally
-    tmp.Free;
-  end;
+  Clear(AColor, TPTCArea.Create);
 end;
 
-procedure TVGAConsole.clear(const color: TPTCColor;
-                            const _area: TPTCArea);
-
+procedure TVGAConsole.clear(color: IPTCColor;
+                            _area: IPTCArea);
 var
   pixels: Pointer;
-  clipped_area: TPTCArea;
-
+  clipped_area: IPTCArea;
 begin
   check_open;
   check_unlocked;
   try
-    clipped_area := nil;
     pixels := lock;
     try
       clipped_area := TPTCClipper.clip(_area, clip);
@@ -589,17 +461,14 @@ begin
       m_clear.clear(pixels, clipped_area.left, clipped_area.right, clipped_area.width, clipped_area.height, pitch, color);
     finally
       unlock;
-      clipped_area.Free;
     end;
   except
     on error: TPTCError do
       raise TPTCError.Create('failed to clear console area', error);
-
   end;
 end;
 
-procedure TVGAConsole.Palette(const _palette: TPTCPalette);
-
+procedure TVGAConsole.Palette(_palette: IPTCPalette);
 begin
   check_open;
   if format.indexed then
@@ -609,111 +478,85 @@ begin
   end;
 end;
 
-function TVGAConsole.Palette: TPTCPalette;
-
+function TVGAConsole.Palette: IPTCPalette;
 begin
   check_open;
   Result := m_palette;
 end;
 
-procedure TVGAConsole.Clip(const _area: TPTCArea);
-
-var
-  tmp: TPTCArea;
-
+procedure TVGAConsole.Clip(_area: IPTCArea);
 begin
   check_open;
-  tmp := TPTCClipper.clip(_area, m_area);
-  try
-    m_clip.Assign(tmp);
-  finally
-    tmp.Free;
-  end;
+  m_clip := TPTCClipper.clip(_area, m_area);
 end;
 
 function TVGAConsole.GetWidth: Integer;
-
 begin
   check_open;
   Result := m_width;
 end;
 
 function TVGAConsole.GetHeight: Integer;
-
 begin
   check_open;
   Result := m_height;
 end;
 
 function TVGAConsole.GetPitch: Integer;
-
 begin
   check_open;
   Result := m_pitch;
 end;
 
 function TVGAConsole.GetPages: Integer;
-
 begin
   check_open;
   Result := 2;
 end;
 
-function TVGAConsole.GetArea: TPTCArea;
-
+function TVGAConsole.GetArea: IPTCArea;
 begin
   check_open;
   Result := m_area;
 end;
 
-function TVGAConsole.Clip: TPTCArea;
-
+function TVGAConsole.Clip: IPTCArea;
 begin
   check_open;
   Result := m_clip;
 end;
 
-function TVGAConsole.GetFormat: TPTCFormat;
-
+function TVGAConsole.GetFormat: IPTCFormat;
 begin
   check_open;
   Result := m_modes[m_CurrentMode].format;
 end;
 
 function TVGAConsole.GetName: string;
-
 begin
   Result := 'VGA';
 end;
 
 function TVGAConsole.GetTitle: string;
-
 begin
   Result := m_title;
 end;
 
 function TVGAConsole.GetInformation: string;
-
 begin
   Result := m_information;
 end;
 
-procedure TVGAConsole.internal_pre_open_setup(const _title: String);
-
+procedure TVGAConsole.internal_pre_open_setup(const _title: string);
 begin
   m_title := _title;
 end;
 
 procedure TVGAConsole.internal_open_fullscreen_start;
-
 begin
 end;
 
 procedure TVGAConsole.internal_open_fullscreen(ModeType: Integer);
-
-var
-  tmp: TPTCArea;
-
 begin
   VGASetMode(320, 200, ModeType, m_faketype);
   case ModeType of
@@ -733,17 +576,11 @@ begin
   m_width := 320;
   m_height := 200;
 
-  tmp := TPTCArea.Create(0, 0, m_width, m_height);
-  try
-    m_area.Assign(tmp);
-    m_clip.Assign(tmp);
-  finally
-    tmp.Free;
-  end;
+  m_area := TPTCArea.Create(0, 0, m_width, m_height);
+  m_clip := m_area;
 end;
 
 procedure TVGAConsole.internal_open_fullscreen_finish(_pages: Integer);
-
 begin
   FreeMemAndNil(m_primary);
   m_primary := GetMem(m_height * m_pitch);
@@ -751,7 +588,6 @@ begin
 end;
 
 procedure TVGAConsole.internal_post_open_setup;
-
 begin
   FreeAndNil(m_keyboard);
   FreeAndNil(FMouse);
@@ -768,7 +604,6 @@ begin
 end;
 
 procedure TVGAConsole.internal_reset;
-
 begin
   FreeMemAndNil(m_primary);
   FreeAndNil(m_keyboard);
@@ -777,7 +612,6 @@ begin
 end;
 
 procedure TVGAConsole.internal_close;
-
 begin
   FreeMemAndNil(m_primary);
   FreeAndNil(m_keyboard);
@@ -788,11 +622,9 @@ begin
 end;
 
 procedure TVGAConsole.internal_SetPalette(data: PUint32);
-
 var
   i: Integer;
   c: DWord;
-
 begin
   outportb($3C8, 0);
   for i := 0 to 255 do
@@ -806,18 +638,15 @@ begin
 end;
 
 procedure TVGAConsole.HandleEvents;
-
 begin
   m_keyboard.GetPendingEvents(FEventQueue);
   FMouse.GetPendingEvents(FEventQueue);
 end;
 
-function TVGAConsole.NextEvent(var event: TPTCEvent; wait: Boolean; const EventMask: TPTCEventMask): Boolean;
-
+function TVGAConsole.NextEvent(out event: IPTCEvent; wait: Boolean; const EventMask: TPTCEventMask): Boolean;
 begin
   check_open;
 
-  FreeAndNil(event);
   repeat
     { get events }
     HandleEvents;
@@ -828,8 +657,7 @@ begin
   Result := event <> nil;
 end;
 
-function TVGAConsole.PeekEvent(wait: Boolean; const EventMask: TPTCEventMask): TPTCEvent;
-
+function TVGAConsole.PeekEvent(wait: Boolean; const EventMask: TPTCEventMask): IPTCEvent;
 begin
   check_open;
 
@@ -843,14 +671,12 @@ begin
 end;
 
 procedure TVGAConsole.check_open;
-
 begin
   if not m_open then
     raise TPTCError.Create('console is not open');
 end;
 
 procedure TVGAConsole.check_unlocked;
-
 begin
   if m_locked then
     raise TPTCError.Create('console is not unlocked');