--- Merging r15916 into '.':

U    rtl/inc/sstrings.inc
--- Merging r15935 into '.':
U    rtl/win64/system.pp
--- Merging r16057 into 'compiler/utils':
U    compiler/utils/gppc386.pp
--- Merging r16075 into '.':
U    rtl/inc/heap.inc
U    rtl/inc/heaph.inc
--- Merging r16082 into '.':
U    packages/fcl-json/src/README.txt
--- Merging r16088 into '.':
U    packages/imagemagick/src/imagemagick.pas
--- Merging r16089 into '.':
U    rtl/win/sysfile.inc
U    rtl/win/sysos.inc
--- Merging r16090 into '.':
A    tests/webtbs/tw17550.pp
--- Merging r16092 into '.':
U    rtl/inc/ustrings.inc
U    rtl/inc/wstrings.inc
--- Merging r16093 into '.':
A    tests/webtbs/tw17514.pp
--- Merging r16099 into '.':
U    rtl/objpas/sysutils/dati.inc
--- Merging r16107 into '.':
U    packages/fcl-process/src/unix/process.inc
--- Merging r16115 into '.':
U    packages/graph/src/ptcgraph/ptcgraph.pp
--- Merging r16123 into '.':
U    rtl/linux/arm/sighnd.inc
--- Merging r16131 into '.':
U    utils/fppkg/fppkg.pp
C    utils/fppkg/pkgoptions.pp
--- Merging r16141 into '.':
U    packages/graph/src/ptcgraph/ptccrt.pp
--- Merging r16142 into '.':
D    packages/ptc/src/x11/x11dgadisplayi.inc
D    packages/ptc/src/x11/x11dgadisplayd.inc
--- Merging r16143 into '.':
A    packages/ptc/src/c_api/capi_aread.inc
A    packages/ptc/src/c_api/capi_color.inc
A    packages/ptc/src/c_api/capi_copyd.inc
A    packages/ptc/src/c_api/capi_timer.inc
A    packages/ptc/src/c_api/capi_colord.inc
A    packages/ptc/src/c_api/capi_timerd.inc
A    packages/ptc/src/c_api/capi_mode.inc
A    packages/ptc/src/c_api/capi_clear.inc
A    packages/ptc/src/c_api/capi_surface.inc
A    packages/ptc/src/c_api/capi_moded.inc
A    packages/ptc/src/c_api/capi_key.inc
A    packages/ptc/src/c_api/capi_format.inc
A    packages/ptc/src/c_api/capi_except.inc
A    packages/ptc/src/c_api/capi_error.inc
A    packages/ptc/src/c_api/capi_cleard.inc
A    packages/ptc/src/c_api/capi_exceptd.inc
A    packages/ptc/src/c_api/capi_formatd.inc
A    packages/ptc/src/c_api/capi_keyd.inc
A    packages/ptc/src/c_api/capi_surfaced.inc
A    packages/ptc/src/c_api/capi_errord.inc
A    packages/ptc/src/c_api/capi_clipper.inc
A    packages/ptc/src/c_api/capi_palette.inc
A    packages/ptc/src/c_api/capi_console.inc
A    packages/ptc/src/c_api/capi_clipperd.inc
A    packages/ptc/src/c_api/capi_paletted.inc
A    packages/ptc/src/c_api/capi_consoled.inc
A    packages/ptc/src/c_api/capi_index.inc
A    packages/ptc/src/c_api/capi_area.inc
A    packages/ptc/src/c_api/capi_copy.inc
D    packages/ptc/src/c_api/console.inc
D    packages/ptc/src/c_api/clipperd.inc
D    packages/ptc/src/c_api/paletted.inc
D    packages/ptc/src/c_api/consoled.inc
D    packages/ptc/src/c_api/index.inc
D    packages/ptc/src/c_api/area.inc
D    packages/ptc/src/c_api/copy.inc
D    packages/ptc/src/c_api/aread.inc
D    packages/ptc/src/c_api/copyd.inc
D    packages/ptc/src/c_api/color.inc
D    packages/ptc/src/c_api/timer.inc
D    packages/ptc/src/c_api/colord.inc
D    packages/ptc/src/c_api/mode.inc
D    packages/ptc/src/c_api/timerd.inc
D    packages/ptc/src/c_api/clear.inc
D    packages/ptc/src/c_api/except.inc
D    packages/ptc/src/c_api/format.inc
D    packages/ptc/src/c_api/key.inc
D    packages/ptc/src/c_api/moded.inc
D    packages/ptc/src/c_api/surface.inc
D    packages/ptc/src/c_api/error.inc
D    packages/ptc/src/c_api/cleard.inc
D    packages/ptc/src/c_api/exceptd.inc
D    packages/ptc/src/c_api/formatd.inc
D    packages/ptc/src/c_api/keyd.inc
D    packages/ptc/src/c_api/surfaced.inc
D    packages/ptc/src/c_api/errord.inc
D    packages/ptc/src/c_api/clipper.inc
D    packages/ptc/src/c_api/palette.inc
--- Merging r16144 into '.':
U    packages/ptc/src/win32/base/kbd.inc
--- Merging r16146 into '.':
U    packages/fcl-json/src/fpjson.pp
--- Merging r16147 into '.':
U    packages/fcl-json/tests/testjsondata.pp
U    packages/fcl-json/tests/testjsonparser.pp
A    packages/fcl-json/examples/demoformat.pp
--- Merging r16163 into '.':
U    packages/fcl-extra/src/win/daemonapp.inc
--- Merging r16178 into '.':
U    packages/ptc/src/win32/base/window.inc
--- Merging r16192 into '.':
U    rtl/morphos/system.pp
U    rtl/amiga/system.pp
--- Merging r16193 into '.':
U    packages/libgd/src/gd.pas
--- Merging r16194 into '.':
U    utils/fppkg/buildfppkg.pp
--- Merging r16195 into '.':
U    packages/winceunits/Makefile.fpc
A    packages/winceunits/src/tlhelp32.pas
U    packages/winceunits/src/buildwinceunits.pp
--- Merging r16196 into '.':
U    ide/fpusrscr.pas
--- Merging r16197 into '.':
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r16200 into '.':
U    packages/sdl/src/sdl_image.pas
U    packages/sdl/src/powersdl.inc
A    packages/sdl/src/powersdl_image.inc
--- Merging r16202 into '.':
U    packages/fpvectorial/src/fpvectorial.pas
U    packages/fpvectorial/src/svgvectorialwriter.pas
U    packages/fpvectorial/src/fpvtocanvas.pas
U    packages/fpvectorial/examples/fpvc_mainform.lfm
U    packages/fpvectorial/examples/fpvectorialconverter.lpi
--- Merging r16203 into '.':
G    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r16204 into '.':
A    packages/sdl/src/powersdl_ttf.inc
A    packages/sdl/src/powersdl_smpeg.inc
A    packages/sdl/src/powersdl_mixer.inc
A    packages/sdl/src/powersdl_gfx.inc
A    packages/sdl/src/powersdl_net.inc
--- Merging r16205 into '.':
U    packages/sdl/src/sdl_ttf.pas
U    packages/sdl/src/smpeg.pas
U    packages/sdl/src/sdl_mixer_nosmpeg.pas
U    packages/sdl/src/sdl_gfx.pas
U    packages/sdl/src/sdl_mixer.pas
U    packages/sdl/src/sdl_net.pas
--- Merging r16207 into '.':
G    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r16210 into '.':
U    rtl/linux/powerpc/prt0.as
U    rtl/linux/powerpc/cprt0.as
--- Merging r16219 into '.':
U    packages/fcl-db/src/base/fields.inc
Summary of conflicts:
  Text conflicts: 1

# revisions: 15916,15935,16057,16075,16082,16088,16089,16090,16092,16093,16099,16107,16115,16123,16131,16141,16142,16143,16144,16146,16147,16163,16178,16192,16193,16194,16195,16196,16197,16200,16202,16203,16204,16205,16207,16210,16219
------------------------------------------------------------------------
r15916 | daniel | 2010-08-28 20:36:30 +0200 (Sat, 28 Aug 2010) | 4 lines
Changed paths:
   M /trunk/rtl/inc/sstrings.inc

  * Apply fix for bug #17291 as uploaded by reporter: Compiler generates a
    32 bit value for deciding between lookup table or key/value array,
	also on 64 bit processors.

------------------------------------------------------------------------
------------------------------------------------------------------------
r15935 | pierre | 2010-09-01 13:56:52 +0200 (Wed, 01 Sep 2010) | 1 line
Changed paths:
   M /trunk/rtl/win64/system.pp

 * Fix incorrect instruction size 
------------------------------------------------------------------------
------------------------------------------------------------------------
r16057 | pierre | 2010-09-28 12:21:51 +0200 (Tue, 28 Sep 2010) | 1 line
Changed paths:
   M /trunk/compiler/utils/gppc386.pp

 * Try to improve directory handling of program
------------------------------------------------------------------------
------------------------------------------------------------------------
r16075 | florian | 2010-10-02 21:15:58 +0200 (Sat, 02 Oct 2010) | 2 lines
Changed paths:
   M /trunk/rtl/inc/heap.inc
   M /trunk/rtl/inc/heaph.inc

* made GetMemory, FreeMemory, ReallocMemory delphi compatible, resolves #17530

------------------------------------------------------------------------
------------------------------------------------------------------------
r16082 | michael | 2010-10-05 14:09:04 +0200 (Tue, 05 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/README.txt

* Added reference to jsonviewer in Lazarus
------------------------------------------------------------------------
------------------------------------------------------------------------
r16088 | sekelsenmat | 2010-10-06 15:13:35 +0200 (Wed, 06 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/imagemagick/src/imagemagick.pas

Patch from Leonardo M. Ramé, updates the ImageMagick library name in UNIXes
------------------------------------------------------------------------
------------------------------------------------------------------------
r16089 | pierre | 2010-10-06 18:04:46 +0200 (Wed, 06 Oct 2010) | 1 line
Changed paths:
   M /trunk/rtl/win/sysfile.inc
   M /trunk/rtl/win/sysos.inc

 * Fix for Bug report 17550
------------------------------------------------------------------------
------------------------------------------------------------------------
r16090 | pierre | 2010-10-06 18:37:14 +0200 (Wed, 06 Oct 2010) | 1 line
Changed paths:
   A /trunk/tests/webtbs/tw17550.pp

 * New bug test
------------------------------------------------------------------------
------------------------------------------------------------------------
r16092 | sergei | 2010-10-06 19:31:08 +0200 (Wed, 06 Oct 2010) | 1 line
Changed paths:
   M /trunk/rtl/inc/ustrings.inc
   M /trunk/rtl/inc/wstrings.inc

* Fix overflow in Delete procedure for Wide- and UnicodeStrings when its Size argument is MaxInt. Now using the same code as in AnsiString version. Mantis #17514.
------------------------------------------------------------------------
------------------------------------------------------------------------
r16093 | sergei | 2010-10-06 19:33:29 +0200 (Wed, 06 Oct 2010) | 1 line
Changed paths:
   A /trunk/tests/webtbs/tw17514.pp

+ Test for System.Delete() with Size argument equal to MaxInt, Mantis #17514
------------------------------------------------------------------------
------------------------------------------------------------------------
r16099 | sergei | 2010-10-07 11:48:18 +0200 (Thu, 07 Oct 2010) | 1 line
Changed paths:
   M /trunk/rtl/objpas/sysutils/dati.inc

* Fixed TryStrToDateTime so it returns True only if both date and time are parsed successfully, resolves #17541.
------------------------------------------------------------------------
------------------------------------------------------------------------
r16107 | jonas | 2010-10-08 15:06:06 +0200 (Fri, 08 Oct 2010) | 3 lines
Changed paths:
   M /trunk/packages/fcl-process/src/unix/process.inc

  + use "Terminal" under Haiku to launch external programs (patch by
    Olivier Coursiere, mantis #17392)

------------------------------------------------------------------------
------------------------------------------------------------------------
r16115 | nickysn | 2010-10-09 18:17:41 +0200 (Sat, 09 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/graph/src/ptcgraph/ptcgraph.pp

+ added ptcgraph implementation of SetBkColor and GetBkColor in 640x480x2 (MCGAHi) mode
------------------------------------------------------------------------
------------------------------------------------------------------------
r16123 | daniel | 2010-10-10 17:09:05 +0200 (Sun, 10 Oct 2010) | 2 lines
Changed paths:
   M /trunk/rtl/linux/arm/sighnd.inc

  - Remove unused variable fpustate.

------------------------------------------------------------------------
------------------------------------------------------------------------
r16131 | joost | 2010-10-11 22:24:08 +0200 (Mon, 11 Oct 2010) | 1 line
Changed paths:
   M /trunk/utils/fppkg/fppkg.pp
   M /trunk/utils/fppkg/pkgoptions.pp

 * Added the ability to skip the rebuild of all packages which are dependent on the package being installed
------------------------------------------------------------------------
------------------------------------------------------------------------
r16141 | nickysn | 2010-10-12 16:17:35 +0200 (Tue, 12 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/graph/src/ptcgraph/ptccrt.pp

* buffer overflow checking in ptccrt.KeyBufAdd
------------------------------------------------------------------------
------------------------------------------------------------------------
r16142 | nickysn | 2010-10-12 16:31:26 +0200 (Tue, 12 Oct 2010) | 1 line
Changed paths:
   D /trunk/packages/ptc/src/x11/x11dgadisplayd.inc
   D /trunk/packages/ptc/src/x11/x11dgadisplayi.inc

- deleted x11dgadisplay*.inc as the code has been moved to x11dga1display*.inc and they're no longer used
------------------------------------------------------------------------
------------------------------------------------------------------------
r16143 | nickysn | 2010-10-12 16:38:27 +0200 (Tue, 12 Oct 2010) | 1 line
Changed paths:
   D /trunk/packages/ptc/src/c_api/area.inc
   D /trunk/packages/ptc/src/c_api/aread.inc
   A /trunk/packages/ptc/src/c_api/capi_area.inc (from /trunk/packages/ptc/src/c_api/area.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_aread.inc (from /trunk/packages/ptc/src/c_api/aread.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_clear.inc (from /trunk/packages/ptc/src/c_api/clear.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_cleard.inc (from /trunk/packages/ptc/src/c_api/cleard.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_clipper.inc (from /trunk/packages/ptc/src/c_api/clipper.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_clipperd.inc (from /trunk/packages/ptc/src/c_api/clipperd.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_color.inc (from /trunk/packages/ptc/src/c_api/color.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_colord.inc (from /trunk/packages/ptc/src/c_api/colord.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_console.inc (from /trunk/packages/ptc/src/c_api/console.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_consoled.inc (from /trunk/packages/ptc/src/c_api/consoled.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_copy.inc (from /trunk/packages/ptc/src/c_api/copy.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_copyd.inc (from /trunk/packages/ptc/src/c_api/copyd.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_error.inc (from /trunk/packages/ptc/src/c_api/error.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_errord.inc (from /trunk/packages/ptc/src/c_api/errord.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_except.inc (from /trunk/packages/ptc/src/c_api/except.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_exceptd.inc (from /trunk/packages/ptc/src/c_api/exceptd.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_format.inc (from /trunk/packages/ptc/src/c_api/format.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_formatd.inc (from /trunk/packages/ptc/src/c_api/formatd.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_index.inc (from /trunk/packages/ptc/src/c_api/index.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_key.inc (from /trunk/packages/ptc/src/c_api/key.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_keyd.inc (from /trunk/packages/ptc/src/c_api/keyd.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_mode.inc (from /trunk/packages/ptc/src/c_api/mode.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_moded.inc (from /trunk/packages/ptc/src/c_api/moded.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_palette.inc (from /trunk/packages/ptc/src/c_api/palette.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_paletted.inc (from /trunk/packages/ptc/src/c_api/paletted.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_surface.inc (from /trunk/packages/ptc/src/c_api/surface.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_surfaced.inc (from /trunk/packages/ptc/src/c_api/surfaced.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_timer.inc (from /trunk/packages/ptc/src/c_api/timer.inc:16141)
   A /trunk/packages/ptc/src/c_api/capi_timerd.inc (from /trunk/packages/ptc/src/c_api/timerd.inc:16141)
   D /trunk/packages/ptc/src/c_api/clear.inc
   D /trunk/packages/ptc/src/c_api/cleard.inc
   D /trunk/packages/ptc/src/c_api/clipper.inc
   D /trunk/packages/ptc/src/c_api/clipperd.inc
   D /trunk/packages/ptc/src/c_api/color.inc
   D /trunk/packages/ptc/src/c_api/colord.inc
   D /trunk/packages/ptc/src/c_api/console.inc
   D /trunk/packages/ptc/src/c_api/consoled.inc
   D /trunk/packages/ptc/src/c_api/copy.inc
   D /trunk/packages/ptc/src/c_api/copyd.inc
   D /trunk/packages/ptc/src/c_api/error.inc
   D /trunk/packages/ptc/src/c_api/errord.inc
   D /trunk/packages/ptc/src/c_api/except.inc
   D /trunk/packages/ptc/src/c_api/exceptd.inc
   D /trunk/packages/ptc/src/c_api/format.inc
   D /trunk/packages/ptc/src/c_api/formatd.inc
   D /trunk/packages/ptc/src/c_api/index.inc
   D /trunk/packages/ptc/src/c_api/key.inc
   D /trunk/packages/ptc/src/c_api/keyd.inc
   D /trunk/packages/ptc/src/c_api/mode.inc
   D /trunk/packages/ptc/src/c_api/moded.inc
   D /trunk/packages/ptc/src/c_api/palette.inc
   D /trunk/packages/ptc/src/c_api/paletted.inc
   D /trunk/packages/ptc/src/c_api/surface.inc
   D /trunk/packages/ptc/src/c_api/surfaced.inc
   D /trunk/packages/ptc/src/c_api/timer.inc
   D /trunk/packages/ptc/src/c_api/timerd.inc

* updated ptc c_api
------------------------------------------------------------------------
------------------------------------------------------------------------
r16144 | nickysn | 2010-10-12 16:39:48 +0200 (Tue, 12 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/ptc/src/win32/base/kbd.inc

* Win32 kbd input unicode translation via MultiByteToWideChar
------------------------------------------------------------------------
------------------------------------------------------------------------
r16146 | michael | 2010-10-12 22:08:23 +0200 (Tue, 12 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

* Implemented FormatJSON
------------------------------------------------------------------------
------------------------------------------------------------------------
r16147 | michael | 2010-10-12 22:45:49 +0200 (Tue, 12 Oct 2010) | 1 line
Changed paths:
   A /trunk/packages/fcl-json/examples/demoformat.pp
   M /trunk/packages/fcl-json/tests/testjsondata.pp
   M /trunk/packages/fcl-json/tests/testjsonparser.pp

* Added example and tests for format
------------------------------------------------------------------------
------------------------------------------------------------------------
r16163 | michael | 2010-10-15 09:46:08 +0200 (Fri, 15 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-extra/src/win/daemonapp.inc

* Fixed memory allocation in registration
------------------------------------------------------------------------
------------------------------------------------------------------------
r16178 | nickysn | 2010-10-17 16:32:25 +0200 (Sun, 17 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/ptc/src/win32/base/window.inc

* fixed windows keyboard layout switching and maybe other bugs, caused by not pumping all thread messages
------------------------------------------------------------------------
------------------------------------------------------------------------
r16192 | karoly | 2010-10-21 04:13:57 +0200 (Thu, 21 Oct 2010) | 2 lines
Changed paths:
   M /trunk/rtl/amiga/system.pp
   M /trunk/rtl/morphos/system.pp

* MorphOS, Amiga: changed definition of sLineBreak to match other system units, fixes fcl-base build

------------------------------------------------------------------------
------------------------------------------------------------------------
r16193 | karoly | 2010-10-21 04:52:00 +0200 (Thu, 21 Oct 2010) | 2 lines
Changed paths:
   M /trunk/packages/libgd/src/gd.pas

+ made libgd package to build at least on MorphOS and Amiga

------------------------------------------------------------------------
------------------------------------------------------------------------
r16194 | karoly | 2010-10-21 05:25:15 +0200 (Thu, 21 Oct 2010) | 2 lines
Changed paths:
   M /trunk/utils/fppkg/buildfppkg.pp

+ disable unimplemented stuff in fppkg for MorphOS/Amiga, so it builds at least

------------------------------------------------------------------------
------------------------------------------------------------------------
r16195 | sekelsenmat | 2010-10-21 17:37:16 +0200 (Thu, 21 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/winceunits/Makefile.fpc
   M /trunk/packages/winceunits/src/buildwinceunits.pp
   A /trunk/packages/winceunits/src/tlhelp32.pas

help headers for wince from bug #17574
------------------------------------------------------------------------
------------------------------------------------------------------------
r16196 | karoly | 2010-10-22 01:44:17 +0200 (Fri, 22 Oct 2010) | 2 lines
Changed paths:
   M /trunk/ide/fpusrscr.pas

+ disable UserScreen for now on Amiga/MorphOS, dummy implementation causes more trouble than it solves

------------------------------------------------------------------------
------------------------------------------------------------------------
r16197 | michael | 2010-10-22 11:20:27 +0200 (Fri, 22 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Fixed largeint parameter problem
------------------------------------------------------------------------
------------------------------------------------------------------------
r16200 | karoly | 2010-10-23 03:54:47 +0200 (Sat, 23 Oct 2010) | 2 lines
Changed paths:
   M /trunk/packages/sdl/src/powersdl.inc
   A /trunk/packages/sdl/src/powersdl_image.inc
   M /trunk/packages/sdl/src/sdl_image.pas

+ some work to complete SDL package support for MorphOS. more to come.

------------------------------------------------------------------------
------------------------------------------------------------------------
r16202 | sekelsenmat | 2010-10-23 12:33:21 +0200 (Sat, 23 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fpvectorial/examples/fpvc_mainform.lfm
   M /trunk/packages/fpvectorial/examples/fpvectorialconverter.lpi
   M /trunk/packages/fpvectorial/src/fpvectorial.pas
   M /trunk/packages/fpvectorial/src/fpvtocanvas.pas
   M /trunk/packages/fpvectorial/src/svgvectorialwriter.pas

Initial transformation of fpvectorial segments in classes, as well as making the number of segments dynamic
------------------------------------------------------------------------
------------------------------------------------------------------------
r16203 | michael | 2010-10-23 13:04:59 +0200 (Sat, 23 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Fixed blob parameter support
------------------------------------------------------------------------
------------------------------------------------------------------------
r16204 | karoly | 2010-10-23 14:34:47 +0200 (Sat, 23 Oct 2010) | 2 lines
Changed paths:
   A /trunk/packages/sdl/src/powersdl_gfx.inc
   A /trunk/packages/sdl/src/powersdl_mixer.inc
   A /trunk/packages/sdl/src/powersdl_net.inc
   A /trunk/packages/sdl/src/powersdl_smpeg.inc
   A /trunk/packages/sdl/src/powersdl_ttf.inc

+ added headers for MorphOS' PowerSDL

------------------------------------------------------------------------
------------------------------------------------------------------------
r16205 | karoly | 2010-10-23 14:35:49 +0200 (Sat, 23 Oct 2010) | 2 lines
Changed paths:
   M /trunk/packages/sdl/src/sdl_gfx.pas
   M /trunk/packages/sdl/src/sdl_mixer.pas
   M /trunk/packages/sdl/src/sdl_mixer_nosmpeg.pas
   M /trunk/packages/sdl/src/sdl_net.pas
   M /trunk/packages/sdl/src/sdl_ttf.pas
   M /trunk/packages/sdl/src/smpeg.pas

+ adapted SDL package to user PowerSDL headers on MorphOS.

------------------------------------------------------------------------
------------------------------------------------------------------------
r16207 | michael | 2010-10-23 16:09:59 +0200 (Sat, 23 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Mark blob parameters as binary
------------------------------------------------------------------------
------------------------------------------------------------------------
r16210 | tom_at_work | 2010-10-23 22:07:36 +0200 (Sat, 23 Oct 2010) | 1 line
Changed paths:
   M /trunk/rtl/linux/powerpc/cprt0.as
   M /trunk/rtl/linux/powerpc/prt0.as

Moved global variables from .text section to .bss in ppc/linux startup code, improves position independency
------------------------------------------------------------------------
------------------------------------------------------------------------
r16219 | michael | 2010-10-25 11:55:43 +0200 (Mon, 25 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/fields.inc

* TBlobField.SaveToStream() should check whether CreateBlobStream actually creates a stream
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@16422 -

.gitattributes

@@ -1486,6 +1486,7 @@ packages/fcl-json/Makefile svneol=native#text/plain
 packages/fcl-json/Makefile.fpc svneol=native#text/plain
 packages/fcl-json/examples/confdemo.lpi svneol=native#text/plain
 packages/fcl-json/examples/confdemo.pp svneol=native#text/plain
+packages/fcl-json/examples/demoformat.pp svneol=native#text/plain
 packages/fcl-json/examples/parsedemo.lpi svneol=native#text/plain
 packages/fcl-json/examples/parsedemo.pp svneol=native#text/plain
 packages/fcl-json/examples/simpledemo.lpi svneol=native#text/plain
@@ -4524,35 +4525,35 @@ packages/ptc/examples/tunnel.pp svneol=native#text/plain
 packages/ptc/examples/tunnel3d.pp svneol=native#text/plain
 packages/ptc/examples/tunnel3d.raw -text svneol=unset#raw/binary
 packages/ptc/fpmake.pp svneol=native#text/plain
-packages/ptc/src/c_api/area.inc svneol=native#text/plain
-packages/ptc/src/c_api/aread.inc svneol=native#text/plain
-packages/ptc/src/c_api/clear.inc svneol=native#text/plain
-packages/ptc/src/c_api/cleard.inc svneol=native#text/plain
-packages/ptc/src/c_api/clipper.inc svneol=native#text/plain
-packages/ptc/src/c_api/clipperd.inc svneol=native#text/plain
-packages/ptc/src/c_api/color.inc svneol=native#text/plain
-packages/ptc/src/c_api/colord.inc svneol=native#text/plain
-packages/ptc/src/c_api/console.inc svneol=native#text/plain
-packages/ptc/src/c_api/consoled.inc svneol=native#text/plain
-packages/ptc/src/c_api/copy.inc svneol=native#text/plain
-packages/ptc/src/c_api/copyd.inc svneol=native#text/plain
-packages/ptc/src/c_api/error.inc svneol=native#text/plain
-packages/ptc/src/c_api/errord.inc svneol=native#text/plain
-packages/ptc/src/c_api/except.inc svneol=native#text/plain
-packages/ptc/src/c_api/exceptd.inc svneol=native#text/plain
-packages/ptc/src/c_api/format.inc svneol=native#text/plain
-packages/ptc/src/c_api/formatd.inc svneol=native#text/plain
-packages/ptc/src/c_api/index.inc svneol=native#text/plain
-packages/ptc/src/c_api/key.inc svneol=native#text/plain
-packages/ptc/src/c_api/keyd.inc svneol=native#text/plain
-packages/ptc/src/c_api/mode.inc svneol=native#text/plain
-packages/ptc/src/c_api/moded.inc svneol=native#text/plain
-packages/ptc/src/c_api/palette.inc svneol=native#text/plain
-packages/ptc/src/c_api/paletted.inc svneol=native#text/plain
-packages/ptc/src/c_api/surface.inc svneol=native#text/plain
-packages/ptc/src/c_api/surfaced.inc svneol=native#text/plain
-packages/ptc/src/c_api/timer.inc svneol=native#text/plain
-packages/ptc/src/c_api/timerd.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_area.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_aread.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_clear.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_cleard.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_clipper.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_clipperd.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_color.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_colord.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_console.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_consoled.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_copy.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_copyd.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_error.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_errord.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_except.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_exceptd.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_format.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_formatd.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_index.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_key.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_keyd.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_mode.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_moded.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_palette.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_paletted.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_surface.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_surfaced.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_timer.inc svneol=native#text/plain
+packages/ptc/src/c_api/capi_timerd.inc svneol=native#text/plain
 packages/ptc/src/core/aread.inc svneol=native#text/plain
 packages/ptc/src/core/areai.inc svneol=native#text/plain
 packages/ptc/src/core/baseconsoled.inc svneol=native#text/plain
@@ -4674,8 +4675,6 @@ packages/ptc/src/x11/x11dga1displayd.inc svneol=native#text/plain
 packages/ptc/src/x11/x11dga1displayi.inc svneol=native#text/plain
 packages/ptc/src/x11/x11dga2displayd.inc svneol=native#text/plain
 packages/ptc/src/x11/x11dga2displayi.inc svneol=native#text/plain
-packages/ptc/src/x11/x11dgadisplayd.inc svneol=native#text/plain
-packages/ptc/src/x11/x11dgadisplayi.inc svneol=native#text/plain
 packages/ptc/src/x11/x11displayd.inc svneol=native#text/plain
 packages/ptc/src/x11/x11displayi.inc svneol=native#text/plain
 packages/ptc/src/x11/x11imaged.inc svneol=native#text/plain
@@ -4733,6 +4732,12 @@ packages/sdl/src/jedi-sdl.inc svneol=native#text/plain
 packages/sdl/src/libxmlparser.pas svneol=native#text/plain
 packages/sdl/src/logger.pas svneol=native#text/plain
 packages/sdl/src/powersdl.inc svneol=native#text/plain
+packages/sdl/src/powersdl_gfx.inc svneol=native#text/plain
+packages/sdl/src/powersdl_image.inc svneol=native#text/plain
+packages/sdl/src/powersdl_mixer.inc svneol=native#text/plain
+packages/sdl/src/powersdl_net.inc svneol=native#text/plain
+packages/sdl/src/powersdl_smpeg.inc svneol=native#text/plain
+packages/sdl/src/powersdl_ttf.inc svneol=native#text/plain
 packages/sdl/src/sdl.pas svneol=native#text/plain
 packages/sdl/src/sdl_gfx.pas svneol=native#text/plain
 packages/sdl/src/sdl_image.pas svneol=native#text/plain
@@ -5331,6 +5336,7 @@ packages/winceunits/src/sipapi.pp svneol=native#text/plain
 packages/winceunits/src/sms.pp svneol=native#text/plain
 packages/winceunits/src/storemgr.pas svneol=native#text/plain
 packages/winceunits/src/tapi.pp svneol=native#text/plain
+packages/winceunits/src/tlhelp32.pas svneol=native#text/pascal
 packages/winceunits/src/todaycmn.pp svneol=native#text/plain
 packages/winceunits/src/tsp.pp svneol=native#text/plain
 packages/winceunits/src/wap.pp svneol=native#text/plain
@@ -9708,8 +9714,10 @@ tests/webtbs/tw17337.pp svneol=native#text/plain
 tests/webtbs/tw1735.pp svneol=native#text/plain
 tests/webtbs/tw1737.pp svneol=native#text/plain
 tests/webtbs/tw1744.pp svneol=native#text/plain
+tests/webtbs/tw17514.pp svneol=native#text/plain
 tests/webtbs/tw1754c.pp svneol=native#text/plain
 tests/webtbs/tw1755.pp svneol=native#text/plain
+tests/webtbs/tw17550.pp svneol=native#text/plain
 tests/webtbs/tw1758.pp svneol=native#text/plain
 tests/webtbs/tw1765.pp svneol=native#text/plain
 tests/webtbs/tw1779.pp svneol=native#text/plain

compiler/utils/gppc386.pp

@@ -33,7 +33,9 @@ program fpc_with_gdb;
       instruction that GDB should do before starting.
       Note that if gdb.fpc is present, no "run" command is
       inserted if gdb4fpc.ini is found
-      but it can be inserted in gdb.fpc itself
+      but it can be inserted in gdb.fpc itself.
+
+  Use EXTDEBUG conditional to get debug information.
 }
 
 uses
@@ -41,22 +43,24 @@ uses
 
 const
 {$ifdef Unix}
-  GDBExeName = 'gdbpas';
+  GDBExeName : String = 'gdbpas';
   GDBIniName = '.gdbinit';
   DefaultCompilerName = 'ppc386';
   PathSep=':';
+  DirSep = '/';
 {$else}
-  GDBExeName = 'gdbpas.exe';
+  GDBExeName : String = 'gdbpas.exe';
   GDBIniName = 'gdb.ini';
   DefaultCompilerName = 'ppc386.exe';
   PathSep=';';
+  DirSep = '\';
 {$endif not linux}
 
   { If you add a gdb.fpc file in a given directory }
   { GDB will read it; this allows you to add       }
   { special tests in specific directories   PM     }
   FpcGDBIniName = 'gdb.fpc';
-  GDBIniTempName = 'gdb4fpc.ini';
+  GDBIniTempName : string = 'gdb4fpc.ini';
 
 var
    fpcgdbini : text;
@@ -71,27 +75,37 @@ begin
   else
     CompilerName:=DefaultCompilerName;
 
+  CompilerName:=fsearch(CompilerName,Dir+PathSep+GetEnv('PATH'));
+
   { support for info functions directly : used in makefiles }
   if (paramcount=1) and (pos('-i',Paramstr(1))=1) then
     begin
-      Exec(fsearch(CompilerName,Dir+PathSep+GetEnv('PATH')),Paramstr(1));
+      Exec(CompilerName,Paramstr(1));
       exit;
     end;
 
-  if fsearch(GDBIniTempName,'./')<>'' then
+  {$ifdef EXTDEBUG}
+  writeln(stderr,'Using compiler "',CompilerName,'"');
+  flush(stderr);
+  {$endif}
+  if fsearch(GDBIniTempName,'.')<>'' then
     begin
       Assign(fpcgdbini,GDBIniTempName);
+      {$ifdef EXTDEBUG}
+      writeln(stderr,'Erasing file "',GDBIniTempName,'"');
+      flush(stderr);
+      {$endif}
       erase(fpcgdbini);
     end;
+  GDBIniTempName:=fexpand('.'+DirSep+GDBIniTempName);
   Assign(fpcgdbini,GdbIniTempName);
+  {$ifdef EXTDEBUG}
+  writeln(stderr,'Creating file "',GDBIniTempName,'"');
+  flush(stderr);
+  {$endif}
   Rewrite(fpcgdbini);
 
   Writeln(fpcgdbini,'set language pascal');
-  Writeln(fpcgdbini,'b SYSTEM_EXIT');
-  Writeln(fpcgdbini,'cond 1 EXITCODE <> 0');
-  Writeln(fpcgdbini,'b INTERNALERROR');
-  Writeln(fpcgdbini,'b HANDLEERRORADDRFRAME');
-  Writeln(fpcgdbini,'set $_exitcode := -1');
   Write(fpcgdbini,'set args');
 
   { this will not work correctly if there are " or '' inside the command line :( }
@@ -103,6 +117,15 @@ begin
         Write(fpcgdbini,' '+ParamStr(i));
     end;
   Writeln(fpcgdbini);
+  Writeln(fpcgdbini,'b SYSTEM_EXIT');
+  Writeln(fpcgdbini,'cond 1 EXITCODE <> 0');
+  Writeln(fpcgdbini,'set $_exitcode := -1');
+  { b INTERNALERROR sometimes fails ... Don't know why. PM 2010-08-28 }
+  Writeln(fpcgdbini,'info fun INTERNALERROR');
+  Writeln(fpcgdbini,'b INTERNALERROR');
+  Writeln(fpcgdbini,'b HANDLEERRORADDRFRAME');
+  { This one will fail unless sysutils unit is also loaded }
+  Writeln(fpcgdbini,'b RUNERRORTOEXCEPT');
   if fsearch(FpcGDBIniName,'./')<>'' then
     begin
       Writeln(fpcgdbini,'source '+FpcGDBIniName);
@@ -115,12 +138,26 @@ begin
   Writeln(fpcgdbini,'  quit');
   Writeln(fpcgdbini,'end');
   Close(fpcgdbini);
-
-  Exec(fsearch(GDBExeName,Dir+PathSep+GetEnv('PATH')),
+  {$ifdef EXTDEBUG}
+  writeln(stderr,'Closing file "',GDBIniTempName,'"');
+  flush(stderr);
+  {$endif}
+
+  GDBExeName:=fsearch(GDBExeName,Dir+PathSep+GetEnv('PATH'));
+  {$ifdef EXTDEBUG}
+  Writeln(stderr,'Starting ',GDBExeName,
+{$ifdef win32}
+    '--nw '+
+{$endif win32}
+    '--nx --command='+GDBIniTempName+' '+CompilerName);
+  flush(stderr);
+  {$endif}
+   DosError:=0;
+   Exec(GDBExeName,
 {$ifdef win32}
     '--nw '+
 {$endif win32}
-    '--nx --quiet --command='+GDBIniTempName+' '+CompilerName);
+    '--nx --command='+GDBIniTempName+' '+CompilerName);
   GDBError:=DosError;
   GDBExitCode:=DosExitCode;
   if (GDBError<>0) or (GDBExitCode<>0) then

ide/fpusrscr.pas

@@ -1572,7 +1572,7 @@ begin
           UserScreen:=New(PNWLScreen, Init);
         {$else}
           {$ifdef AMIGASCREEN}
-            UserScreen:=New(PAmigaScreen, Init);
+            UserScreen:=nil; //New(PAmigaScreen, Init);
           {$else}
             UserScreen:=New(PScreen, Init);
           {$endif AMIGASCREEN}

packages/fcl-db/src/base/fields.inc

@@ -2607,7 +2607,8 @@ Var S : TStream;
 begin
   S:=GetBlobStream(bmRead);
   Try
-    Stream.CopyFrom(S,0);
+    If Assigned(S) then
+      Stream.CopyFrom(S,0);
   finally
     S.Free;
   end;

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -448,49 +448,59 @@ begin
 end;
 
 procedure TPQConnection.PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams);
-
+{
+  TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
+      ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate,  ftTime, ftDateTime,
+          ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
+              ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
+                  ftWideString, ftLargeint, ftADT, ftArray, ftReference,
+                      ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
+                          ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo);
+                          
+                          
+}
 const TypeStrings : array[TFieldType] of string =
     (
-      'Unknown',
-      'text',
-      'int',
-      'int',
-      'int',
-      'bool',
-      'float',
-      'numeric',
-      'numeric',
-      'date',
-      'time',
-      'timestamp',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'text',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'int',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown',
-      'Unknown'
+      'Unknown',   // ftUnknown
+      'text',     // ftString
+      'int',       // ftSmallint
+      'int',       // ftInteger
+      'int',       // ftWord
+      'bool',      // ftBoolean
+      'float',     // ftFloat
+      'numeric',   // ftCurrency
+      'numeric',   // ftBCD
+      'date',      // ftDate
+      'time',      // ftTime
+      'timestamp', // ftDateTime
+      'Unknown',   // ftBytes
+      'Unknown',   // ftVarBytes
+      'Unknown',   // ftAutoInc
+      'bytea',     // ftBlob 
+      'text',      // ftMemo
+      'bytea',     // ftGraphic
+      'text',      // ftFmtMemo
+      'Unknown',   // ftParadoxOle
+      'Unknown',   // ftDBaseOle
+      'Unknown',   // ftTypedBinary
+      'Unknown',   // ftCursor
+      'text',      // ftFixedChar
+      'text',      // ftWideString
+      'bigint',    // ftLargeint
+      'Unknown',   // ftADT
+      'Unknown',   // ftArray
+      'Unknown',   // ftReference
+      'Unknown',   // ftDataSet
+      'Unknown',   // ftOraBlob
+      'Unknown',   // ftOraClob
+      'Unknown',   // ftVariant
+      'Unknown',   // ftInterface
+      'Unknown',   // ftIDispatch
+      'Unknown',   // ftGuid
+      'Unknown',   // ftTimeStamp
+      'Unknown',   // ftFMTBcd
+      'Unknown',   // ftFixedWideChar
+      'Unknown'    // ftWideMemo
     );
 
 
@@ -518,8 +528,10 @@ begin
           s := s + TypeStrings[AParams[i].DataType] + ','
         else
           begin
-          if AParams[i].DataType = ftUnknown then DatabaseErrorFmt(SUnknownParamFieldType,[AParams[i].Name],self)
-            else DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[i].DataType]],self);
+          if AParams[i].DataType = ftUnknown then 
+            DatabaseErrorFmt(SUnknownParamFieldType,[AParams[i].Name],self)
+          else 
+            DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[i].DataType]],self);
           end;
         s[length(s)] := ')';
         buf := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psPostgreSQL);
@@ -561,9 +573,11 @@ end;
 procedure TPQConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction;AParams : TParams);
 
 var ar  : array of pchar;
-    i   : integer;
+    l,i   : integer;
     s   : string;
-    ParamNames,ParamValues : array of string;
+    lengths,formats : array of integer;
+    ParamNames,
+    ParamValues : array of string;
 
 begin
   with cursor as TPQCursor do
@@ -573,7 +587,10 @@ begin
       pqclear(res);
       if Assigned(AParams) and (AParams.count > 0) then
         begin
-        setlength(ar,Aparams.count);
+        l:=Aparams.count;
+        setlength(ar,l);
+        setlength(lengths,l);
+        setlength(formats,l);
         for i := 0 to AParams.count -1 do if not AParams[i].IsNull then
           begin
           case AParams[i].DataType of
@@ -590,10 +607,15 @@ begin
           end; {case}
           GetMem(ar[i],length(s)+1);
           StrMove(PChar(ar[i]),Pchar(s),Length(S)+1);
+          lengths[i]:=Length(s);
+          if (AParams[i].DataType in [ftBlob,ftgraphic]) then
+            formats[i]:=1 
+          else
+            Formats[i]:=0;  
           end
         else
           FreeAndNil(ar[i]);
-        res := PQexecPrepared(tr.PGConn,pchar('prepst'+nr),Aparams.count,@Ar[0],nil,nil,1);
+        res := PQexecPrepared(tr.PGConn,pchar('prepst'+nr),Aparams.count,@Ar[0],@Lengths[0],@Formats[0],1);
         for i := 0 to AParams.count -1 do
           FreeMem(ar[i]);
         end

packages/fcl-extra/src/win/daemonapp.inc

@@ -385,7 +385,7 @@ Var
   RV : Integer;
   
 begin
-  GetMem(P,SizeOf(TServiceTableEntry)*FMapper.DaemonDefs.Count+1);
+  GetMem(P,SizeOf(TServiceTableEntry)*(FMapper.DaemonDefs.Count+1));
   Try
     C:=FMapper.DaemonDefs.Count;
     For I:=0 to C-1 do

packages/fcl-json/examples/demoformat.pp

@@ -0,0 +1,21 @@
+{$mode objfpc}
+{$h+}
+program demoformat;
+
+uses fpjson;
+
+var
+  O : TJSONObject;
+  A : TJSONArray;  
+begin  
+  O:=TJSONObject.Create(['a',1,'b','two','three',TJSONObject.Create(['x',10,'y',20])]);
+  Writeln (O.FormatJSon);
+  Writeln (O.FormatJSon([foDonotQuoteMembers,foUseTabChar],1));
+  Writeln (O.FormatJSon([foSingleLineObject,foUseTabChar],1));
+  Writeln (O.asJSON);
+  A:=TJSONArray.Create([1,2,'a',TJSONObject.Create(['x',10,'y',20])]);
+  Writeln (A.FormatJSon());
+  Writeln (A.FormatJSON([foSinglelineArray],2));
+  Writeln (A.FormatJSON([foSinglelineArray,foSingleLineObject],2));
+  Writeln (A.asJSON);
+end.  

packages/fcl-json/src/README.txt

@@ -1,5 +1,9 @@
 This package implements JSON support for FPC.
 
+You might want to have a look at the lazarus jsonviewer tool, written using
+fpJSON (see lazarus/tools/jsonviewer). It visualizes the fpJSON data and
+shows how to program using fpjson.
+
 JSON support consists of 3 parts:
 
 unit fpJSON contains the data representation. Basically, it defines a set of

packages/fcl-json/src/fpjson.pp

@@ -31,9 +31,21 @@ type
   TJSONStringType = AnsiString;
   TJSONCharType = AnsiChar;
   PJSONCharType = ^TJSONCharType;
+  TFormatOption = (foSingleLineArray,   // Array without CR/LF : all on one line
+                   foSingleLineObject,  // Object without CR/LF : all on one line
+                   foDoNotQuoteMembers, // Do not quote object member names.
+                   foUseTabchar);       // Use tab characters instead of spaces.
+  TFormatOptions = set of TFormatOption;
+
+Const
+  DefaultIndentSize = 2;
+  DefaultFormat     = [];
+  AsJSONFormat      = [foSingleLineArray,foSingleLineObject]; // These options make FormatJSON behave as AsJSON
+  
+Type
 
   { TJSONData }
-
+  
   TJSONData = class(TObject)
   protected
     function GetAsBoolean: Boolean; virtual; abstract;
@@ -52,12 +64,14 @@ type
     procedure SetValue(const AValue: variant); virtual; abstract;
     function GetItem(Index : Integer): TJSONData; virtual;
     procedure SetItem(Index : Integer; const AValue: TJSONData); virtual;
+    Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; virtual;
     function GetCount: Integer; virtual;
   public
     Constructor Create; virtual;
     Class function JSONType: TJSONType; virtual;
     Procedure Clear;  virtual; Abstract;
     Function Clone : TJSONData; virtual; abstract;
+    Function FormatJSON(Options : TFormatOptions = DefaultFormat; Indentsize : Integer = DefaultIndentSize) : TJSONStringType; 
     property Count: Integer read GetCount;
     property Items[Index: Integer]: TJSONData read GetItem write SetItem;
     property Value: variant read GetValue write SetValue;
@@ -277,6 +291,7 @@ type
     function GetCount: Integer; override;
     function GetItem(Index : Integer): TJSONData; override;
     procedure SetItem(Index : Integer; const AValue: TJSONData); override;
+    Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
   public
     Constructor Create; overload; reintroduce;
     Constructor Create(const Elements : Array of Const); overload;
@@ -357,6 +372,7 @@ type
     function GetCount: Integer; override;
     function GetItem(Index : Integer): TJSONData; override;
     procedure SetItem(Index : Integer; const AValue: TJSONData); override;
+    Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
   public
     constructor Create; reintroduce;
     Constructor Create(const Elements : Array of Const); overload;
@@ -541,6 +557,18 @@ begin
   // Do Nothing
 end;
 
+Function TJSONData.FormatJSON(Options : TFormatOptions = DefaultFormat; IndentSize : Integer = DefaultIndentSize) : TJSONStringType;
+
+begin
+  Result:=DoFormatJSON(Options,0,IndentSize);
+end;
+
+Function TJSONData.DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; 
+
+begin
+  Result:=AsJSON;
+end;
+
 { TJSONnumber }
 
 class function TJSONnumber.JSONType: TJSONType;
@@ -1256,6 +1284,42 @@ begin
 end;
 
 {$warnings off}
+
+Function IndentString(Options : TFormatOptions; Indent : Integer) : TJSONStringType;
+
+begin
+  If (foUseTabChar in Options) then
+    Result:=StringofChar(#9,Indent)
+  else
+    Result:=StringOfChar(' ',Indent);  
+end;
+
+Function TJSONArray.DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; 
+
+Var
+  I : Integer;
+  
+begin
+  Result:='[';
+  if not (foSingleLineArray in Options) then
+    Result:=Result+sLineBreak;
+  For I:=0 to Count-1 do
+    begin
+    if not (foSingleLineArray in Options) then
+      Result:=Result+IndentString(Options, CurrentIndent+Indent);
+    Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
+    If (I<Count-1) then
+      if (foSingleLineArray in Options) then
+        Result:=Result+', '
+      else
+        Result:=Result+',';
+    if not (foSingleLineArray in Options) then
+      Result:=Result+sLineBreak
+    end;
+  Result:=Result+']';
+end;
+
+
 function TJSONArray.GetAsString: TJSONStringType;
 begin
   ConvertError(True);
@@ -1748,6 +1812,43 @@ begin
   end;
 end;
 
+
+Function TJSONObject.DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; 
+
+Var
+  i : Integer;
+  S : TJSONStringType;
+
+
+begin
+  CurrentIndent:=CurrentIndent+Indent;  
+  For I:=0 to Count-1 do
+    begin
+    If (Result<>'') then
+      begin
+      If (foSingleLineObject in Options) then
+        Result:=Result+', '
+      else
+        Result:=Result+','+SLineBreak;
+      end;
+    If not (foSingleLineObject in Options) then    
+      Result:=Result+IndentString(Options,CurrentIndent);
+    S:=StringToJSONString(Names[i]);
+    If not (foDoNotQuoteMembers in options) then
+      S:='"'+S+'"';
+    Result:=Result+S+' : '+Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
+    end;
+  If (Result<>'') then
+    begin
+    if (foSingleLineObject in Options) then
+      Result:='{ '+Result+' }'
+    else  
+      Result:='{'+sLineBreak+Result+sLineBreak+indentString(options,CurrentIndent-Indent)+'}'
+    end
+  else
+    Result:='{}';
+end;
+
 procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject);
 
 Var

packages/fcl-json/tests/testjsondata.pp

@@ -56,6 +56,7 @@ type
   published
     procedure TestNull;
     Procedure TestClone;
+    Procedure TestFormat;
   end;
   
   { TTestBoolean }
@@ -65,6 +66,7 @@ type
     procedure TestTrue;
     procedure TestFalse;
     Procedure TestClone;
+    Procedure TestFormat;
   end;
   
   { TTestInteger }
@@ -77,6 +79,7 @@ type
     procedure TestNegative;
     procedure TestZero;
     Procedure TestClone;
+    Procedure TestFormat;
   end;
 
   { TTestInt64 }
@@ -89,6 +92,7 @@ type
     procedure TestNegative;
     procedure TestZero;
     Procedure TestClone;
+    Procedure TestFormat;
   end;
   
   { TTestFloat }
@@ -101,6 +105,7 @@ type
     procedure TestNegative;
     procedure TestZero;
     Procedure TestClone;
+    Procedure TestFormat;
   end;
 
   { TTestString }
@@ -117,6 +122,7 @@ type
     Procedure TestBooleanTrue;
     Procedure TestBooleanFalse;
     Procedure TestClone;
+    Procedure TestFormat;
   end;
   
   { TTestArray }
@@ -150,6 +156,7 @@ type
     procedure TestDelete;
     procedure TestRemove;
     Procedure TestClone;
+    Procedure TestFormat;
   end;
   
   { TTestObject }
@@ -186,6 +193,7 @@ type
     procedure TestClone;
     procedure TestExtract;
     Procedure TestNonExistingAccessError;
+    Procedure TestFormat;
   end;
 
 
@@ -449,6 +457,20 @@ begin
   end;
 end;
 
+procedure TTestBoolean.TestFormat;
+
+Var
+  B : TJSONBoolean;
+
+begin
+  B:=TJSONBoolean.Create(true);
+  try
+    AssertEquals('FormatJSON same as asJSON',B.asJSON,B.FormatJSON);
+  finally
+    B.Free;
+  end;
+end;
+
 
 
 { TTestNull }
@@ -495,6 +517,18 @@ begin
   end;
 end;
 
+procedure TTestNull.TestFormat;
+Var
+  J : TJSONNull;
+begin
+  J:=TJSONNull.Create;
+  try
+    AssertEquals('FormatJSON same as asJSON',J.asJSON,J.FormatJSON);
+  finally
+    J.Free;
+  end;
+end;
+
 
 { TTestString }
 
@@ -663,6 +697,19 @@ begin
   end;
 end;
 
+procedure TTestString.TestFormat;
+Var
+  S : TJSONString;
+
+begin
+  S:=TJSONString.Create('aloha');
+  try
+    AssertEquals('FormatJSON equals JSON',S.AsJSON,S.FormatJSOn);
+  finally
+    FreeAndNil(S);
+  end;
+end;
+
 procedure TTestString.DoTestFloat(F : TJSOnFloat;S : String; OK : Boolean);
 
 Var
@@ -749,6 +796,20 @@ begin
 
 end;
 
+procedure TTestInteger.TestFormat;
+
+Var
+  I : TJSONIntegerNumber;
+
+begin
+  I:=TJSONIntegerNumber.Create(99);
+  try
+    AssertEquals('FormatJSON equal to JSON',I.AsJSON,I.FormatJSON);
+  finally
+    FreeAndNil(I);
+  end;
+end;
+
 { TTestInt64 }
 
 procedure TTestInt64.DoTest(I: Int64);
@@ -813,6 +874,19 @@ begin
 
 end;
 
+procedure TTestInt64.TestFormat;
+Var
+  I : TJSONInt64Number;
+
+begin
+  I:=TJSONInt64Number.Create(99);
+  try
+    AssertEquals('FormatJSON equal to JSON',I.AsJSON,I.FormatJSON);
+  finally
+    FreeAndNil(I);
+  end;
+end;
+
 { TTestFloat }
 
 procedure TTestFloat.DoTest(F: TJSONFloat);
@@ -888,6 +962,21 @@ begin
 
 end;
 
+procedure TTestFloat.TestFormat;
+
+Var
+  F : TJSONFloatNumber;
+
+
+begin
+  F:=TJSONFloatNumber.Create(1.23);
+  try
+    AssertEquals('FormatJSON equals asJSON',F.AsJSON,F.FormatJSON);
+  finally
+    FreeAndNil(F);
+  end;
+end;
+
 { TTestArray }
 
 procedure TTestArray.TestCreate;
@@ -1437,6 +1526,32 @@ begin
   end;
 end;
 
+procedure TTestArray.TestFormat;
+Var
+  J : TJSONArray;
+  I : TJSONData;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(0);
+    J.Add(1);
+    J.Add(2);
+    TestItemCount(J,3);
+    TestJSONType(J[0],jtNumber);
+    TestJSONType(J[1],jtNumber);
+    TestJSONType(J[2],jtNumber);
+    TestJSON(J,'[0, 1, 2]');
+    AssertEquals('FormatJSON, single line',J.AsJSON,J.FormatJSON([foSingleLineArray],1));
+    AssertEquals('FormatJSON, single line','['+sLinebreak+'  0,'+sLinebreak+'  1,'+sLinebreak+'  2'+sLinebreak+']',J.FormatJSON());
+    AssertEquals('FormatJSON, single line','['+sLinebreak+#9'0,'+sLinebreak+#9'1,'+sLinebreak+#9'2'+sLinebreak+']',J.FormatJSON([foUseTabChar],1));
+    J.Add(TJSONObject.Create(['x',1,'y',2]));
+    AssertEquals('FormatJSON, single line','['+sLinebreak+#9'0,'+sLinebreak+#9'1,'+sLinebreak+#9'2,'+sLinebreak+#9'{'+sLineBreak+#9#9'"x" : 1,'+sLineBreak+#9#9'"y" : 2'+sLinebreak+#9'}'+sLineBreak+']',J.FormatJSON([foUseTabChar],1));
+  finally
+    J.Free
+  end;
+end;
+
 { TTestObject }
 
 procedure TTestObject.TestCreate;
@@ -1833,6 +1948,26 @@ begin
   AssertException(EJSON,@TestAccessError);
 end;
 
+procedure TTestObject.TestFormat;
+
+Var
+  O : TJSONObject;
+
+begin
+  O:=TJSONObject.Create(['x',1,'y',2]);
+  try
+    TestJSON(O,'{ "x" : 1, "y" : 2 }');
+    AssertEquals('Format equals JSON',O.AsJSON,O.FormatJSON([foSingleLineObject]));
+    AssertEquals('Format 1','{'+sLineBreak+'  "x" : 1,'+sLineBreak+'  "y" : 2'+sLineBreak+'}',O.FormatJSON([]));
+    AssertEquals('Format 1','{'+sLineBreak+'  x : 1,'+sLineBreak+'  y : 2'+sLineBreak+'}',O.FormatJSON([foDoNotQuoteMembers]));
+    AssertEquals('Format 1','{'+sLineBreak+#9'x : 1,'+sLineBreak+#9'y : 2'+sLineBreak+'}',O.FormatJSON([foUseTabChar,foDoNotQuoteMembers],1));
+    O.Add('s',TJSONObject.Create(['w',10,'h',20]));
+    AssertEquals('Format 1','{'+sLineBreak+#9'x : 1,'+sLineBreak+#9'y : 2,'+sLineBreak+#9's : {'+sLineBreak+#9#9'w : 10,'+sLineBreak+#9#9'h : 20'+sLineBreak+#9'}'+sLineBreak+'}',O.FormatJSON([foUseTabChar,foDoNotQuoteMembers],1));
+  finally
+    O.Free;
+  end;
+end;
+
 
 procedure TTestObject.TestCreateString;
 

packages/fcl-json/tests/testjsonparser.pp

@@ -135,7 +135,7 @@ Var
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create('True');
+  P:=TJSONParser.Create('true');
   Try
     J:=P.Parse;
     If (J=Nil) then
@@ -155,7 +155,7 @@ Var
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create('False');
+  P:=TJSONParser.Create('false');
   Try
     J:=P.Parse;
     If (J=Nil) then
@@ -339,6 +339,7 @@ Var
 begin
   ParseOK:=False;
   P:=TJSONParser.Create(S);
+  P.Strict:=True;
   J:=Nil;
   Try
     Try

packages/fcl-process/src/unix/process.inc

@@ -136,6 +136,15 @@ end;
 
 Function MakeCommand(P : TProcess) : PPchar;
 
+{$ifdef darwin}
+Const
+  TerminalApp = 'open';
+{$endif}
+{$ifdef haiku}
+Const
+  TerminalApp = 'Terminal';
+{$endif}
+  
 Var
   Cmd : String;
   S  : TStringList;
@@ -160,8 +169,15 @@ begin
     CommandToList(Cmd,S);
     if poNewConsole in P.Options then
       begin
-      {$ifdef darwin}
-      S.Insert(0,'open');
+      {$ifdef haiku}
+      If (P.ApplicationName<>'') then
+        begin
+        S.Insert(0,P.ApplicationName);
+        S.Insert(0,'--title');
+        end;
+      {$endif}
+      {$if defined(darwin) or defined(haiku)}
+      S.Insert(0,TerminalApp);
       {$else}
       S.Insert(0,'-e');
       If (P.ApplicationName<>'') then
@@ -177,6 +193,7 @@ begin
       S.Insert(0,'xterm');
       {$endif}
       end;
+    {$ifndef haiku}
     if (P.ApplicationName<>'') then
       begin
       S.Add(TitleOption);
@@ -192,6 +209,7 @@ begin
       S.Add(GeometryOption);
       S.Add(g);
       end;
+    {$endif}
     Result:=StringsToPcharList(S);
   Finally
     S.free;
@@ -293,7 +311,16 @@ begin
         end;
 
 {$if (defined(DARWIN) or defined(SUNOS))}
-        Pid:=fpvfork;
+        { can't use vfork in case the child has to be
+          suspended immediately, because with vfork the
+          child borrows the execution thread of the parent
+          unit it either exits or execs -> potential 
+          deadlock depending on how quickly the SIGSTOP
+          signal is delivered }
+        if not(poRunSuspended in Options) then
+          Pid:=fpvfork
+        else
+          Pid:=fpfork;
 {$else}
         Pid:=fpfork;
 {$endif}
@@ -405,7 +432,11 @@ begin
     If Running then
       Result:=fpkill(Handle,SIGKILL)=0;
     end;
-  GetExitStatus;
+  { the fact that the signal has been sent does not
+    mean that the process has already handled the
+    signal -> wait instead of calling getexitstatus }
+  if Result then
+    WaitOnExit;
 end;
 
 Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);

packages/fpvectorial/examples/fpvc_mainform.lfm

@@ -10,26 +10,28 @@ object formVectorialConverter: TformVectorialConverter
   LCLVersion = '0.9.29'
   object Label1: TLabel
     Left = 8
-    Height = 14
-    Top = 104
-    Width = 123
+    Height = 17
+    Top = 112
+    Width = 160
     Caption = 'Location of the Input file:'
     ParentColor = False
   end
   object Label2: TLabel
     Left = 11
-    Height = 96
+    Height = 104
     Top = 8
-    Width = 224
+    Width = 229
     AutoSize = False
     Caption = 'This converter application use the fpvectorial library to convert between various different vectorial graphics formats. The type is detected from the extension and the supported types are: PDF (*.pdf), SVG (*.svg) and Corel Draw file (*.cdr).'
+    Font.Height = -12
     ParentColor = False
+    ParentFont = False
     WordWrap = True
   end
   object editInput: TFileNameEdit
     Left = 8
-    Height = 21
-    Top = 120
+    Height = 22
+    Top = 128
     Width = 192
     DialogOptions = []
     FilterIndex = 0
@@ -41,16 +43,16 @@ object formVectorialConverter: TformVectorialConverter
   end
   object Label3: TLabel
     Left = 8
-    Height = 14
-    Top = 144
-    Width = 132
+    Height = 17
+    Top = 152
+    Width = 173
     Caption = 'Full path of the Output file:'
     ParentColor = False
   end
   object editOutput: TFileNameEdit
     Left = 8
-    Height = 21
-    Top = 160
+    Height = 22
+    Top = 168
     Width = 192
     DialogOptions = []
     FilterIndex = 0

packages/fpvectorial/examples/fpvectorialconverter.lpi

@@ -8,6 +8,7 @@
         <AlwaysBuild Value="False"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
       <Title Value="fpvectorialconverter"/>
       <UseXPManifest Value="True"/>
       <Icon Value="0"/>
@@ -18,6 +19,9 @@
     <VersionInfo>
       <StringTable ProductVersion=""/>
     </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@@ -55,7 +59,7 @@
       <Filename Value="fpvectorialconverter"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)\"/>
+      <IncludeFiles Value="$(ProjOutDir)"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>

packages/fpvectorial/src/fpvectorial.pas

@@ -48,20 +48,64 @@ type
     the starting point is in the bottom-left corner of the document.
     The X grows to the right and the Y grows to the top.
   }
-  TPathSegment = record
+  { TPathSegment }
+
+  TPathSegment = class
+  public
     SegmentType: TSegmentType;
-    X, Y, Z: Double; // Z is ignored in 2D segments
-    X2, Y2, Z2: Double; // Z is ignored in 2D segments
-    X3, Y3, Z3: Double; // Z is ignored in 2D segments
+    // Fields for linking the list
+    Previous: TPathSegment;
+    Next: TPathSegment;
   end;
 
-  TPath = record
-    Len: Integer;
-    // ToDo: make the array dynamic
-    Points: array[0..255] of TPathSegment;
+  {@@
+    In a 2D segment, the X and Y coordinates represent usually the
+    final point of the segment, being that it starts where the previous
+    segment ends. The exception is for the first segment of all, which simply
+    holds the starting point for the drawing and should always be of the type
+    stMoveTo.
+  }
+  T2DSegment = class(TPathSegment)
+  public
+    X, Y: Double;
+  end;
+
+  {@@
+    In Bezier segments, we remain using the X and Y coordinates for the ending point.
+    The starting point is where the previous segment ended, so that the intermediary
+    bezier control points are [X2, Y2] and [X3, Y3].
+  }
+  T2DBezierSegment = class(T2DSegment)
+  public
+    X2, Y2: Double;
+    X3, Y3: Double;
   end;
 
-  PPath = ^TPath;
+  T3DSegment = class(TPathSegment)
+  public
+    {@@
+      Coordinates of the end of the segment.
+      For the first segment, this is the starting point.
+    }
+    X, Y, Z: Double;
+  end;
+
+  T3DBezierSegment = class(T3DSegment)
+  public
+    X2, Y2, Z2: Double;
+    X3, Y3, Z3: Double;
+  end;
+
+  TPath = class
+    Len: Integer;
+    Points: TPathSegment; // Beginning of the double-linked list
+    PointsEnd: TPathSegment; // End of the double-linked list
+    CurPoint: TPathSegment; // Used in PrepareForSequentialReading and Next
+    procedure Assign(APath: TPath);
+    function Count(): TPathSegment;
+    procedure PrepareForSequentialReading;
+    function Next(): TPathSegment;
+  end;
 
   {@@
     TvText represents a text in memory.
@@ -69,16 +113,14 @@ type
     At the moment fonts are unsupported, only simple texts
     up to 255 chars are supported.
   }
-
-  TvText = record
+  TvText = class
+  public
     X, Y, Z: Double; // Z is ignored in 2D formats
     FontSize: integer;
     FontName: utf8string;
     Value: utf8string;
   end;
 
-  PText = ^TvText;
-
 type
 
   TvCustomVectorialWriter = class;
@@ -95,6 +137,8 @@ type
     procedure RemoveCallback(data, arg: pointer);
     function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
     function CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
+    procedure ClearTmpPath();
+    procedure AppendSegmentToTmpPath(ASegment: TPathSegment);
   public
     Name: string;
     Width, Height: Double; // in millimeters
@@ -185,6 +229,9 @@ procedure RegisterVectorialWriter(
 
 implementation
 
+const
+  Str_Error_Nil_Path = ' The program attempted to add a segment before creating a path';
+
 {@@
   Registers a new reader for a format
 }
@@ -276,7 +323,11 @@ end;
 }
 procedure TvVectorialDocument.RemoveCallback(data, arg: pointer);
 begin
-  if data <> nil then FreeMem(data);
+{  if data <> nil then
+  begin
+    ldata := PObject(data);
+    ldata^.Free;
+  end;}
 end;
 
 {@@
@@ -288,6 +339,7 @@ begin
 
   FPaths := TFPList.Create;
   FTexts := TFPList.Create;
+  FTmpPath := TPath.Create;
 end;
 
 {@@
@@ -308,28 +360,27 @@ end;
 }
 procedure TvVectorialDocument.RemoveAllPaths;
 begin
-  FPaths.ForEachCall(RemoveCallback, nil);
+//  FPaths.ForEachCall(RemoveCallback, nil);
   FPaths.Clear;
 end;
 
 procedure TvVectorialDocument.RemoveAllTexts;
 begin
-  FTexts.ForEachCall(RemoveCallback, nil);
+//  FTexts.ForEachCall(RemoveCallback, nil);
   FTexts.Clear;
 end;
 
 procedure TvVectorialDocument.AddPath(APath: TPath);
 var
-  Path: PPath;
+  lPath: TPath;
   Len: Integer;
 begin
-  Len := SizeOf(TPath);
+  lPath := TPath.Create;
+  lPath.Assign(APath);
+  FPaths.Add(Pointer(lPath));
   //WriteLn(':>TvVectorialDocument.AddPath 1 Len = ', Len);
-  Path := GetMem(Len);
   //WriteLn(':>TvVectorialDocument.AddPath 2');
-  Move(APath, Path^, Len);
   //WriteLn(':>TvVectorialDocument.AddPath 3');
-  FPaths.Add(Path);
   //WriteLn(':>TvVectorialDocument.AddPath 4');
 end;
 
@@ -341,11 +392,19 @@ end;
   @see    StartPath, AddPointToPath
 }
 procedure TvVectorialDocument.StartPath(AX, AY: Double);
+var
+  segment: T2DSegment;
 begin
+  ClearTmpPath();
+
   FTmpPath.Len := 1;
-  FTmpPath.Points[0].SegmentType := stMoveTo;
-  FTmpPath.Points[0].X := AX;
-  FTmpPath.Points[0].Y := AY;
+  segment := T2DSegment.Create;
+  segment.SegmentType := stMoveTo;
+  segment.X := AX;
+  segment.Y := AY;
+
+  FTmpPath.Points := segment;
+  FTmpPath.PointsEnd := segment;
 end;
 
 {@@
@@ -360,60 +419,69 @@ end;
 }
 procedure TvVectorialDocument.AddLineToPath(AX, AY: Double);
 var
-  L: Integer;
+  segment: T2DSegment;
 begin
-  L := FTmpPath.Len;
-  Inc(FTmpPath.Len);
-  FTmpPath.Points[L].SegmentType := st2DLine;
-  FTmpPath.Points[L].X := AX;
-  FTmpPath.Points[L].Y := AY;
+  segment := T2DSegment.Create;
+  segment.SegmentType := st2DLine;
+  segment.X := AX;
+  segment.Y := AY;
+
+  AppendSegmentToTmpPath(segment);
 end;
 
 procedure TvVectorialDocument.AddLineToPath(AX, AY, AZ: Double);
 var
-  L: Integer;
+  segment: T3DSegment;
 begin
-  L := FTmPPath.Len;
-  Inc(FTmPPath.Len);
-  FTmPPath.Points[L].SegmentType := st3DLine;
-  FTmPPath.Points[L].X := AX;
-  FTmPPath.Points[L].Y := AY;
-  FTmPPath.Points[L].Z := AZ;
+  segment := T3DSegment.Create;
+  segment.SegmentType := st3DLine;
+  segment.X := AX;
+  segment.Y := AY;
+  segment.Z := AZ;
+
+  AppendSegmentToTmpPath(segment);
 end;
 
+{@@
+  Adds a bezier element to the path. It starts where the previous element ended
+  and it goes throw the control points [AX1, AY1] and [AX2, AY2] and ends
+  in [AX3, AY3].
+}
 procedure TvVectorialDocument.AddBezierToPath(AX1, AY1, AX2, AY2, AX3,
   AY3: Double);
 var
-  L: Integer;
+  segment: T2DBezierSegment;
 begin
-  L := FTmPPath.Len;
-  Inc(FTmPPath.Len);
-  FTmPPath.Points[L].SegmentType := st2DBezier;
-  FTmPPath.Points[L].X := AX3;
-  FTmPPath.Points[L].Y := AY3;
-  FTmPPath.Points[L].X2 := AX1;
-  FTmPPath.Points[L].Y2 := AY1;
-  FTmPPath.Points[L].X3 := AX2;
-  FTmPPath.Points[L].Y3 := AY2;
+  segment := T2DBezierSegment.Create;
+  segment.SegmentType := st2DBezier;
+  segment.X := AX3;
+  segment.Y := AY3;
+  segment.X2 := AX1;
+  segment.Y2 := AY1;
+  segment.X3 := AX2;
+  segment.Y3 := AY2;
+
+  AppendSegmentToTmpPath(segment);
 end;
 
 procedure TvVectorialDocument.AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2,
   AX3, AY3, AZ3: Double);
 var
-  L: Integer;
+  segment: T3DBezierSegment;
 begin
-  L := FTmPPath.Len;
-  Inc(FTmPPath.Len);
-  FTmPPath.Points[L].SegmentType := st3DBezier;
-  FTmPPath.Points[L].X := AX3;
-  FTmPPath.Points[L].Y := AY3;
-  FTmPPath.Points[L].Z := AZ3;
-  FTmPPath.Points[L].X2 := AX1;
-  FTmPPath.Points[L].Y2 := AY1;
-  FTmPPath.Points[L].Z2 := AZ1;
-  FTmPPath.Points[L].X3 := AX2;
-  FTmPPath.Points[L].Y3 := AY2;
-  FTmPPath.Points[L].Z3 := AZ2;
+  segment := T3DBezierSegment.Create;
+  segment.SegmentType := st3DBezier;
+  segment.X := AX3;
+  segment.Y := AY3;
+  segment.Z := AZ3;
+  segment.X2 := AX1;
+  segment.Y2 := AY1;
+  segment.Z2 := AZ1;
+  segment.X3 := AX2;
+  segment.Y3 := AY2;
+  segment.Z3 := AZ2;
+
+  AppendSegmentToTmpPath(segment);
 end;
 
 {@@
@@ -430,15 +498,14 @@ procedure TvVectorialDocument.EndPath();
 begin
   if FTmPPath.Len = 0 then Exit;
   AddPath(FTmPPath);
-  FTmPPath.Len := 0;
+  ClearTmpPath();
 end;
 
 procedure TvVectorialDocument.AddText(AX, AY, AZ: Double; FontName: string; FontSize: integer; AText: utf8string);
 var
-  lText: PText;
+  lText: TvText;
 begin
-  lText := GetMem(SizeOf(TvText));
-  FillChar(lText^, SizeOf(TvText), 0);
+  lText := TvText.Create;
   lText.Value := AText;
   lText.X := AX;
   lText.Y := AY;
@@ -495,6 +562,40 @@ begin
   if Result = nil then raise Exception.Create('Unsuported vector graphics format.');
 end;
 
+procedure TvVectorialDocument.ClearTmpPath();
+var
+  segment, oldsegment: TPathSegment;
+begin
+//  segment := FTmpPath.Points;
+// Don't free segments, because they are used when the path is added
+//  while segment <> nil do
+//  begin
+//    oldsegment := segment;
+//    segment := segment^.Next;
+//    oldsegment^.Free;
+//  end;
+
+  FTmpPath.Points := nil;
+  FTmpPath.PointsEnd := nil;
+  FTmpPath.Len := 0;
+end;
+
+procedure TvVectorialDocument.AppendSegmentToTmpPath(ASegment: TPathSegment);
+var
+  L: Integer;
+begin
+  if FTmpPath.PointsEnd = nil then
+    Exception.Create('[TvVectorialDocument.AppendSegmentToTmpPath]' + Str_Error_Nil_Path);
+
+  L := FTmpPath.Len;
+  Inc(FTmpPath.Len);
+
+  // Adds the element to the end of the list
+  FTmpPath.PointsEnd.Next := ASegment;
+  ASegment.Previous := FTmpPath.PointsEnd;
+  FTmpPath.PointsEnd := ASegment;
+end;
+
 {@@
   Writes the document to a file.
 
@@ -624,7 +725,7 @@ begin
 
   if FPaths.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetPath: Invalid Path number');
 
-  Result := PPath(FPaths.Items[ANum])^;
+  Result := TPath(FPaths.Items[ANum]);
 end;
 
 function TvVectorialDocument.GetPathCount: Integer;
@@ -638,7 +739,7 @@ begin
 
   if FTexts.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetText: Invalid Text number');
 
-  Result := PText(FTexts.Items[ANum])^;
+  Result := TvText(FTexts.Items[ANum]);
 end;
 
 function TvVectorialDocument.GetTextCount: Integer;
@@ -751,6 +852,34 @@ begin
 
 end;
 
+{ TPath }
+
+procedure TPath.Assign(APath: TPath);
+begin
+  Len := APath.Len;
+  Points := APath.Points;
+  PointsEnd := APath.PointsEnd;
+  CurPoint := APath.CurPoint;
+end;
+
+function TPath.Count(): TPathSegment;
+begin
+
+end;
+
+procedure TPath.PrepareForSequentialReading;
+begin
+  CurPoint := nil;
+end;
+
+function TPath.Next(): TPathSegment;
+begin
+  if CurPoint = nil then Result := Points
+  else Result := CurPoint.Next;
+
+  CurPoint := Result;
+end;
+
 finalization
 
   SetLength(GvVectorialFormats, 0);

packages/fpvectorial/src/fpvtocanvas.pas

@@ -34,6 +34,8 @@ var
   i, j, k: Integer;
   PosX, PosY: Integer; // Not modified by ADestX, etc
   CurSegment: TPathSegment;
+  Cur2DSegment: T2DSegment absolute CurSegment;
+  Cur2DBSegment: T2DBezierSegment absolute CurSegment;
   // For bezier
   CurX, CurY: Integer; // Not modified by ADestX, etc
   CurveLength: Integer;
@@ -51,15 +53,18 @@ begin
   for i := 0 to ASource.PathCount - 1 do
   begin
     //WriteLn('i = ', i);
-    for j := 0 to Length(ASource.Paths[i].Points) - 1 do
+    ASource.Paths[i].PrepareForSequentialReading;
+
+    for j := 0 to ASource.Paths[i].Len - 1 do
     begin
       //WriteLn('j = ', j);
-      CurSegment := ASource.Paths[i].Points[j];
+      CurSegment := TPathSegment(ASource.Paths[i].Next());
+
       case CurSegment.SegmentType of
       st2DLine, st3DLine:
       begin
-        PosX := Round(CurSegment.X);
-        PosY := Round(CurSegment.Y);
+        PosX := Round(Cur2DSegment.X);
+        PosY := Round(Cur2DSegment.Y);
         ADest.LineTo(
           Round(ADestX + AMulX * PosX),
           Round(ADestY + AMulY * PosY)
@@ -70,21 +75,21 @@ begin
       st2DBezier, st3DBezier:
       begin
         CurveLength :=
-          Round(sqrt(sqr(CurSegment.X3 - PosX) + sqr(CurSegment.Y3 - PosY))) +
-          Round(sqrt(sqr(CurSegment.X2 - CurSegment.X3) + sqr(CurSegment.Y2 - CurSegment.Y3))) +
-          Round(sqrt(sqr(CurSegment.X - CurSegment.X3) + sqr(CurSegment.Y - CurSegment.Y3)));
+          Round(sqrt(sqr(Cur2DBSegment.X3 - PosX) + sqr(Cur2DBSegment.Y3 - PosY))) +
+          Round(sqrt(sqr(Cur2DBSegment.X2 - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y2 - Cur2DBSegment.Y3))) +
+          Round(sqrt(sqr(Cur2DBSegment.X - Cur2DBSegment.X3) + sqr(Cur2DBSegment.Y - Cur2DBSegment.Y3)));
 
         for k := 1 to CurveLength do
         begin
           t := k / CurveLength;
-          CurX := Round(sqr(1 - t) * (1 - t) * PosX + 3 * t * sqr(1 - t) * CurSegment.X2 + 3 * t * t * (1 - t) * CurSegment.X3 + t * t * t * CurSegment.X);
-          CurY := Round(sqr(1 - t) * (1 - t) * PosY + 3 * t * sqr(1 - t) * CurSegment.Y2 + 3 * t * t * (1 - t) * CurSegment.Y3 + t * t * t * CurSegment.Y);
+          CurX := Round(sqr(1 - t) * (1 - t) * PosX + 3 * t * sqr(1 - t) * Cur2DBSegment.X2 + 3 * t * t * (1 - t) * Cur2DBSegment.X3 + t * t * t * Cur2DBSegment.X);
+          CurY := Round(sqr(1 - t) * (1 - t) * PosY + 3 * t * sqr(1 - t) * Cur2DBSegment.Y2 + 3 * t * t * (1 - t) * Cur2DBSegment.Y3 + t * t * t * Cur2DBSegment.Y);
           ADest.LineTo(
             Round(ADestX + AMulX * CurX),
             Round(ADestY + AMulY * CurY));
         end;
-        PosX := Round(CurSegment.X);
-        PosY := Round(CurSegment.Y);
+        PosX := Round(Cur2DBSegment.X);
+        PosY := Round(Cur2DBSegment.Y);
       end;
       end;
     end;

packages/fpvectorial/src/svgvectorialwriter.pas

@@ -81,6 +81,9 @@ var
   lPath: TPath;
   PtX, PtY, OldPtX, OldPtY: double;
   BezierCP1X, BezierCP1Y, BezierCP2X, BezierCP2Y: double;
+  segment: TPathSegment;
+  l2DSegment: T2DSegment absolute segment;
+  l2DBSegment: T2DBezierSegment absolute segment;
 begin
   for i := 0 to AData.GetPathCount() - 1 do
   begin
@@ -89,38 +92,42 @@ begin
 
     PathStr := '';
     lPath := AData.GetPath(i);
+    lPath.PrepareForSequentialReading;
+
     for j := 0 to lPath.Len - 1 do
     begin
-      if (lPath.Points[j].SegmentType <> st2DLine)
-        and (lPath.Points[j].SegmentType <> stMoveTo)
-        and (lPath.Points[j].SegmentType <> st2DBezier)
+      segment := TPathSegment(lPath.Next());
+
+      if (segment.SegmentType <> st2DLine)
+        and (segment.SegmentType <> stMoveTo)
+        and (segment.SegmentType <> st2DBezier)
         then Break; // unsupported line type
 
       // Coordinate conversion from fpvectorial to SVG
       ConvertFPVCoordinatesToSVGCoordinates(
-        AData, lPath.Points[j].X, lPath.Points[j].Y, PtX, PtY);
+        AData, l2DSegment.X, l2DSegment.Y, PtX, PtY);
       PtX := PtX - OldPtX;
       PtY := PtY - OldPtY;
 
-      if (lPath.Points[j].SegmentType = stMoveTo) then
+      if (segment.SegmentType = stMoveTo) then
       begin
         PathStr := PathStr + 'm '
           + FloatToStr(PtX, FPointSeparator) + ','
           + FloatToStr(PtY, FPointSeparator) + ' ';
       end
-      else if (lPath.Points[j].SegmentType = st2DLine) then
+      else if (segment.SegmentType = st2DLine) then
       begin
         PathStr := PathStr + 'l '
           + FloatToStr(PtX, FPointSeparator) + ','
           + FloatToStr(PtY, FPointSeparator) + ' ';
       end
-      else if (lPath.Points[j].SegmentType = st2DBezier) then
+      else if (segment.SegmentType = st2DBezier) then
       begin
         // Converts all coordinates to absolute values
         ConvertFPVCoordinatesToSVGCoordinates(
-          AData, lPath.Points[j].X2, lPath.Points[j].Y2, BezierCP1X, BezierCP1Y);
+          AData, l2DBSegment.X2, l2DBSegment.Y2, BezierCP1X, BezierCP1Y);
         ConvertFPVCoordinatesToSVGCoordinates(
-          AData, lPath.Points[j].X3, lPath.Points[j].Y3, BezierCP2X, BezierCP2Y);
+          AData, l2DBSegment.X3, l2DBSegment.Y3, BezierCP2X, BezierCP2Y);
 
         // Transforms them into values relative to the initial point
         BezierCP1X := BezierCP1X - OldPtX;

packages/graph/src/ptcgraph/ptccrt.pp

@@ -79,7 +79,10 @@ end;
 
 procedure KeyBufAdd(Ch: Char);
 begin
-  {todo: overflow checking}
+  { do nothing, if the buffer is full }
+  if ((KeyBufTail + 1) = KeyBufHead) or
+     ((KeyBufTail = High(KeyBuffer)) and (KeyBufHead = Low(KeyBuffer))) then
+    exit;
   KeyBuffer[KeyBufTail] := Ch;
   Inc(KeyBufTail);
   if KeyBufTail > High(KeyBuffer) then

packages/graph/src/ptcgraph/ptcgraph.pp

@@ -614,6 +614,32 @@ begin
   CurrentCGABkColor := 0;
 end;
 
+procedure ptc_InitPaletteMCGA2;
+var
+  PaletteData: PUint32;
+  I: Integer;
+  r, g, b: Uint32;
+begin
+  VGAPalette := DefaultVGA16Palette;
+  FillChar(EGAPalette, SizeOf(EGAPalette), 0);
+  EGAPaletteEnabled := True;
+
+  for I := 1 to 15 do
+    EGAPalette[I] := 63;
+
+  PaletteData := ptc_palette_lock;
+  FillChar(PaletteData^, 256*4, 0);
+  for I := 0 to 1 do
+  begin
+    r := VGA6to8(VGAPalette[EGAPalette[I], 0]);
+    g := VGA6to8(VGAPalette[EGAPalette[I], 1]);
+    b := VGA6to8(VGAPalette[EGAPalette[I], 2]);
+    PaletteData[I] := (r shl 16) or (g shl 8) or b;
+  end;
+  ptc_palette_unlock;
+  CurrentCGABkColor := 0;
+end;
+
 procedure ptc_InternalOpen(const ATitle: string; AWidth, AHeight: Integer; AFormat: TPTCFormat; AVirtualPages: Integer);
 var
   ConsoleWidth, ConsoleHeight: Integer;
@@ -717,6 +743,21 @@ begin
   ColorMask := 1;
 end;
 
+procedure ptc_InitModeMCGA2(XResolution, YResolution, Pages: LongInt);
+begin
+{$IFDEF logging}
+  LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 2 colours');
+{$ENDIF logging}
+  { open the console }
+  ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, Pages);
+  PTCWidth := XResolution;
+  PTCHeight := YResolution;
+  CurrentActivePage := 0;
+  { create palette }
+  ptc_InitPaletteMCGA2;
+  ColorMask := 1;
+end;
+
 procedure ptc_InitMode32k(XResolution, YResolution, Pages: LongInt);
 begin
 {$IFDEF logging}
@@ -801,7 +842,7 @@ end;
 
 procedure ptc_Init640x480x2;
 begin
-  ptc_InitModeCGA2(640, 480, 1);
+  ptc_InitModeMCGA2(640, 480, 1);
 end;
 
 procedure ptc_Init720x348x2;
@@ -950,6 +991,22 @@ begin
   GetBkColorCGA640 := CurrentCGABkColor;
 end;
 
+{ nickysn: VGA compatible implementation. I don't have a real MCGA to test
+  if there's any difference with VGA }
+procedure SetBkColorMCGA640(ColorNum: Word);
+begin
+  if ColorNum > 15 then
+    exit;
+  CurrentCGABkColor := ColorNum;
+
+  ptc_SetEGAPalette(0, ((ColorNum shl 1) and $10) or (ColorNum and $07));
+end;
+
+function GetBkColorMCGA640: Word;
+begin
+  GetBkColorMCGA640 := CurrentCGABkColor;
+end;
+
 Function ClipCoords (Var X,Y : smallint) : Boolean;
 { Adapt to viewport, return TRUE if still in viewport,
   false if outside viewport}
@@ -1908,6 +1965,9 @@ end;
        SetVisualPage  := @ptc_SetVisualPage;
        SetActivePage  := @ptc_SetActivePage;
 
+       SetBkColor     := @SetBkColorMCGA640;
+       GetBkColor     := @GetBkColorMCGA640;
+
        XAspect := 10000;
        YAspect := 10000;
      end;

packages/imagemagick/src/imagemagick.pas

@@ -47,7 +47,7 @@ const
   WandExport = 'CORE_RL_wand_.dll';
 {$else}
   MagickExport = 'libMagickCore';
-  WandExport = 'libWand';
+  WandExport = 'libMagickWand'; // Previous ImageMagick versions used 'libWand'
 {$endif}
 
 {# include "magick/methods.h"

packages/libgd/src/gd.pas

@@ -16,6 +16,13 @@ unit gd;
 {$IFDEF GO32V2}
   {$UNDEF FPC_TARGET_SUPPORTS_DYNLIBS}
 {$ENDIF GO32V2}
+{$IFDEF AMIGA}
+  {$UNDEF FPC_TARGET_SUPPORTS_DYNLIBS}
+{$ENDIF AMIGA}
+{$IFDEF MORPHOS}
+  {$UNDEF FPC_TARGET_SUPPORTS_DYNLIBS}
+{$ENDIF MORPHOS}
+
 
 interface
 
@@ -56,6 +63,16 @@ uses
   {$DEFINE gdlib := }
   {$DEFINE clib := }
 {$ENDIF OS2}
+{$IFDEF AMIGA}
+  {$UNDEF LOAD_DYNAMICALLY}
+  {$DEFINE gdlib := }
+  {$DEFINE clib := }
+{$ENDIF AMIGA}
+{$IFDEF MORPHOS}
+  {$UNDEF LOAD_DYNAMICALLY}
+  {$DEFINE gdlib := }
+  {$DEFINE clib := }
+{$ENDIF MORPHOS}
 
 {$IFNDEF LOAD_DYNAMICALLY}
   {$IFDEF darwin}

packages/ptc/src/c_api/area.inc

@@ -1,140 +0,0 @@
-Function ptc_area_create(left, top, right, bottom : Integer) : TPTC_AREA;
-
-Begin
-  Try
-    ptc_area_create := TPTC_AREA(TPTCArea.Create(left, top, right, bottom));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_area_create := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_area_destroy(obj : TPTC_AREA);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCArea(obj).Destroy;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-    End;
-  End;
-End;
-
-Function ptc_area_left(obj : TPTC_AREA) : Integer;
-
-Begin
-  Try
-    ptc_area_left := TPTCArea(obj).left;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_area_left := 0;
-    End;
-  End;
-End;
-
-Function ptc_area_top(obj : TPTC_AREA) : Integer;
-
-Begin
-  Try
-    ptc_area_top := TPTCArea(obj).top;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_area_top := 0;
-    End;
-  End;
-End;
-
-Function ptc_area_right(obj : TPTC_AREA) : Integer;
-
-Begin
-  Try
-    ptc_area_right := TPTCArea(obj).right;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_area_right := 0;
-    End;
-  End;
-End;
-
-Function ptc_area_bottom(obj : TPTC_AREA) : Integer;
-
-Begin
-  Try
-    ptc_area_bottom := TPTCArea(obj).bottom;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_area_bottom := 0;
-    End;
-  End;
-End;
-
-Function ptc_area_width(obj : TPTC_AREA) : Integer;
-
-Begin
-  Try
-    ptc_area_width := TPTCArea(obj).width;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_area_width := 0;
-    End;
-  End;
-End;
-
-Function ptc_area_height(obj : TPTC_AREA) : Integer;
-
-Begin
-  Try
-    ptc_area_height := TPTCArea(obj).height;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_area_height := 0;
-    End;
-  End;
-End;
-
-Procedure ptc_area_assign(obj, area : TPTC_AREA);
-
-Begin
-  Try
-    TPTCArea(obj).ASSign(TPTCArea(area));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-    End;
-  End;
-End;
-
-Function ptc_area_equals(obj, area : TPTC_AREA) : Boolean;
-
-Begin
-  Try
-    ptc_area_equals := TPTCArea(obj).Equals(TPTCArea(area));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_area_equals := False;
-    End;
-  End;
-End;
-

packages/ptc/src/c_api/aread.inc

@@ -1,15 +0,0 @@
-{ setup }
-Function ptc_area_create(left, top, right, bottom : Integer) : TPTC_AREA;
-Procedure ptc_area_destroy(obj : TPTC_AREA);
-
-{ data access }
-Function ptc_area_left(obj : TPTC_AREA) : Integer;
-Function ptc_area_top(obj : TPTC_AREA) : Integer;
-Function ptc_area_right(obj : TPTC_AREA) : Integer;
-Function ptc_area_bottom(obj : TPTC_AREA) : Integer;
-Function ptc_area_width(obj : TPTC_AREA) : Integer;
-Function ptc_area_height(obj : TPTC_AREA) : Integer;
-
-{ operators }
-Procedure ptc_area_assign(obj, area : TPTC_AREA);
-Function ptc_area_equals(obj, area : TPTC_AREA) : Boolean;

packages/ptc/src/c_api/capi_area.inc

@@ -0,0 +1,161 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_area_create(left, top, right, bottom: Integer): TPTC_AREA;
+begin
+  try
+    ptc_area_create := TPTC_AREA(TPTCArea.Create(left, top, right, bottom));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_area_create := nil;
+    end;
+  end;
+end;
+
+procedure ptc_area_destroy(obj: TPTC_AREA);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCArea(obj).Destroy;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+    end;
+  end;
+end;
+
+function ptc_area_left(obj: TPTC_AREA): Integer;
+begin
+  try
+    ptc_area_left := TPTCArea(obj).left;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_area_left := 0;
+    end;
+  end;
+end;
+
+function ptc_area_top(obj: TPTC_AREA): Integer;
+begin
+  try
+    ptc_area_top := TPTCArea(obj).top;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_area_top := 0;
+    end;
+  end;
+end;
+
+function ptc_area_right(obj: TPTC_AREA): Integer;
+begin
+  try
+    ptc_area_right := TPTCArea(obj).right;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_area_right := 0;
+    end;
+  end;
+end;
+
+function ptc_area_bottom(obj: TPTC_AREA): Integer;
+begin
+  try
+    ptc_area_bottom := TPTCArea(obj).bottom;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_area_bottom := 0;
+    end;
+  end;
+end;
+
+function ptc_area_width(obj: TPTC_AREA): Integer;
+begin
+  try
+    ptc_area_width := TPTCArea(obj).width;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_area_width := 0;
+    end;
+  end;
+end;
+
+function ptc_area_height(obj: TPTC_AREA): Integer;
+begin
+  try
+    ptc_area_height := TPTCArea(obj).height;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_area_height := 0;
+    end;
+  end;
+end;
+
+procedure ptc_area_assign(obj, area: TPTC_AREA);
+begin
+  try
+    TPTCArea(obj).Assign(TPTCArea(area));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+    end;
+  end;
+end;
+
+function ptc_area_equals(obj, area: TPTC_AREA): Boolean;
+begin
+  try
+    ptc_area_equals := TPTCArea(obj).Equals(TPTCArea(area));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_area_equals := False;
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_aread.inc

@@ -0,0 +1,47 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_area_create(left, top, right, bottom: Integer): TPTC_AREA;
+procedure ptc_area_destroy(obj: TPTC_AREA);
+
+{ data access }
+function ptc_area_left(obj: TPTC_AREA): Integer;
+function ptc_area_top(obj: TPTC_AREA): Integer;
+function ptc_area_right(obj: TPTC_AREA): Integer;
+function ptc_area_bottom(obj: TPTC_AREA): Integer;
+function ptc_area_width(obj: TPTC_AREA): Integer;
+function ptc_area_height(obj: TPTC_AREA): Integer;
+
+{ operators }
+procedure ptc_area_assign(obj, area: TPTC_AREA);
+function ptc_area_equals(obj, area: TPTC_AREA): Boolean;

packages/ptc/src/c_api/capi_clear.inc

@@ -0,0 +1,76 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_clear_create: TPTC_CLEAR;
+begin
+  try
+    ptc_clear_create := TPTC_CLEAR(TPTCClear.Create);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_clear_create := nil;
+    end;
+  end;
+end;
+
+procedure ptc_clear_destroy(obj: TPTC_CLEAR);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCClear(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_clear_request(obj: TPTC_CLEAR; format: TPTC_FORMAT);
+begin
+  try
+    TPTCClear(obj).request(TPTCFormat(format));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_clear_clear(obj: TPTC_CLEAR; pixels: Pointer; x, y, width, height, pitch: Integer; color: TPTC_COLOR);
+begin
+  try
+    TPTCClear(obj).clear(pixels, x, y, width, height, pitch, TPTCColor(color));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;

packages/ptc/src/c_api/capi_cleard.inc

@@ -0,0 +1,41 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_clear_create: TPTC_CLEAR;
+procedure ptc_clear_destroy(obj: TPTC_CLEAR);
+
+{ request clear }
+procedure ptc_clear_request(obj: TPTC_CLEAR; format: TPTC_FORMAT);
+
+{ clear pixels }
+procedure ptc_clear_clear(obj: TPTC_CLEAR; pixels: Pointer; x, y, width, height, pitch: Integer; color: TPTC_COLOR);

packages/ptc/src/c_api/capi_clipper.inc

@@ -0,0 +1,62 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+procedure ptc_clipper_clip(area, clip, clipped: TPTC_AREA);
+var
+  tmp: TPTCArea;
+begin
+  try
+    tmp := TPTCClipper.clip(TPTCArea(area), TPTCArea(clip));
+    try
+      TPTCArea(clipped).Assign(tmp);
+    finally
+      tmp.Destroy;
+    end;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+    end;
+  end;
+end;
+
+procedure ptc_clipper_clip_complex(source, clip_source, clipped_source, destination, clip_destination, clipped_destination: TPTC_AREA);
+begin
+  try
+    TPTCClipper.clip(TPTCArea(source), TPTCArea(clip_source), TPTCArea(clipped_source), TPTCArea(destination), TPTCArea(clip_destination), TPTCArea(clipped_destination));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_clipperd.inc

@@ -0,0 +1,37 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ clip a single area against clip area }
+procedure ptc_clipper_clip(area, clip, clipped: TPTC_AREA);
+
+{ clip source and destination areas against source and destination clip areas }
+procedure ptc_clipper_clip_complex(source, clip_source, clipped_source, destination, clip_destination, clipped_destination: TPTC_AREA);

packages/ptc/src/c_api/capi_color.inc

@@ -0,0 +1,196 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_color_create: TPTC_COLOR;
+begin
+  try
+    ptc_color_create := TPTC_COLOR(TPTCColor.Create);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_create := nil;
+    end;
+  end;
+end;
+
+function ptc_color_create_indexed(index: Integer): TPTC_COLOR;
+begin
+  try
+    ptc_color_create_indexed := TPTC_COLOR(TPTCColor.Create(index));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_create_indexed := nil;
+    end;
+  end;
+end;
+
+function ptc_color_create_direct(r, g, b, a: Single): TPTC_COLOR;
+begin
+  try
+    ptc_color_create_direct := TPTC_COLOR(TPTCColor.Create(r, g, b, a));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_create_direct := nil;
+    end;
+  end;
+end;
+
+procedure ptc_color_destroy(obj: TPTC_COLOR);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCColor(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_color_index(obj: TPTC_COLOR): Integer;
+begin
+  try
+    ptc_color_index := TPTCColor(obj).index;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_index := 0;
+    end;
+  end;
+end;
+
+function ptc_color_r(obj: TPTC_COLOR): Single;
+begin
+  try
+    ptc_color_r := TPTCColor(obj).r;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_r := 0;
+    end;
+  end;
+end;
+
+function ptc_color_g(obj: TPTC_COLOR): Single;
+begin
+  try
+    ptc_color_g := TPTCColor(obj).g;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_g := 0;
+    end;
+  end;
+end;
+
+function ptc_color_b(obj: TPTC_COLOR): Single;
+begin
+  try
+    ptc_color_b := TPTCColor(obj).b;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_b := 0;
+    end;
+  end;
+end;
+
+function ptc_color_a(obj: TPTC_COLOR): Single;
+begin
+  try
+    ptc_color_a := TPTCColor(obj).a;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_a := 0;
+    end;
+  end;
+end;
+
+function ptc_color_direct(obj: TPTC_COLOR): Boolean;
+begin
+  try
+    ptc_color_direct := TPTCColor(obj).direct;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_direct := False;
+    end;
+  end;
+end;
+
+function ptc_color_indexed(obj: TPTC_COLOR): Boolean;
+begin
+  try
+    ptc_color_indexed := TPTCColor(obj).indexed;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_indexed := False;
+    end;
+  end;
+end;
+
+procedure ptc_color_assign(obj, color: TPTC_COLOR);
+begin
+  try
+    TPTCColor(obj).Assign(TPTCColor(color));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_color_equals(obj, color: TPTC_COLOR): Boolean;
+begin
+  try
+    ptc_color_equals := TPTCColor(obj).Equals(TPTCColor(color));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_color_equals := False;
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_colord.inc

@@ -0,0 +1,50 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_color_create: TPTC_COLOR;
+function ptc_color_create_indexed(index: Integer): TPTC_COLOR;
+function ptc_color_create_direct(r, g, b, a: Single): TPTC_COLOR;
+procedure ptc_color_destroy(obj: TPTC_COLOR);
+
+{ data access }
+function ptc_color_index(obj: TPTC_COLOR): Integer;
+function ptc_color_r(obj: TPTC_COLOR): Single;
+function ptc_color_g(obj: TPTC_COLOR): Single;
+function ptc_color_b(obj: TPTC_COLOR): Single;
+function ptc_color_a(obj: TPTC_COLOR): Single;
+function ptc_color_direct(obj: TPTC_COLOR): Boolean;
+function ptc_color_indexed(obj: TPTC_COLOR): Boolean;
+
+{ operators }
+procedure ptc_color_assign(obj, color: TPTC_COLOR);
+function ptc_color_equals(obj, color: TPTC_COLOR): Boolean;

packages/ptc/src/c_api/capi_console.inc

@@ -0,0 +1,488 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_console_create: TPTC_CONSOLE;
+begin
+  try
+    ptc_console_create := TPTC_CONSOLE(TPTCConsole.Create);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_create := nil;
+    end;
+  end;
+end;
+
+procedure ptc_console_destroy(obj: TPTC_CONSOLE);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCBaseConsole(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_configure(obj: TPTC_CONSOLE; _file: String);
+begin
+  try
+    TPTCBaseConsole(obj).configure(_file);
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_console_option(obj: TPTC_CONSOLE; _option: String): Boolean;
+begin
+  try
+    ptc_console_option := TPTCBaseConsole(obj).option(_option);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_option := False;
+    end;
+  end;
+end;
+
+function ptc_console_mode(obj: TPTC_CONSOLE; index: Integer): TPTC_MODE;
+begin
+  try
+    ptc_console_mode := TPTC_MODE(TPTCBaseConsole(obj).modes[index]);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_mode := nil;
+    end;
+  end;
+end;
+
+procedure ptc_console_open(obj: TPTC_CONSOLE; title: string; pages: Integer);
+begin
+  try
+    TPTCBaseConsole(obj).open(title, pages);
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_open_format(obj: TPTC_CONSOLE; title: string; format: TPTC_FORMAT; pages: Integer);
+begin
+  try
+    TPTCBaseConsole(obj).open(title, TPTCFormat(format), pages);
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_open_resolution(obj: TPTC_CONSOLE; title: string; width, height: Integer; format: TPTC_FORMAT; pages: Integer);
+begin
+  try
+    TPTCBaseConsole(obj).open(title, width, height, TPTCFormat(format), pages);
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_open_mode(obj: TPTC_CONSOLE; title: string; mode: TPTC_MODE; pages: Integer);
+begin
+  try
+    TPTCBaseConsole(obj).open(title, TPTCMode(mode), pages);
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_close(obj: TPTC_CONSOLE);
+begin
+  try
+    TPTCBaseConsole(obj).close;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_flush(obj: TPTC_CONSOLE);
+begin
+  try
+    TPTCBaseConsole(obj).flush;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_finish(obj: TPTC_CONSOLE);
+begin
+  try
+    TPTCBaseConsole(obj).finish;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_update(obj: TPTC_CONSOLE);
+begin
+  try
+    TPTCBaseConsole(obj).update;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_update_area(obj: TPTC_CONSOLE; area: TPTC_AREA);
+begin
+  try
+    TPTCBaseConsole(obj).update(TPTCArea(area));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_console_key(obj: TPTC_CONSOLE): Boolean;
+begin
+  try
+    ptc_console_key := TPTCBaseConsole(obj).key;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_key := False;
+    end;
+  end;
+end;
+
+procedure ptc_console_read(obj: TPTC_CONSOLE; key: TPTC_KEY);
+var
+  tmp: TPTCKeyEvent;
+begin
+  try
+    tmp := TPTCBaseConsole(obj).read;
+    try
+      TPTCKeyEvent(key).Assign(tmp);
+    finally
+      tmp.Destroy;
+    end;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_copy(obj: TPTC_CONSOLE; surface: TPTC_SURFACE);
+begin
+  try
+    TPTCBaseConsole(obj).copy(TPTCBaseSurface(surface));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_copy_area(obj: TPTC_CONSOLE; surface: TPTC_SURFACE; source, destination: TPTC_AREA);
+begin
+  try
+    TPTCBaseConsole(obj).copy(TPTCBaseSurface(surface), TPTCArea(source), TPTCArea(destination));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_console_lock(obj: TPTC_CONSOLE): Pointer;
+begin
+  try
+    ptc_console_lock := TPTCBaseConsole(obj).lock;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_lock := nil;
+    end;
+  end;
+end;
+
+procedure ptc_console_unlock(obj: TPTC_CONSOLE);
+begin
+  try
+    TPTCBaseConsole(obj).unlock;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_load(obj: TPTC_CONSOLE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE);
+begin
+  try
+    TPTCBaseConsole(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_load_area(obj: TPTC_CONSOLE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE; source, destination: TPTC_AREA);
+begin
+  try
+    TPTCBaseConsole(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_save(obj: TPTC_CONSOLE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE);
+begin
+  try
+    TPTCBaseConsole(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_save_area(obj: TPTC_CONSOLE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE; source, destination: TPTC_AREA);
+begin
+  try
+    TPTCBaseConsole(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_clear(obj: TPTC_CONSOLE);
+begin
+  try
+    TPTCBaseConsole(obj).clear;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_clear_color(obj: TPTC_CONSOLE; color: TPTC_COLOR);
+begin
+  try
+    TPTCBaseConsole(obj).clear(TPTCColor(color));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_clear_color_area(obj: TPTC_CONSOLE; color: TPTC_COLOR; area: TPTC_AREA);
+begin
+  try
+    TPTCBaseConsole(obj).clear(TPTCColor(color), TPTCArea(area));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_console_palette_set(obj: TPTC_CONSOLE; palette: TPTC_PALETTE);
+begin
+  try
+    TPTCBaseConsole(obj).palette(TPTCPalette(palette));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_console_palette_get(obj: TPTC_CONSOLE): TPTC_PALETTE;
+begin
+  try
+    ptc_console_palette_get := TPTC_PALETTE(TPTCBaseConsole(obj).palette);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_palette_get := nil;
+    end;
+  end;
+end;
+
+procedure ptc_console_clip_set(obj: TPTC_CONSOLE; area: TPTC_AREA);
+begin
+  try
+    TPTCBaseConsole(obj).clip(TPTCArea(area));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_console_width(obj: TPTC_CONSOLE): Integer;
+begin
+  try
+    ptc_console_width := TPTCBaseConsole(obj).width;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_width := 0;
+    end;
+  end;
+end;
+
+function ptc_console_height(obj: TPTC_CONSOLE): Integer;
+begin
+  try
+    ptc_console_height := TPTCBaseConsole(obj).height;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_height := 0;
+    end;
+  end;
+end;
+
+function ptc_console_pages(obj: TPTC_CONSOLE): Integer;
+begin
+  try
+    ptc_console_pages := TPTCBaseConsole(obj).pages;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_pages := 0;
+    end;
+  end;
+end;
+
+function ptc_console_pitch(obj: TPTC_CONSOLE): Integer;
+begin
+  try
+    ptc_console_pitch := TPTCBaseConsole(obj).pitch;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_pitch := 0;
+    end;
+  end;
+end;
+
+function ptc_console_area(obj: TPTC_CONSOLE): TPTC_AREA;
+begin
+  try
+    ptc_console_area := TPTC_AREA(TPTCBaseConsole(obj).area);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_area := nil;
+    end;
+  end;
+end;
+
+function ptc_console_clip(obj: TPTC_CONSOLE): TPTC_AREA;
+begin
+  try
+    ptc_console_clip := TPTC_AREA(TPTCBaseConsole(obj).clip);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_clip := nil;
+    end;
+  end;
+end;
+
+function ptc_console_format(obj: TPTC_CONSOLE): TPTC_FORMAT;
+begin
+  try
+    ptc_console_format := TPTC_FORMAT(TPTCBaseConsole(obj).format);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_format := nil;
+    end;
+  end;
+end;
+
+function ptc_console_name(obj: TPTC_CONSOLE): string;
+begin
+  try
+    ptc_console_name := TPTCBaseConsole(obj).name;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_name := '';
+    end;
+  end;
+end;
+
+function ptc_console_title(obj: TPTC_CONSOLE): string;
+begin
+  try
+    ptc_console_title := TPTCBaseConsole(obj).title;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_title := '';
+    end;
+  end;
+end;
+
+function ptc_console_information(obj: TPTC_CONSOLE): string;
+begin
+  try
+    ptc_console_information := TPTCBaseConsole(obj).information;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_console_information := '';
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_consoled.inc

@@ -0,0 +1,115 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_console_create: TPTC_CONSOLE;
+procedure ptc_console_destroy(obj: TPTC_CONSOLE);
+
+{ console configuration }
+procedure ptc_console_configure(obj: TPTC_CONSOLE; _file: String);
+
+{ console option string }
+function ptc_console_option(obj: TPTC_CONSOLE; _option: String): Boolean;
+
+{ console modes }
+function ptc_console_mode(obj: TPTC_CONSOLE; index: Integer): TPTC_MODE;
+
+{ console management }
+procedure ptc_console_open(obj: TPTC_CONSOLE; title: string; pages: Integer);
+procedure ptc_console_open_format(obj: TPTC_CONSOLE; title: string; format: TPTC_FORMAT; pages: Integer);
+procedure ptc_console_open_resolution(obj: TPTC_CONSOLE; title: string; width, height: Integer; format: TPTC_FORMAT; pages: Integer);
+procedure ptc_console_open_mode(obj: TPTC_CONSOLE; title: string; mode: TPTC_MODE; pages: Integer);
+procedure ptc_console_close(obj: TPTC_CONSOLE);
+
+{ synchronization }
+procedure ptc_console_flush(obj: TPTC_CONSOLE);
+procedure ptc_console_finish(obj: TPTC_CONSOLE);
+procedure ptc_console_update(obj: TPTC_CONSOLE);
+procedure ptc_console_update_area(obj: TPTC_CONSOLE; area: TPTC_AREA);
+
+{ keyboard input }
+function ptc_console_key(obj: TPTC_CONSOLE): Boolean;
+procedure ptc_console_read(obj: TPTC_CONSOLE; key: TPTC_KEY);
+
+{ copy to surface }
+procedure ptc_console_copy(obj: TPTC_CONSOLE; surface: TPTC_SURFACE);
+procedure ptc_console_copy_area(obj: TPTC_CONSOLE; surface: TPTC_SURFACE; source, destination: TPTC_AREA);
+
+{ memory access }
+function ptc_console_lock(obj: TPTC_CONSOLE): Pointer;
+procedure ptc_console_unlock(obj: TPTC_CONSOLE);
+
+{ load pixels to console }
+procedure ptc_console_load(obj: TPTC_CONSOLE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE);
+procedure ptc_console_load_area(obj: TPTC_CONSOLE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE; source, destination: TPTC_AREA);
+
+{ save console pixels }
+procedure ptc_console_save(obj: TPTC_CONSOLE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE);
+procedure ptc_console_save_area(obj: TPTC_CONSOLE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE; source, destination: TPTC_AREA);
+
+{ clear console }
+procedure ptc_console_clear(obj: TPTC_CONSOLE);
+procedure ptc_console_clear_color(obj: TPTC_CONSOLE; color: TPTC_COLOR);
+procedure ptc_console_clear_color_area(obj: TPTC_CONSOLE; color: TPTC_COLOR; area: TPTC_AREA);
+
+{ console palette }
+procedure ptc_console_palette_set(obj: TPTC_CONSOLE; palette: TPTC_PALETTE);
+function ptc_console_palette_get(obj: TPTC_CONSOLE): TPTC_PALETTE;
+
+{ console clip area }
+procedure ptc_console_clip_set(obj: TPTC_CONSOLE; area: TPTC_AREA);
+
+{ data access }
+function ptc_console_width(obj: TPTC_CONSOLE): Integer;
+function ptc_console_height(obj: TPTC_CONSOLE): Integer;
+function ptc_console_pages(obj: TPTC_CONSOLE): Integer;
+function ptc_console_pitch(obj: TPTC_CONSOLE): Integer;
+function ptc_console_area(obj: TPTC_CONSOLE): TPTC_AREA;
+function ptc_console_clip(obj: TPTC_CONSOLE): TPTC_AREA;
+function ptc_console_format(obj: TPTC_CONSOLE): TPTC_FORMAT;
+function ptc_console_name(obj: TPTC_CONSOLE): string;
+function ptc_console_title(obj: TPTC_CONSOLE): string;
+function ptc_console_information(obj: TPTC_CONSOLE): string;
+
+{ extension functions }
+{#ifdef __PTC_WIN32_EXTENSIONS__
+CAPI void PTCAPI ptc_console_open_window(PTC_CONSOLE object,HWND window,int pages);
+CAPI void PTCAPI ptc_console_open_window_format(PTC_CONSOLE object,HWND window,PTC_FORMAT format,int pages);
+CAPI void PTCAPI ptc_console_open_window_resolution(PTC_CONSOLE object,HWND window,int width,int height,PTC_FORMAT format,int pages);
+CAPI void PTCAPI ptc_console_open_window_mode(PTC_CONSOLE object,HWND window,PTC_MODE mode,int pages);
+CAPI HWND PTCAPI ptc_console_window(PTC_CONSOLE object);
+CAPI LPDIRECTDRAW PTCAPI ptc_console_lpDD(PTC_CONSOLE object);
+CAPI LPDIRECTDRAW2 PTCAPI ptc_console_lpDD2(PTC_CONSOLE object);
+CAPI LPDIRECTDRAWSURFACE PTCAPI ptc_console_lpDDS(PTC_CONSOLE object);
+CAPI LPDIRECTDRAWSURFACE PTCAPI ptc_console_lpDDS_primary(PTC_CONSOLE object);
+CAPI LPDIRECTDRAWSURFACE PTCAPI ptc_console_lpDDS_secondary(PTC_CONSOLE object);
+#endif}

packages/ptc/src/c_api/capi_copy.inc

@@ -0,0 +1,100 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_copy_create: TPTC_COPY;
+begin
+  try
+    ptc_copy_create := TPTC_COPY(TPTCCopy.Create);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_copy_create := nil;
+    end;
+  end;
+end;
+
+procedure ptc_copy_destroy(obj: TPTC_COPY);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCCopy(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_copy_request(obj: TPTC_COPY; source, destination: TPTC_FORMAT);
+begin
+  try
+    TPTCCopy(obj).request(TPTCFormat(source), TPTCFormat(destination));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_copy_palette(obj: TPTC_COPY; source, destination: TPTC_PALETTE);
+begin
+  try
+    TPTCCopy(obj).palette(TPTCPalette(source), TPTCPalette(destination));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_copy_copy(obj: TPTC_COPY; source_pixels: Pointer; source_x, source_y, source_width, source_height, source_pitch: Integer;
+                        destination_pixels: Pointer; destination_x, destination_y, destination_width, destination_height, destination_pitch: Integer);
+begin
+  try
+    TPTCCopy(obj).copy(source_pixels, source_x, source_y, source_width, source_height, source_pitch, destination_pixels, destination_x, destination_y, destination_width, destination_height, destination_pitch);
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_copy_option(obj: TPTC_COPY; option: String): Boolean;
+begin
+  try
+    TPTCCopy(obj).option(option);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_copy_option := False;
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_copyd.inc

@@ -0,0 +1,48 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_copy_create: TPTC_COPY;
+procedure ptc_copy_destroy(obj: TPTC_COPY);
+
+{ set source and destination formats }
+procedure ptc_copy_request(obj: TPTC_COPY; source, destination: TPTC_FORMAT);
+
+{ set source and destination palettes }
+procedure ptc_copy_palette(obj: TPTC_COPY; source, destination: TPTC_PALETTE);
+
+{ copy pixels }
+procedure ptc_copy_copy(obj: TPTC_COPY; source_pixels: Pointer; source_x, source_y, source_width, source_height, source_pitch: Integer;
+                        destination_pixels: Pointer; destination_x, destination_y, destination_width, destination_height, destination_pitch: Integer);
+
+{ copy option string }
+function ptc_copy_option(obj: TPTC_COPY; option: String): Boolean;

packages/ptc/src/c_api/capi_error.inc

@@ -0,0 +1,120 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_error_create(message: string): TPTC_ERROR;
+begin
+  try
+    ptc_error_create := TPTC_ERROR(TPTCError.Create(message));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_error_create := nil;
+    end;
+  end;
+end;
+
+function ptc_error_create_composite(message: string; error: TPTC_ERROR): TPTC_ERROR;
+begin
+  try
+    ptc_error_create_composite := TPTC_ERROR(TPTCError.Create(message, TPTCError(error)));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_error_create_composite := nil;
+    end;
+  end;
+end;
+
+procedure ptc_error_destroy(obj: TPTC_ERROR);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCError(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_error_report(obj: TPTC_ERROR);
+begin
+  try
+    TPTCError(obj).report;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_error_message(obj: TPTC_ERROR): string;
+begin
+  try
+    ptc_error_message := TPTCError(obj).message;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_error_message := '';
+    end;
+  end;
+end;
+
+procedure ptc_error_assign(obj, error: TPTC_ERROR);
+begin
+  try
+    TPTCError(obj).Assign(TPTCError(error));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_error_equals(obj, error: TPTC_ERROR): Boolean;
+begin
+  try
+    ptc_error_equals := TPTCError(obj).Equals(TPTCError(error));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_error_equals := False;
+    end;
+  end;
+end;
+
+procedure ptc_error_handler(handler: TPTC_ERROR_HANDLER);
+begin
+  ptc_exception_handler(handler);
+end;

packages/ptc/src/c_api/capi_errord.inc

@@ -0,0 +1,47 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+type
+  TPTC_ERROR_HANDLER = procedure(error: TPTC_ERROR);
+
+function ptc_error_create(message: string): TPTC_ERROR;
+function ptc_error_create_composite(message: string; error: TPTC_ERROR): TPTC_ERROR;
+procedure ptc_error_destroy(obj: TPTC_ERROR);
+
+procedure ptc_error_report(obj: TPTC_ERROR);
+
+function ptc_error_message(obj: TPTC_ERROR): string;
+
+procedure ptc_error_assign(obj, error: TPTC_ERROR);
+function ptc_error_equals(obj, error: TPTC_ERROR): Boolean;
+
+procedure ptc_error_handler(handler: TPTC_ERROR_HANDLER);

packages/ptc/src/c_api/capi_except.inc

@@ -0,0 +1,55 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+var
+  ptc_error_handler_function: TPTC_ERROR_HANDLER;
+
+procedure ptc_error_handler_default(error: TPTC_ERROR);
+
+begin
+  TPTCError(error).report;
+end;
+
+procedure ptc_exception_handler(handler: TPTC_ERROR_HANDLER);
+
+begin
+  if handler = nil then
+    ptc_error_handler_function := @ptc_error_handler_default
+  else
+    ptc_error_handler_function := handler;
+end;
+
+procedure ptc_exception_handle(error: TPTCError);
+
+begin
+  ptc_error_handler_function(TPTC_ERROR(error));
+end;

packages/ptc/src/c_api/capi_exceptd.inc

@@ -0,0 +1,34 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+procedure ptc_exception_handler(handler: TPTC_ERROR_HANDLER);
+procedure ptc_exception_handle(error: TPTCError);

packages/ptc/src/c_api/capi_format.inc

@@ -0,0 +1,209 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_format_create: TPTC_FORMAT;
+begin
+  try
+    ptc_format_create := TPTC_FORMAT(TPTCFormat.Create);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_create := nil;
+    end;
+  end;
+end;
+
+function ptc_format_create_indexed(bits: Integer): TPTC_FORMAT;
+begin
+  try
+    ptc_format_create_indexed := TPTC_FORMAT(TPTCFormat.Create(bits));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_create_indexed := nil;
+    end;
+  end;
+end;
+
+function ptc_format_create_direct(bits: Integer; r, g, b, a: int32): TPTC_FORMAT;
+begin
+  try
+    ptc_format_create_direct := TPTC_FORMAT(TPTCFormat.Create(bits, r, g, b, a));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_create_direct := nil;
+    end;
+  end;
+end;
+
+procedure ptc_format_destroy(obj: TPTC_FORMAT);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCFormat(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_format_r(obj: TPTC_FORMAT): int32;
+begin
+  try
+    ptc_format_r := TPTCFormat(obj).r;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_r := 0;
+    end;
+  end;
+end;
+
+function ptc_format_g(obj: TPTC_FORMAT): int32;
+begin
+  try
+    ptc_format_g := TPTCFormat(obj).g;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_g := 0;
+    end;
+  end;
+end;
+
+function ptc_format_b(obj: TPTC_FORMAT): int32;
+begin
+  try
+    ptc_format_b := TPTCFormat(obj).b;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_b := 0;
+    end;
+  end;
+end;
+
+function ptc_format_a(obj: TPTC_FORMAT): int32;
+begin
+  try
+    ptc_format_a := TPTCFormat(obj).a;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_a := 0;
+    end;
+  end;
+end;
+
+function ptc_format_bits(obj: TPTC_FORMAT): Integer;
+begin
+  try
+    ptc_format_bits := TPTCFormat(obj).bits;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_bits := 0;
+    end;
+  end;
+end;
+
+function ptc_format_bytes(obj: TPTC_FORMAT): Integer;
+begin
+  try
+    ptc_format_bytes := TPTCFormat(obj).bytes;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_bytes := 0;
+    end;
+  end;
+end;
+
+function ptc_format_direct(obj: TPTC_FORMAT): Boolean;
+begin
+  try
+    ptc_format_direct := TPTCFormat(obj).direct;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_direct := False;
+    end;
+  end;
+end;
+
+function ptc_format_indexed(obj: TPTC_FORMAT): Boolean;
+begin
+  try
+    ptc_format_indexed := TPTCFormat(obj).indexed;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_indexed := False;
+    end;
+  end;
+end;
+
+procedure ptc_format_assign(obj, format: TPTC_FORMAT);
+begin
+  try
+    TPTCFormat(obj).Assign(TPTCFormat(format));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_format_equals(obj, format: TPTC_FORMAT): Boolean;
+begin
+  try
+    ptc_format_equals := TPTCFormat(obj).Equals(TPTCFormat(format));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_format_equals := False;
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_formatd.inc

@@ -0,0 +1,51 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_format_create: TPTC_FORMAT;
+function ptc_format_create_indexed(bits: Integer): TPTC_FORMAT;
+function ptc_format_create_direct(bits: Integer; r, g, b, a: int32): TPTC_FORMAT;
+procedure ptc_format_destroy(obj: TPTC_FORMAT);
+
+{ data access }
+function ptc_format_r(obj: TPTC_FORMAT): int32;
+function ptc_format_g(obj: TPTC_FORMAT): int32;
+function ptc_format_b(obj: TPTC_FORMAT): int32;
+function ptc_format_a(obj: TPTC_FORMAT): int32;
+function ptc_format_bits(obj: TPTC_FORMAT): Integer;
+function ptc_format_bytes(obj: TPTC_FORMAT): Integer;
+function ptc_format_direct(obj: TPTC_FORMAT): Boolean;
+function ptc_format_indexed(obj: TPTC_FORMAT): Boolean;
+
+{ operators }
+procedure ptc_format_assign(obj, format: TPTC_FORMAT);
+function ptc_format_equals(obj, format: TPTC_FORMAT): Boolean;

packages/ptc/src/c_api/capi_index.inc

@@ -0,0 +1,46 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+type
+  { object handles }
+  TPTC_KEY     = Pointer; { equivalent to Object Pascal TPTCKeyEvent    }
+  TPTC_AREA    = Pointer; { equivalent to Object Pascal TPTCArea        }
+  TPTC_MODE    = Pointer; { equivalent to Object Pascal TPTCMode        }
+  TPTC_COPY    = Pointer; { equivalent to Object Pascal TPTCCopy        }
+  TPTC_CLEAR   = Pointer; { equivalent to Object Pascal TPTCClear       }
+  TPTC_TIMER   = Pointer; { equivalent to Object Pascal TPTCTimer       }
+  TPTC_ERROR   = Pointer; { equivalent to Object Pascal TPTCError       }
+  TPTC_COLOR   = Pointer; { equivalent to Object Pascal TPTCColor       }
+  TPTC_FORMAT  = Pointer; { equivalent to Object Pascal TPTCFormat      }
+  TPTC_PALETTE = Pointer; { equivalent to Object Pascal TPTCPalette     }
+  TPTC_SURFACE = Pointer; { equivalent to Object Pascal TPTCBaseSurface }
+  TPTC_CONSOLE = Pointer; { equivalent to Object Pascal TPTCBaseConsole }

packages/ptc/src/c_api/capi_key.inc

@@ -0,0 +1,131 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_key_create(code: Integer; alt, shift, control: Boolean): TPTC_KEY;
+begin
+  try
+    ptc_key_create := TPTC_KEY(TPTCKeyEvent.Create(code, alt, shift, control));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_key_create := nil;
+    end;
+  end;
+end;
+
+procedure ptc_key_destroy(obj: TPTC_KEY);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCKeyEvent(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_key_code(obj: TPTC_KEY): Integer;
+begin
+  try
+    ptc_key_code := Integer(TPTCKeyEvent(obj).code);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_key_code := 0;
+    end;
+  end;
+end;
+
+function ptc_key_alt(obj: TPTC_KEY): Boolean;
+begin
+  try
+    ptc_key_alt := TPTCKeyEvent(obj).alt;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_key_alt := False;
+    end;
+  end;
+end;
+
+function ptc_key_shift(obj: TPTC_KEY): Boolean;
+begin
+  try
+    ptc_key_shift := TPTCKeyEvent(obj).shift;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_key_shift := False;
+    end;
+  end;
+end;
+
+function ptc_key_control(obj: TPTC_KEY): Boolean;
+begin
+  try
+    ptc_key_control := TPTCKeyEvent(obj).control;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_key_control := False;
+    end;
+  end;
+end;
+
+procedure ptc_key_assign(obj: TPTC_KEY; key: TPTC_KEY);
+begin
+  try
+    TPTCKeyEvent(obj).Assign(TPTCKeyEvent(key));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_key_equals(obj: TPTC_KEY; key: TPTC_KEY): Boolean;
+begin
+  try
+    ptc_key_equals := TPTCKeyEvent(obj).Equals(TPTCKeyEvent(key));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_key_equals := False;
+    end;
+  end;
+end;

packages/ptc/src/c_api/keyd.inc → packages/ptc/src/c_api/capi_keyd.inc

@@ -1,18 +1,50 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
 { setup }
-Function ptc_key_create(code : Integer; alt, shift, control : Boolean) : TPTC_KEY;
-Procedure ptc_key_destroy(obj : TPTC_KEY);
+function ptc_key_create(code: Integer; alt, shift, control: Boolean): TPTC_KEY;
+procedure ptc_key_destroy(obj: TPTC_KEY);
 
 { key code }
-Function ptc_key_code(obj : TPTC_KEY) : Integer;
+function ptc_key_code(obj: TPTC_KEY): Integer;
 
 { modifiers }
-Function ptc_key_alt(obj : TPTC_KEY) : Boolean;
-Function ptc_key_shift(obj : TPTC_KEY) : Boolean;
-Function ptc_key_control(obj : TPTC_KEY) : Boolean;
+function ptc_key_alt(obj: TPTC_KEY): Boolean;
+function ptc_key_shift(obj: TPTC_KEY): Boolean;
+function ptc_key_control(obj: TPTC_KEY): Boolean;
 
 { operators }
-Procedure ptc_key_assign(obj : TPTC_KEY; key : TPTC_KEY);
-Function ptc_key_equals(obj : TPTC_KEY; key : TPTC_KEY) : Boolean;
+procedure ptc_key_assign(obj: TPTC_KEY; key: TPTC_KEY);
+function ptc_key_equals(obj: TPTC_KEY; key: TPTC_KEY): Boolean;
 
 { key codes }
 {#define PTC_KEY_ENTER            '\n'

packages/ptc/src/c_api/capi_mode.inc

@@ -0,0 +1,144 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_mode_create(width, height: Integer; format: TPTC_FORMAT): TPTC_MODE;
+begin
+  try
+    ptc_mode_create := TPTC_MODE(TPTCMode.Create(width, height, TPTCFormat(format)));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_mode_create := nil;
+    end;
+  end;
+end;
+
+function ptc_mode_create_invalid: TPTC_MODE;
+begin
+  try
+    ptc_mode_create_invalid := TPTC_MODE(TPTCMode.Create);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_mode_create_invalid := nil;
+    end;
+  end;
+end;
+
+procedure ptc_mode_destroy(obj: TPTC_MODE);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCMode(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_mode_valid(obj: TPTC_MODE): Boolean;
+begin
+  try
+    ptc_mode_valid := TPTCMode(obj).valid;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_mode_valid := False;
+    end;
+  end;
+end;
+
+function ptc_mode_width(obj: TPTC_MODE): Integer;
+begin
+  try
+    ptc_mode_width := TPTCMode(obj).width;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_mode_width := 0;
+    end;
+  end;
+end;
+
+function ptc_mode_height(obj: TPTC_MODE): Integer;
+begin
+  try
+    ptc_mode_height := TPTCMode(obj).height;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_mode_height := 0;
+    end;
+  end;
+end;
+
+function ptc_mode_format(obj: TPTC_MODE): TPTC_FORMAT;
+begin
+  try
+    ptc_mode_format := TPTC_FORMAT(TPTCMode(obj).format);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_mode_format := nil;
+    end;
+  end;
+end;
+
+procedure ptc_mode_assign(obj, mode: TPTC_MODE);
+begin
+  try
+    TPTCMode(obj).Assign(TPTCMode(mode));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_mode_equals(obj, mode: TPTC_MODE): Boolean;
+begin
+  try
+    ptc_mode_equals := TPTCMode(obj).Equals(TPTCMode(mode));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_mode_equals := False;
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_moded.inc

@@ -0,0 +1,48 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_mode_create(width, height: Integer; format: TPTC_FORMAT): TPTC_MODE;
+function ptc_mode_create_invalid: TPTC_MODE;
+procedure ptc_mode_destroy(obj: TPTC_MODE);
+
+{ valid mode flag }
+function ptc_mode_valid(obj: TPTC_MODE): Boolean;
+
+{ data access }
+function ptc_mode_width(obj: TPTC_MODE): Integer;
+function ptc_mode_height(obj: TPTC_MODE): Integer;
+function ptc_mode_format(obj: TPTC_MODE): TPTC_FORMAT;
+
+{ operators }
+procedure ptc_mode_assign(obj, mode: TPTC_MODE);
+function ptc_mode_equals(obj, mode: TPTC_MODE): Boolean;

packages/ptc/src/c_api/capi_palette.inc

@@ -0,0 +1,149 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_palette_create: TPTC_PALETTE;
+begin
+  try
+    ptc_palette_create := TPTC_PALETTE(TPTCPalette.Create);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_palette_create := nil;
+    end;
+  end;
+end;
+
+{function ptc_palette_create_data(data: Pint32): TPTC_PALETTE;
+
+begin
+  try
+    ptc_palette_create_data := TPTC_PALETTE(TPTCPalette.Create(data));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_palette_create_data := nil;
+    end;
+  end;
+End;}
+
+procedure ptc_palette_destroy(obj: TPTC_PALETTE);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCPalette(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_palette_lock(obj: TPTC_PALETTE): Pint32;
+begin
+  try
+    ptc_palette_lock := TPTCPalette(obj).lock;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_palette_lock := nil;
+    end;
+  end;
+end;
+
+procedure ptc_palette_unlock(obj: TPTC_PALETTE);
+begin
+  try
+    TPTCPalette(obj).unlock;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_palette_load(obj: TPTC_PALETTE; data: Pint32);
+begin
+  try
+    TPTCPalette(obj).load(data);
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_palette_save(obj: TPTC_PALETTE; data: Pint32);
+begin
+  try
+    TPTCPalette(obj).save(data);
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_palette_data(obj: TPTC_PALETTE): Pint32;
+begin
+  try
+    ptc_palette_data := TPTCPalette(obj).data;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_palette_data := nil;
+    end;
+  end;
+end;
+
+procedure ptc_palette_assign(obj, palette: TPTC_PALETTE);
+begin
+  try
+    TPTCPalette(obj).Assign(TPTCPalette(palette));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_palette_equals(obj, palette: TPTC_PALETTE): Boolean;
+begin
+  try
+    ptc_palette_equals := TPTCPalette(obj).Equals(TPTCPalette(palette));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_palette_equals := False;
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_paletted.inc

@@ -0,0 +1,53 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_palette_create: TPTC_PALETTE;
+{function ptc_palette_create_data(data: Pint32): TPTC_PALETTE;}
+procedure ptc_palette_destroy(obj: TPTC_PALETTE);
+
+{ memory access }
+function ptc_palette_lock(obj: TPTC_PALETTE): Pint32;
+procedure ptc_palette_unlock(obj: TPTC_PALETTE);
+
+{ load palette data }
+procedure ptc_palette_load(obj: TPTC_PALETTE; data: Pint32);
+
+{ save palette data }
+procedure ptc_palette_save(obj: TPTC_PALETTE; data: Pint32);
+
+{ get palette data }
+function ptc_palette_data(obj: TPTC_PALETTE): Pint32;
+
+{ operators }
+procedure ptc_palette_assign(obj, palette: TPTC_PALETTE);
+function ptc_palette_equals(obj, palette: TPTC_PALETTE): Boolean;

packages/ptc/src/c_api/capi_surface.inc

@@ -0,0 +1,293 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_surface_create(width, height: Integer; format: TPTC_FORMAT): TPTC_SURFACE;
+begin
+  try
+    ptc_surface_create := TPTC_SURFACE(TPTCSurface.Create(width, height, TPTCFormat(format)));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_create := nil;
+    end;
+  end;
+end;
+
+procedure ptc_surface_destroy(obj: TPTC_SURFACE);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCBaseSurface(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_copy(obj: TPTC_SURFACE; surface: TPTC_SURFACE);
+begin
+  try
+    TPTCBaseSurface(obj).copy(TPTCBaseSurface(surface));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_copy_area(obj: TPTC_SURFACE; surface: TPTC_SURFACE; source, destination: TPTC_AREA);
+begin
+  try
+    TPTCBaseSurface(obj).copy(TPTCBaseSurface(surface), TPTCArea(source), TPTCArea(destination));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_surface_lock(obj: TPTC_SURFACE): Pointer;
+begin
+  try
+    ptc_surface_lock := TPTCBaseSurface(obj).lock;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_lock := nil;
+    end;
+  end;
+end;
+
+procedure ptc_surface_unlock(obj: TPTC_SURFACE);
+begin
+  try
+    TPTCBaseSurface(obj).unlock;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_load(obj: TPTC_SURFACE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE);
+begin
+  try
+    TPTCBaseSurface(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_load_area(obj: TPTC_SURFACE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE; source, destination: TPTC_AREA);
+begin
+  try
+    TPTCBaseSurface(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_save(obj: TPTC_SURFACE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE);
+begin
+  try
+    TPTCBaseSurface(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_save_area(obj: TPTC_SURFACE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE; source, destination: TPTC_AREA);
+begin
+  try
+    TPTCBaseSurface(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_clear(obj: TPTC_SURFACE);
+begin
+  try
+    TPTCBaseSurface(obj).clear;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_clear_color(obj: TPTC_SURFACE; color: TPTC_COLOR);
+begin
+  try
+    TPTCBaseSurface(obj).clear(TPTCColor(color));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_clear_color_area(obj: TPTC_SURFACE; color: TPTC_COLOR; area: TPTC_AREA);
+begin
+  try
+    TPTCBaseSurface(obj).clear(TPTCColor(color), TPTCArea(area));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_surface_palette_set(obj: TPTC_SURFACE; palette: TPTC_PALETTE);
+begin
+  try
+    TPTCBaseSurface(obj).palette(TPTCPalette(palette));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_surface_palette_get(obj: TPTC_SURFACE): TPTC_PALETTE;
+begin
+  try
+    ptc_surface_palette_get := TPTC_PALETTE(TPTCBaseSurface(obj).palette);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_palette_get := nil;
+    end;
+  end;
+end;
+
+procedure ptc_surface_clip_set(obj: TPTC_SURFACE; area: TPTC_AREA);
+begin
+  try
+    TPTCBaseSurface(obj).clip(TPTCArea(area));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_surface_width(obj: TPTC_SURFACE): Integer;
+begin
+  try
+    ptc_surface_width := TPTCBaseSurface(obj).width;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_width := 0;
+    end;
+  end;
+end;
+
+function ptc_surface_height(obj: TPTC_SURFACE): Integer;
+begin
+  try
+    ptc_surface_height := TPTCBaseSurface(obj).height;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_height := 0;
+    end;
+  end;
+end;
+
+function ptc_surface_pitch(obj: TPTC_SURFACE): Integer;
+begin
+  try
+    ptc_surface_pitch := TPTCBaseSurface(obj).pitch;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_pitch := 0;
+    end;
+  end;
+end;
+
+function ptc_surface_area(obj: TPTC_SURFACE): TPTC_AREA;
+begin
+  try
+    ptc_surface_area := TPTC_AREA(TPTCBaseSurface(obj).area);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_area := nil;
+    end;
+  end;
+end;
+
+function ptc_surface_clip(obj: TPTC_SURFACE): TPTC_AREA;
+begin
+  try
+    ptc_surface_clip := TPTC_AREA(TPTCBaseSurface(obj).clip);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_clip := nil;
+    end;
+  end;
+end;
+
+function ptc_surface_format(obj: TPTC_SURFACE): TPTC_FORMAT;
+begin
+  try
+    ptc_surface_format := TPTC_FORMAT(TPTCBaseSurface(obj).format);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_format := nil;
+    end;
+  end;
+end;
+
+function ptc_surface_option(obj: TPTC_SURFACE; _option: string): Boolean;
+begin
+  try
+    ptc_surface_option := TPTCBaseSurface(obj).option(_option);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_surface_option := False;
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_surfaced.inc

@@ -0,0 +1,74 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_surface_create(width, height: Integer; format: TPTC_FORMAT): TPTC_SURFACE;
+procedure ptc_surface_destroy(obj: TPTC_SURFACE);
+
+{ copy to surface }
+procedure ptc_surface_copy(obj: TPTC_SURFACE; surface: TPTC_SURFACE);
+procedure ptc_surface_copy_area(obj: TPTC_SURFACE; surface: TPTC_SURFACE; source, destination: TPTC_AREA);
+
+{ memory access }
+function ptc_surface_lock(obj: TPTC_SURFACE): Pointer;
+procedure ptc_surface_unlock(obj: TPTC_SURFACE);
+
+{ load pixels to surface }
+procedure ptc_surface_load(obj: TPTC_SURFACE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE);
+procedure ptc_surface_load_area(obj: TPTC_SURFACE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE; source, destination: TPTC_AREA);
+
+{ save surface pixels }
+procedure ptc_surface_save(obj: TPTC_SURFACE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE);
+procedure ptc_surface_save_area(obj: TPTC_SURFACE; pixels: Pointer; width, height, pitch: Integer; format: TPTC_FORMAT; palette: TPTC_PALETTE; source, destination: TPTC_AREA);
+
+{ clear surface }
+procedure ptc_surface_clear(obj: TPTC_SURFACE);
+procedure ptc_surface_clear_color(obj: TPTC_SURFACE; color: TPTC_COLOR);
+procedure ptc_surface_clear_color_area(obj: TPTC_SURFACE; color: TPTC_COLOR; area: TPTC_AREA);
+
+{ surface palette }
+procedure ptc_surface_palette_set(obj: TPTC_SURFACE; palette: TPTC_PALETTE);
+function ptc_surface_palette_get(obj: TPTC_SURFACE): TPTC_PALETTE;
+
+{ surface clip area }
+procedure ptc_surface_clip_set(obj: TPTC_SURFACE; area: TPTC_AREA);
+
+{ data access }
+function ptc_surface_width(obj: TPTC_SURFACE): Integer;
+function ptc_surface_height(obj: TPTC_SURFACE): Integer;
+function ptc_surface_pitch(obj: TPTC_SURFACE): Integer;
+function ptc_surface_area(obj: TPTC_SURFACE): TPTC_AREA;
+function ptc_surface_clip(obj: TPTC_SURFACE): TPTC_AREA;
+function ptc_surface_format(obj: TPTC_SURFACE): TPTC_FORMAT;
+
+{ surface option string }
+function ptc_surface_option(obj: TPTC_SURFACE; _option: string): Boolean;

packages/ptc/src/c_api/capi_timer.inc

@@ -0,0 +1,148 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+function ptc_timer_create: TPTC_TIMER;
+begin
+  try
+    ptc_timer_create := TPTC_TIMER(TPTCTimer.Create);
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_timer_create := nil;
+    end;
+  end;
+end;
+
+procedure ptc_timer_destroy(obj: TPTC_TIMER);
+begin
+  if obj = nil then
+    exit;
+  try
+    TPTCTimer(obj).Destroy;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_timer_set(obj: TPTC_TIMER; time: Double);
+begin
+  try
+    TPTCTimer(obj).settime(time);
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_timer_start(obj: TPTC_TIMER);
+begin
+  try
+    TPTCTimer(obj).start;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+procedure ptc_timer_stop(obj: TPTC_TIMER);
+begin
+  try
+    TPTCTimer(obj).stop;
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_timer_time(obj: TPTC_TIMER): Double;
+begin
+  try
+    ptc_timer_time := TPTCTimer(obj).time;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_timer_time := 0;
+    end;
+  end;
+end;
+
+function ptc_timer_delta(obj: TPTC_TIMER): Double;
+begin
+  try
+    ptc_timer_delta := TPTCTimer(obj).delta;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_timer_delta := 0;
+    end;
+  end;
+end;
+
+function ptc_timer_resolution(obj: TPTC_TIMER): Double;
+begin
+  try
+    ptc_timer_resolution := TPTCTimer(obj).resolution;
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_timer_resolution := 0;
+    end;
+  end;
+end;
+
+procedure ptc_timer_assign(obj, timer: TPTC_TIMER);
+begin
+  try
+    TPTCTimer(obj).Assign(TPTCTimer(timer));
+  except
+    on error: TPTCError do
+      ptc_exception_handle(error);
+  end;
+end;
+
+function ptc_timer_equals(obj, timer: TPTC_TIMER): Boolean;
+begin
+  try
+    ptc_timer_equals := TPTCTimer(obj).equals(TPTCTimer(timer));
+  except
+    on error: TPTCError do
+    begin
+      ptc_exception_handle(error);
+      ptc_timer_equals := False;
+    end;
+  end;
+end;

packages/ptc/src/c_api/capi_timerd.inc

@@ -0,0 +1,51 @@
+{
+    Free Pascal port of the OpenPTC C++ library.
+    Copyright (C) 2001-2010  Nikolay Nikolov ([email protected])
+    Original C++ version by Glenn Fiedler ([email protected])
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version
+    with the following modification:
+
+    As a special exception, the copyright holders of this library give you
+    permission to link this library with independent modules to produce an
+    executable, regardless of the license terms of these independent modules,and
+    to copy and distribute the resulting executable under terms of your choice,
+    provided that you also meet, for each linked independent module, the terms
+    and conditions of the license of that module. An independent module is a
+    module which is not derived from or based on this library. If you modify
+    this library, you may extend this exception to your version of the library,
+    but you are not obligated to do so. If you do not wish to do so, delete this
+    exception statement from your version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+{ setup }
+function ptc_timer_create: TPTC_TIMER;
+procedure ptc_timer_destroy(obj: TPTC_TIMER);
+
+{ set time }
+procedure ptc_timer_set(obj: TPTC_TIMER; time: Double);
+
+{ control }
+procedure ptc_timer_start(obj: TPTC_TIMER);
+procedure ptc_timer_stop(obj: TPTC_TIMER);
+
+{ time data }
+function ptc_timer_time(obj: TPTC_TIMER): Double;
+function ptc_timer_delta(obj: TPTC_TIMER): Double;
+function ptc_timer_resolution(obj: TPTC_TIMER): Double;
+
+{ operators }
+procedure ptc_timer_assign(obj, timer: TPTC_TIMER);
+function ptc_timer_equals(obj, timer: TPTC_TIMER): Boolean;

packages/ptc/src/c_api/clear.inc

@@ -1,48 +0,0 @@
-Function ptc_clear_create : TPTC_CLEAR;
-
-Begin
-  Try
-    ptc_clear_create := TPTC_CLEAR(TPTCClear.Create);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_clear_create := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_clear_destroy(obj : TPTC_CLEAR);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCClear(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_clear_request(obj : TPTC_CLEAR; format : TPTC_FORMAT);
-
-Begin
-  Try
-    TPTCClear(obj).request(TPTCFormat(format));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_clear_clear(obj : TPTC_CLEAR; pixels : Pointer; x, y, width, height, pitch : Integer; color : TPTC_COLOR);
-
-Begin
-  Try
-    TPTCClear(obj).clear(pixels, x, y, width, height, pitch, TPTCColor(color));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;

packages/ptc/src/c_api/cleard.inc

@@ -1,9 +0,0 @@
-{ setup }
-Function ptc_clear_create : TPTC_CLEAR;
-Procedure ptc_clear_destroy(obj : TPTC_CLEAR);
-
-{ request clear }
-Procedure ptc_clear_request(obj : TPTC_CLEAR; format : TPTC_FORMAT);
-
-{ clear pixels }
-Procedure ptc_clear_clear(obj : TPTC_CLEAR; pixels : Pointer; x, y, width, height, pitch : Integer; color : TPTC_COLOR);

packages/ptc/src/c_api/clipper.inc

@@ -1,33 +0,0 @@
-Procedure ptc_clipper_clip(area, clip, clipped : TPTC_AREA);
-
-Var
-  tmp : TPTCArea;
-
-Begin
-  Try
-    tmp := TPTCClipper.clip(TPTCArea(area), TPTCArea(clip));
-    Try
-      TPTCArea(clipped).ASSign(tmp);
-    Finally
-      tmp.Destroy;
-    End;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-    End;
-  End;
-End;
-
-Procedure ptc_clipper_clip_complex(source, clip_source, clipped_source, destination, clip_destination, clipped_destination : TPTC_AREA);
-
-Begin
-  Try
-    TPTCClipper.clip(TPTCArea(source), TPTCArea(clip_source), TPTCArea(clipped_source), TPTCArea(destination), TPTCArea(clip_destination), TPTCArea(clipped_destination));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-    End;
-  End;
-End;

packages/ptc/src/c_api/clipperd.inc

@@ -1,5 +0,0 @@
-{ clip a single area against clip area }
-Procedure ptc_clipper_clip(area, clip, clipped : TPTC_AREA);
-
-{ clip source and destination areas against source and destination clip areas }
-Procedure ptc_clipper_clip_complex(source, clip_source, clipped_source, destination, clip_destination, clipped_destination : TPTC_AREA);

packages/ptc/src/c_api/color.inc

@@ -1,177 +0,0 @@
-Function ptc_color_create : TPTC_COLOR;
-
-Begin
-  Try
-    ptc_color_create := TPTC_COLOR(TPTCColor.Create);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_create := Nil;
-    End;
-  End;
-End;
-
-Function ptc_color_create_indexed(index : Integer) : TPTC_COLOR;
-
-Begin
-  Try
-    ptc_color_create_indexed := TPTC_COLOR(TPTCColor.Create(index));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_create_indexed := Nil;
-    End;
-  End;
-End;
-
-Function ptc_color_create_direct(r, g, b, a : Single) : TPTC_COLOR;
-
-Begin
-  Try
-    ptc_color_create_direct := TPTC_COLOR(TPTCColor.Create(r, g, b, a));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_create_direct := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_color_destroy(obj : TPTC_COLOR);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCColor(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_color_index(obj : TPTC_COLOR) : Integer;
-
-Begin
-  Try
-    ptc_color_index := TPTCColor(obj).index;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_index := 0;
-    End;
-  End;
-End;
-
-Function ptc_color_r(obj : TPTC_COLOR) : Single;
-
-Begin
-  Try
-    ptc_color_r := TPTCColor(obj).r;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_r := 0;
-    End;
-  End;
-End;
-
-Function ptc_color_g(obj : TPTC_COLOR) : Single;
-
-Begin
-  Try
-    ptc_color_g := TPTCColor(obj).g;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_g := 0;
-    End;
-  End;
-End;
-
-Function ptc_color_b(obj : TPTC_COLOR) : Single;
-
-Begin
-  Try
-    ptc_color_b := TPTCColor(obj).b;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_b := 0;
-    End;
-  End;
-End;
-
-Function ptc_color_a(obj : TPTC_COLOR) : Single;
-
-Begin
-  Try
-    ptc_color_a := TPTCColor(obj).a;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_a := 0;
-    End;
-  End;
-End;
-
-Function ptc_color_direct(obj : TPTC_COLOR) : Boolean;
-
-Begin
-  Try
-    ptc_color_direct := TPTCColor(obj).direct;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_direct := False;
-    End;
-  End;
-End;
-
-Function ptc_color_indexed(obj : TPTC_COLOR) : Boolean;
-
-Begin
-  Try
-    ptc_color_indexed := TPTCColor(obj).indexed;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_indexed := False;
-    End;
-  End;
-End;
-
-Procedure ptc_color_assign(obj, color : TPTC_COLOR);
-
-Begin
-  Try
-    TPTCColor(obj).ASSign(TPTCColor(color));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_color_equals(obj, color : TPTC_COLOR) : Boolean;
-
-Begin
-  Try
-    ptc_color_equals := TPTCColor(obj).Equals(TPTCColor(color));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_color_equals := False;
-    End;
-  End;
-End;

packages/ptc/src/c_api/colord.inc

@@ -1,18 +0,0 @@
-{ setup }
-Function ptc_color_create : TPTC_COLOR;
-Function ptc_color_create_indexed(index : Integer) : TPTC_COLOR;
-Function ptc_color_create_direct(r, g, b, a : Single) : TPTC_COLOR;
-Procedure ptc_color_destroy(obj : TPTC_COLOR);
-
-{ data access }
-Function ptc_color_index(obj : TPTC_COLOR) : Integer;
-Function ptc_color_r(obj : TPTC_COLOR) : Single;
-Function ptc_color_g(obj : TPTC_COLOR) : Single;
-Function ptc_color_b(obj : TPTC_COLOR) : Single;
-Function ptc_color_a(obj : TPTC_COLOR) : Single;
-Function ptc_color_direct(obj : TPTC_COLOR) : Boolean;
-Function ptc_color_indexed(obj : TPTC_COLOR) : Boolean;
-
-{ operators }
-Procedure ptc_color_assign(obj, color : TPTC_COLOR);
-Function ptc_color_equals(obj, color : TPTC_COLOR) : Boolean;

packages/ptc/src/c_api/console.inc

@@ -1,497 +0,0 @@
-Function ptc_console_create : TPTC_CONSOLE;
-
-Begin
-  Try
-    ptc_console_create := TPTC_CONSOLE(TPTCConsole.Create);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_create := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_console_destroy(obj : TPTC_CONSOLE);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCBaseConsole(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_configure(obj : TPTC_CONSOLE; _file : String);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).configure(_file);
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_console_option(obj : TPTC_CONSOLE; _option : String) : Boolean;
-
-Begin
-  Try
-    ptc_console_option := TPTCBaseConsole(obj).option(_option);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_option := False;
-    End;
-  End;
-End;
-
-Function ptc_console_mode(obj : TPTC_CONSOLE; index : Integer) : TPTC_MODE;
-
-Begin
-  Try
-    ptc_console_mode := TPTC_MODE(TPTCBaseConsole(obj).modes[index]);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_mode := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_console_open(obj : TPTC_CONSOLE; title : String; pages : Integer);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).open(title, pages);
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_open_format(obj : TPTC_CONSOLE; title : String; format : TPTC_FORMAT; pages : Integer);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).open(title, TPTCFormat(format), pages);
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_open_resolution(obj : TPTC_CONSOLE; title : String; width, height : Integer; format : TPTC_FORMAT; pages : Integer);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).open(title, width, height, TPTCFormat(format), pages);
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_open_mode(obj : TPTC_CONSOLE; title : String; mode : TPTC_MODE; pages : Integer);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).open(title, TPTCMode(mode), pages);
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_close(obj : TPTC_CONSOLE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).close;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_flush(obj : TPTC_CONSOLE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).flush;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_finish(obj : TPTC_CONSOLE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).finish;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_update(obj : TPTC_CONSOLE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).update;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_update_area(obj : TPTC_CONSOLE; area : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).update(TPTCArea(area));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_console_key(obj : TPTC_CONSOLE) : Boolean;
-
-Begin
-  Try
-    ptc_console_key := TPTCBaseConsole(obj).key;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_key := False;
-    End;
-  End;
-End;
-
-Procedure ptc_console_read(obj : TPTC_CONSOLE; key : TPTC_KEY);
-
-Var
-  tmp : TPTCKey;
-
-Begin
-  Try
-    tmp := TPTCBaseConsole(obj).read;
-    Try
-      TPTCKey(key).ASSign(tmp);
-    Finally
-      tmp.Destroy;
-    End;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_copy(obj : TPTC_CONSOLE; surface : TPTC_SURFACE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).copy(TPTCBaseSurface(surface));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_copy_area(obj : TPTC_CONSOLE; surface : TPTC_SURFACE; source, destination : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).copy(TPTCBaseSurface(surface), TPTCArea(source), TPTCArea(destination));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_console_lock(obj : TPTC_CONSOLE) : Pointer;
-
-Begin
-  Try
-    ptc_console_lock := TPTCBaseConsole(obj).lock;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_lock := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_console_unlock(obj : TPTC_CONSOLE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).unlock;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_load(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_load_area(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_save(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_save_area(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_clear(obj : TPTC_CONSOLE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).clear;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_clear_color(obj : TPTC_CONSOLE; color : TPTC_COLOR);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).clear(TPTCColor(color));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_clear_color_area(obj : TPTC_CONSOLE; color : TPTC_COLOR; area : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).clear(TPTCColor(color), TPTCArea(area));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_console_palette_set(obj : TPTC_CONSOLE; palette : TPTC_PALETTE);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).palette(TPTCPalette(palette));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_console_palette_get(obj : TPTC_CONSOLE) : TPTC_PALETTE;
-
-Begin
-  Try
-    ptc_console_palette_get := TPTC_PALETTE(TPTCBaseConsole(obj).palette);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_palette_get := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_console_clip_set(obj : TPTC_CONSOLE; area : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseConsole(obj).clip(TPTCArea(area));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_console_width(obj : TPTC_CONSOLE) : Integer;
-
-Begin
-  Try
-    ptc_console_width := TPTCBaseConsole(obj).width;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_width := 0;
-    End;
-  End;
-End;
-
-Function ptc_console_height(obj : TPTC_CONSOLE) : Integer;
-
-Begin
-  Try
-    ptc_console_height := TPTCBaseConsole(obj).height;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_height := 0;
-    End;
-  End;
-End;
-
-Function ptc_console_pages(obj : TPTC_CONSOLE) : Integer;
-
-Begin
-  Try
-    ptc_console_pages := TPTCBaseConsole(obj).pages;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_pages := 0;
-    End;
-  End;
-End;
-
-Function ptc_console_pitch(obj : TPTC_CONSOLE) : Integer;
-
-Begin
-  Try
-    ptc_console_pitch := TPTCBaseConsole(obj).pitch;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_pitch := 0;
-    End;
-  End;
-End;
-
-Function ptc_console_area(obj : TPTC_CONSOLE) : TPTC_AREA;
-
-Begin
-  Try
-    ptc_console_area := TPTC_AREA(TPTCBaseConsole(obj).area);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_area := Nil;
-    End;
-  End;
-End;
-
-Function ptc_console_clip(obj : TPTC_CONSOLE) : TPTC_AREA;
-
-Begin
-  Try
-    ptc_console_clip := TPTC_AREA(TPTCBaseConsole(obj).clip);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_clip := Nil;
-    End;
-  End;
-End;
-
-Function ptc_console_format(obj : TPTC_CONSOLE) : TPTC_FORMAT;
-
-Begin
-  Try
-    ptc_console_format := TPTC_FORMAT(TPTCBaseConsole(obj).format);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_format := Nil;
-    End;
-  End;
-End;
-
-Function ptc_console_name(obj : TPTC_CONSOLE) : String;
-
-Begin
-  Try
-    ptc_console_name := TPTCBaseConsole(obj).name;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_name := '';
-    End;
-  End;
-End;
-
-Function ptc_console_title(obj : TPTC_CONSOLE) : String;
-
-Begin
-  Try
-    ptc_console_title := TPTCBaseConsole(obj).title;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_title := '';
-    End;
-  End;
-End;
-
-Function ptc_console_information(obj : TPTC_CONSOLE) : String;
-
-Begin
-  Try
-    ptc_console_information := TPTCBaseConsole(obj).information;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_console_information := '';
-    End;
-  End;
-End;

packages/ptc/src/c_api/consoled.inc

@@ -1,83 +0,0 @@
-{ setup }
-Function ptc_console_create : TPTC_CONSOLE;
-Procedure ptc_console_destroy(obj : TPTC_CONSOLE);
-
-{ console configuration }
-Procedure ptc_console_configure(obj : TPTC_CONSOLE; _file : String);
-
-{ console option string }
-Function ptc_console_option(obj : TPTC_CONSOLE; _option : String) : Boolean;
-
-{ console modes }
-Function ptc_console_mode(obj : TPTC_CONSOLE; index : Integer) : TPTC_MODE;
-
-{ console management }
-Procedure ptc_console_open(obj : TPTC_CONSOLE; title : String; pages : Integer);
-Procedure ptc_console_open_format(obj : TPTC_CONSOLE; title : String; format : TPTC_FORMAT; pages : Integer);
-Procedure ptc_console_open_resolution(obj : TPTC_CONSOLE; title : String; width, height : Integer; format : TPTC_FORMAT; pages : Integer);
-Procedure ptc_console_open_mode(obj : TPTC_CONSOLE; title : String; mode : TPTC_MODE; pages : Integer);
-Procedure ptc_console_close(obj : TPTC_CONSOLE);
-
-{ synchronization }
-Procedure ptc_console_flush(obj : TPTC_CONSOLE);
-Procedure ptc_console_finish(obj : TPTC_CONSOLE);
-Procedure ptc_console_update(obj : TPTC_CONSOLE);
-Procedure ptc_console_update_area(obj : TPTC_CONSOLE; area : TPTC_AREA);
-
-{ keyboard input }
-Function ptc_console_key(obj : TPTC_CONSOLE) : Boolean;
-Procedure ptc_console_read(obj : TPTC_CONSOLE; key : TPTC_KEY);
-
-{ copy to surface }
-Procedure ptc_console_copy(obj : TPTC_CONSOLE; surface : TPTC_SURFACE);
-Procedure ptc_console_copy_area(obj : TPTC_CONSOLE; surface : TPTC_SURFACE; source, destination : TPTC_AREA);
-
-{ memory access }
-Function ptc_console_lock(obj : TPTC_CONSOLE) : Pointer;
-Procedure ptc_console_unlock(obj : TPTC_CONSOLE);
-
-{ load pixels to console }
-Procedure ptc_console_load(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE);
-Procedure ptc_console_load_area(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA);
-
-{ save console pixels }
-Procedure ptc_console_save(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE);
-Procedure ptc_console_save_area(obj : TPTC_CONSOLE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA);
-
-{ clear console }
-Procedure ptc_console_clear(obj : TPTC_CONSOLE);
-Procedure ptc_console_clear_color(obj : TPTC_CONSOLE; color : TPTC_COLOR);
-Procedure ptc_console_clear_color_area(obj : TPTC_CONSOLE; color : TPTC_COLOR; area : TPTC_AREA);
-
-{ console palette }
-Procedure ptc_console_palette_set(obj : TPTC_CONSOLE; palette : TPTC_PALETTE);
-Function ptc_console_palette_get(obj : TPTC_CONSOLE) : TPTC_PALETTE;
-
-{ console clip area }
-Procedure ptc_console_clip_set(obj : TPTC_CONSOLE; area : TPTC_AREA);
-
-{ data access }
-Function ptc_console_width(obj : TPTC_CONSOLE) : Integer;
-Function ptc_console_height(obj : TPTC_CONSOLE) : Integer;
-Function ptc_console_pages(obj : TPTC_CONSOLE) : Integer;
-Function ptc_console_pitch(obj : TPTC_CONSOLE) : Integer;
-Function ptc_console_area(obj : TPTC_CONSOLE) : TPTC_AREA;
-Function ptc_console_clip(obj : TPTC_CONSOLE) : TPTC_AREA;
-Function ptc_console_format(obj : TPTC_CONSOLE) : TPTC_FORMAT;
-Function ptc_console_name(obj : TPTC_CONSOLE) : String;
-Function ptc_console_title(obj : TPTC_CONSOLE) : String;
-Function ptc_console_information(obj : TPTC_CONSOLE) : String;
-
-{ extension functions }
-{#ifdef __PTC_WIN32_EXTENSIONS__
-CAPI void PTCAPI ptc_console_open_window(PTC_CONSOLE object,HWND window,int pages);
-CAPI void PTCAPI ptc_console_open_window_format(PTC_CONSOLE object,HWND window,PTC_FORMAT format,int pages);
-CAPI void PTCAPI ptc_console_open_window_resolution(PTC_CONSOLE object,HWND window,int width,int height,PTC_FORMAT format,int pages);
-CAPI void PTCAPI ptc_console_open_window_mode(PTC_CONSOLE object,HWND window,PTC_MODE mode,int pages);
-CAPI HWND PTCAPI ptc_console_window(PTC_CONSOLE object);
-CAPI LPDIRECTDRAW PTCAPI ptc_console_lpDD(PTC_CONSOLE object);
-CAPI LPDIRECTDRAW2 PTCAPI ptc_console_lpDD2(PTC_CONSOLE object);
-CAPI LPDIRECTDRAWSURFACE PTCAPI ptc_console_lpDDS(PTC_CONSOLE object);
-CAPI LPDIRECTDRAWSURFACE PTCAPI ptc_console_lpDDS_primary(PTC_CONSOLE object);
-CAPI LPDIRECTDRAWSURFACE PTCAPI ptc_console_lpDDS_secondary(PTC_CONSOLE object);
-#endif}

packages/ptc/src/c_api/copy.inc

@@ -1,74 +0,0 @@
-Function ptc_copy_create : TPTC_COPY;
-
-Begin
-  Try
-    ptc_copy_create := TPTC_COPY(TPTCCopy.Create);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_copy_create := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_copy_destroy(obj : TPTC_COPY);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCCopy(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_copy_request(obj : TPTC_COPY; source, destination : TPTC_FORMAT);
-
-Begin
-  Try
-    TPTCCopy(obj).request(TPTCFormat(source), TPTCFormat(destination));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_copy_palette(obj : TPTC_COPY; source, destination : TPTC_PALETTE);
-
-Begin
-  Try
-    TPTCCopy(obj).palette(TPTCPalette(source), TPTCPalette(destination));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_copy_copy(obj : TPTC_COPY; source_pixels : Pointer; source_x, source_y, source_width, source_height, source_pitch : Integer;
-                        destination_pixels : Pointer; destination_x, destination_y, destination_width, destination_height, destination_pitch : Integer);
-
-Begin
-  Try
-    TPTCCopy(obj).copy(source_pixels, source_x, source_y, source_width, source_height, source_pitch, destination_pixels, destination_x, destination_y, destination_width, destination_height, destination_pitch);
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_copy_option(obj : TPTC_COPY; option : String) : Boolean;
-
-Begin
-  Try
-    TPTCCopy(obj).option(option);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_copy_option := False;
-    End;
-  End;
-End;

packages/ptc/src/c_api/copyd.inc

@@ -1,16 +0,0 @@
-{ setup }
-Function ptc_copy_create : TPTC_COPY;
-Procedure ptc_copy_destroy(obj : TPTC_COPY);
-
-{ set source and destination formats }
-Procedure ptc_copy_request(obj : TPTC_COPY; source, destination : TPTC_FORMAT);
-
-{ set source and destination palettes }
-Procedure ptc_copy_palette(obj : TPTC_COPY; source, destination : TPTC_PALETTE);
-
-{ copy pixels }
-Procedure ptc_copy_copy(obj : TPTC_COPY; source_pixels : Pointer; source_x, source_y, source_width, source_height, source_pitch : Integer;
-                        destination_pixels : Pointer; destination_x, destination_y, destination_width, destination_height, destination_pitch : Integer);
-
-{ copy option string }
-Function ptc_copy_option(obj : TPTC_COPY; option : String) : Boolean;

packages/ptc/src/c_api/error.inc

@@ -1,96 +0,0 @@
-Function ptc_error_create(message : String) : TPTC_ERROR;
-
-Begin
-  Try
-    ptc_error_create := TPTC_ERROR(TPTCError.Create(message));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_error_create := Nil;
-    End;
-  End;
-End;
-
-Function ptc_error_create_composite(message : String; error : TPTC_ERROR) : TPTC_ERROR;
-
-Begin
-  Try
-    ptc_error_create_composite := TPTC_ERROR(TPTCError.Create(message, TPTCError(error)));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_error_create_composite := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_error_destroy(obj : TPTC_ERROR);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCError(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_error_report(obj : TPTC_ERROR);
-
-Begin
-  Try
-    TPTCError(obj).report;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_error_message(obj : TPTC_ERROR) : String;
-
-Begin
-  Try
-    ptc_error_message := TPTCError(obj).message;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_error_message := '';
-    End;
-  End;
-End;
-
-Procedure ptc_error_assign(obj, error : TPTC_ERROR);
-
-Begin
-  Try
-    TPTCError(obj).ASSign(TPTCError(error));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_error_equals(obj, error : TPTC_ERROR) : Boolean;
-
-Begin
-  Try
-    ptc_error_equals := TPTCError(obj).Equals(TPTCError(error));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_error_equals := False;
-    End;
-  End;
-End;
-
-Procedure ptc_error_handler(handler : TPTC_ERROR_HANDLER);
-
-Begin
-  ptc_exception_handler(handler);
-End;

packages/ptc/src/c_api/errord.inc

@@ -1,15 +0,0 @@
-Type
-  TPTC_ERROR_HANDLER = Procedure(error : TPTC_ERROR);
-
-Function ptc_error_create(message : String) : TPTC_ERROR;
-Function ptc_error_create_composite(message : String; error : TPTC_ERROR) : TPTC_ERROR;
-Procedure ptc_error_destroy(obj : TPTC_ERROR);
-
-Procedure ptc_error_report(obj : TPTC_ERROR);
-
-Function ptc_error_message(obj : TPTC_ERROR) : String;
-
-Procedure ptc_error_assign(obj, error : TPTC_ERROR);
-Function ptc_error_equals(obj, error : TPTC_ERROR) : Boolean;
-
-Procedure ptc_error_handler(handler : TPTC_ERROR_HANDLER);

packages/ptc/src/c_api/except.inc

@@ -1,23 +0,0 @@
-Var
-  ptc_error_handler_function : TPTC_ERROR_HANDLER;
-
-Procedure ptc_error_handler_default(error : TPTC_ERROR);
-
-Begin
-  TPTCError(error).report;
-End;
-
-Procedure ptc_exception_handler(handler : TPTC_ERROR_HANDLER);
-
-Begin
-  If handler = Nil Then
-    ptc_error_handler_function := @ptc_error_handler_default
-  Else
-    ptc_error_handler_function := handler;
-End;
-
-Procedure ptc_exception_handle(error : TPTCError);
-
-Begin
-  ptc_error_handler_function(TPTC_ERROR(error));
-End;

packages/ptc/src/c_api/exceptd.inc

@@ -1,2 +0,0 @@
-Procedure ptc_exception_handler(handler : TPTC_ERROR_HANDLER);
-Procedure ptc_exception_handle(error : TPTCError);

packages/ptc/src/c_api/format.inc

@@ -1,191 +0,0 @@
-Function ptc_format_create : TPTC_FORMAT;
-
-Begin
-  Try
-    ptc_format_create := TPTC_FORMAT(TPTCFormat.Create);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_create := Nil;
-    End;
-  End;
-End;
-
-Function ptc_format_create_indexed(bits : Integer) : TPTC_FORMAT;
-
-Begin
-  Try
-    ptc_format_create_indexed := TPTC_FORMAT(TPTCFormat.Create(bits));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_create_indexed := Nil;
-    End;
-  End;
-End;
-
-Function ptc_format_create_direct(bits : Integer; r, g, b, a : int32) : TPTC_FORMAT;
-
-Begin
-  Try
-    ptc_format_create_direct := TPTC_FORMAT(TPTCFormat.Create(bits, r, g, b, a));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_create_direct := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_format_destroy(obj : TPTC_FORMAT);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCFormat(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_format_r(obj : TPTC_FORMAT) : int32;
-
-Begin
-  Try
-    ptc_format_r := TPTCFormat(obj).r;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_r := 0;
-    End;
-  End;
-End;
-
-Function ptc_format_g(obj : TPTC_FORMAT) : int32;
-
-Begin
-  Try
-    ptc_format_g := TPTCFormat(obj).g;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_g := 0;
-    End;
-  End;
-End;
-
-Function ptc_format_b(obj : TPTC_FORMAT) : int32;
-
-Begin
-  Try
-    ptc_format_b := TPTCFormat(obj).b;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_b := 0;
-    End;
-  End;
-End;
-
-Function ptc_format_a(obj : TPTC_FORMAT) : int32;
-
-Begin
-  Try
-    ptc_format_a := TPTCFormat(obj).a;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_a := 0;
-    End;
-  End;
-End;
-
-Function ptc_format_bits(obj : TPTC_FORMAT) : Integer;
-
-Begin
-  Try
-    ptc_format_bits := TPTCFormat(obj).bits;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_bits := 0;
-    End;
-  End;
-End;
-
-Function ptc_format_bytes(obj : TPTC_FORMAT) : Integer;
-
-Begin
-  Try
-    ptc_format_bytes := TPTCFormat(obj).bytes;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_bytes := 0;
-    End;
-  End;
-End;
-
-Function ptc_format_direct(obj : TPTC_FORMAT) : Boolean;
-
-Begin
-  Try
-    ptc_format_direct := TPTCFormat(obj).direct;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_direct := False;
-    End;
-  End;
-End;
-
-Function ptc_format_indexed(obj : TPTC_FORMAT) : Boolean;
-
-Begin
-  Try
-    ptc_format_indexed := TPTCFormat(obj).indexed;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_indexed := False;
-    End;
-  End;
-End;
-
-Procedure ptc_format_assign(obj, format : TPTC_FORMAT);
-
-Begin
-  Try
-    TPTCFormat(obj).ASSign(TPTCFormat(format));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_format_equals(obj, format : TPTC_FORMAT) : Boolean;
-
-Begin
-  Try
-    ptc_format_equals := TPTCFormat(obj).Equals(TPTCFormat(format));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_format_equals := False;
-    End;
-  End;
-End;

packages/ptc/src/c_api/formatd.inc

@@ -1,19 +0,0 @@
-{ setup }
-Function ptc_format_create : TPTC_FORMAT;
-Function ptc_format_create_indexed(bits : Integer) : TPTC_FORMAT;
-Function ptc_format_create_direct(bits : Integer; r, g, b, a : int32) : TPTC_FORMAT;
-Procedure ptc_format_destroy(obj : TPTC_FORMAT);
-
-{ data access }
-Function ptc_format_r(obj : TPTC_FORMAT) : int32;
-Function ptc_format_g(obj : TPTC_FORMAT) : int32;
-Function ptc_format_b(obj : TPTC_FORMAT) : int32;
-Function ptc_format_a(obj : TPTC_FORMAT) : int32;
-Function ptc_format_bits(obj : TPTC_FORMAT) : Integer;
-Function ptc_format_bytes(obj : TPTC_FORMAT) : Integer;
-Function ptc_format_direct(obj : TPTC_FORMAT) : Boolean;
-Function ptc_format_indexed(obj : TPTC_FORMAT) : Boolean;
-
-{ operators }
-Procedure ptc_format_assign(obj, format : TPTC_FORMAT);
-Function ptc_format_equals(obj, format : TPTC_FORMAT) : Boolean;

packages/ptc/src/c_api/index.inc

@@ -1,14 +0,0 @@
-Type
-  { object handles }
-  TPTC_KEY     = Pointer; { equivalent to Object Pascal TPTCKey         }
-  TPTC_AREA    = Pointer; { equivalent to Object Pascal TPTCArea        }
-  TPTC_MODE    = Pointer; { equivalent to Object Pascal TPTCMode        }
-  TPTC_COPY    = Pointer; { equivalent to Object Pascal TPTCCopy        }
-  TPTC_CLEAR   = Pointer; { equivalent to Object Pascal TPTCClear       }
-  TPTC_TIMER   = Pointer; { equivalent to Object Pascal TPTCTimer       }
-  TPTC_ERROR   = Pointer; { equivalent to Object Pascal TPTCError       }
-  TPTC_COLOR   = Pointer; { equivalent to Object Pascal TPTCColor       }
-  TPTC_FORMAT  = Pointer; { equivalent to Object Pascal TPTCFormat      }
-  TPTC_PALETTE = Pointer; { equivalent to Object Pascal TPTCPalette     }
-  TPTC_SURFACE = Pointer; { equivalent to Object Pascal TPTCBaseSurface }
-  TPTC_CONSOLE = Pointer; { equivalent to Object Pascal TPTCBaseConsole }

packages/ptc/src/c_api/key.inc

@@ -1,107 +0,0 @@
-Function ptc_key_create(code : Integer; alt, shift, control : Boolean) : TPTC_KEY;
-
-Begin
-  Try
-    ptc_key_create := TPTC_KEY(TPTCKey.Create(code, alt, shift, control));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_key_create := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_key_destroy(obj : TPTC_KEY);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCKey(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_key_code(obj : TPTC_KEY) : Integer;
-
-Begin
-  Try
-    ptc_key_code := Integer(TPTCKey(obj).code);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_key_code := 0;
-    End;
-  End;
-End;
-
-Function ptc_key_alt(obj : TPTC_KEY) : Boolean;
-
-Begin
-  Try
-    ptc_key_alt := TPTCKey(obj).alt;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_key_alt := False;
-    End;
-  End;
-End;
-
-Function ptc_key_shift(obj : TPTC_KEY) : Boolean;
-
-Begin
-  Try
-    ptc_key_shift := TPTCKey(obj).shift;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_key_shift := False;
-    End;
-  End;
-End;
-
-Function ptc_key_control(obj : TPTC_KEY) : Boolean;
-
-Begin
-  Try
-    ptc_key_control := TPTCKey(obj).control;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_key_control := False;
-    End;
-  End;
-End;
-
-Procedure ptc_key_assign(obj : TPTC_KEY; key : TPTC_KEY);
-
-Begin
-  Try
-    TPTCKey(obj).ASSign(TPTCKey(key));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_key_equals(obj : TPTC_KEY; key : TPTC_KEY) : Boolean;
-
-Begin
-  Try
-    ptc_key_equals := TPTCKey(obj).Equals(TPTCKey(key));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_key_equals := False;
-    End;
-  End;
-End;

packages/ptc/src/c_api/mode.inc

@@ -1,121 +0,0 @@
-Function ptc_mode_create(width, height : Integer; format : TPTC_FORMAT) : TPTC_MODE;
-
-Begin
-  Try
-    ptc_mode_create := TPTC_MODE(TPTCMode.Create(width, height, TPTCFormat(format)));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_mode_create := Nil;
-    End;
-  End;
-End;
-
-Function ptc_mode_create_invalid : TPTC_MODE;
-
-Begin
-  Try
-    ptc_mode_create_invalid := TPTC_MODE(TPTCMode.Create);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_mode_create_invalid := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_mode_destroy(obj : TPTC_MODE);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCMode(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_mode_valid(obj : TPTC_MODE) : Boolean;
-
-Begin
-  Try
-    ptc_mode_valid := TPTCMode(obj).valid;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_mode_valid := False;
-    End;
-  End;
-End;
-
-Function ptc_mode_width(obj : TPTC_MODE) : Integer;
-
-Begin
-  Try
-    ptc_mode_width := TPTCMode(obj).width;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_mode_width := 0;
-    End;
-  End;
-End;
-
-Function ptc_mode_height(obj : TPTC_MODE) : Integer;
-
-Begin
-  Try
-    ptc_mode_height := TPTCMode(obj).height;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_mode_height := 0;
-    End;
-  End;
-End;
-
-Function ptc_mode_format(obj : TPTC_MODE) : TPTC_FORMAT;
-
-Begin
-  Try
-    ptc_mode_format := TPTC_FORMAT(TPTCMode(obj).format);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_mode_format := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_mode_assign(obj, mode : TPTC_MODE);
-
-Begin
-  Try
-    TPTCMode(obj).ASSign(TPTCMode(mode));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_mode_equals(obj, mode : TPTC_MODE) : Boolean;
-
-Begin
-  Try
-    ptc_mode_equals := TPTCMode(obj).Equals(TPTCMode(mode));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_mode_equals := False;
-    End;
-  End;
-End;

packages/ptc/src/c_api/moded.inc

@@ -1,16 +0,0 @@
-{ setup }
-Function ptc_mode_create(width, height : Integer; format : TPTC_FORMAT) : TPTC_MODE;
-Function ptc_mode_create_invalid : TPTC_MODE;
-Procedure ptc_mode_destroy(obj : TPTC_MODE);
-
-{ valid mode flag }
-Function ptc_mode_valid(obj : TPTC_MODE) : Boolean;
-
-{ data access }
-Function ptc_mode_width(obj : TPTC_MODE) : Integer;
-Function ptc_mode_height(obj : TPTC_MODE) : Integer;
-Function ptc_mode_format(obj : TPTC_MODE) : TPTC_FORMAT;
-
-{ operators }
-Procedure ptc_mode_assign(obj, mode : TPTC_MODE);
-Function ptc_mode_equals(obj, mode : TPTC_MODE) : Boolean;

packages/ptc/src/c_api/palette.inc

@@ -1,126 +0,0 @@
-Function ptc_palette_create : TPTC_PALETTE;
-
-Begin
-  Try
-    ptc_palette_create := TPTC_PALETTE(TPTCPalette.Create);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_palette_create := Nil;
-    End;
-  End;
-End;
-
-{Function ptc_palette_create_data(data : Pint32) : TPTC_PALETTE;
-
-Begin
-  Try
-    ptc_palette_create_data := TPTC_PALETTE(TPTCPalette.Create(data));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_palette_create_data := Nil;
-    End;
-  End;
-End;}
-
-Procedure ptc_palette_destroy(obj : TPTC_PALETTE);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCPalette(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_palette_lock(obj : TPTC_PALETTE) : Pint32;
-
-Begin
-  Try
-    ptc_palette_lock := TPTCPalette(obj).lock;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_palette_lock := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_palette_unlock(obj : TPTC_PALETTE);
-
-Begin
-  Try
-    TPTCPalette(obj).unlock;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_palette_load(obj : TPTC_PALETTE; data : Pint32);
-
-Begin
-  Try
-    TPTCPalette(obj).load(data);
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_palette_save(obj : TPTC_PALETTE; data : Pint32);
-
-Begin
-  Try
-    TPTCPalette(obj).save(data);
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_palette_data(obj : TPTC_PALETTE) : Pint32;
-
-Begin
-  Try
-    ptc_palette_data := TPTCPalette(obj).data;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_palette_data := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_palette_assign(obj, palette : TPTC_PALETTE);
-
-Begin
-  Try
-    TPTCPalette(obj).ASSign(TPTCPalette(palette));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_palette_equals(obj, palette : TPTC_PALETTE) : Boolean;
-
-Begin
-  Try
-    ptc_palette_equals := TPTCPalette(obj).Equals(TPTCPalette(palette));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_palette_equals := False;
-    End;
-  End;
-End;

packages/ptc/src/c_api/paletted.inc

@@ -1,21 +0,0 @@
-{ setup }
-Function ptc_palette_create : TPTC_PALETTE;
-{Function ptc_palette_create_data(data : Pint32) : TPTC_PALETTE;}
-Procedure ptc_palette_destroy(obj : TPTC_PALETTE);
-
-{ memory access }
-Function ptc_palette_lock(obj : TPTC_PALETTE) : Pint32;
-Procedure ptc_palette_unlock(obj : TPTC_PALETTE);
-
-{ load palette data }
-Procedure ptc_palette_load(obj : TPTC_PALETTE; data : Pint32);
-
-{ save palette data }
-Procedure ptc_palette_save(obj : TPTC_PALETTE; data : Pint32);
-
-{ get palette data }
-Function ptc_palette_data(obj : TPTC_PALETTE) : Pint32;
-
-{ operators }
-Procedure ptc_palette_assign(obj, palette : TPTC_PALETTE);
-Function ptc_palette_equals(obj, palette : TPTC_PALETTE) : Boolean;

packages/ptc/src/c_api/surface.inc

@@ -1,284 +0,0 @@
-Function ptc_surface_create(width, height : Integer; format : TPTC_FORMAT) : TPTC_SURFACE;
-
-Begin
-  Try
-    ptc_surface_create := TPTC_SURFACE(TPTCSurface.Create(width, height, TPTCFormat(format)));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_create := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_surface_destroy(obj : TPTC_SURFACE);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCBaseSurface(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_copy(obj : TPTC_SURFACE; surface : TPTC_SURFACE);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).copy(TPTCBaseSurface(surface));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_copy_area(obj : TPTC_SURFACE; surface : TPTC_SURFACE; source, destination : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).copy(TPTCBaseSurface(surface), TPTCArea(source), TPTCArea(destination));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_surface_lock(obj : TPTC_SURFACE) : Pointer;
-
-Begin
-  Try
-    ptc_surface_lock := TPTCBaseSurface(obj).lock;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_lock := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_surface_unlock(obj : TPTC_SURFACE);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).unlock;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_load(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_load_area(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).load(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_save(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_save_area(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).save(pixels, width, height, pitch, TPTCFormat(format), TPTCPalette(palette), TPTCArea(source), TPTCArea(destination));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_clear(obj : TPTC_SURFACE);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).clear;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_clear_color(obj : TPTC_SURFACE; color : TPTC_COLOR);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).clear(TPTCColor(color));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_clear_color_area(obj : TPTC_SURFACE; color : TPTC_COLOR; area : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).clear(TPTCColor(color), TPTCArea(area));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_surface_palette_set(obj : TPTC_SURFACE; palette : TPTC_PALETTE);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).palette(TPTCPalette(palette));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_surface_palette_get(obj : TPTC_SURFACE) : TPTC_PALETTE;
-
-Begin
-  Try
-    ptc_surface_palette_get := TPTC_PALETTE(TPTCBaseSurface(obj).palette);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_palette_get := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_surface_clip_set(obj : TPTC_SURFACE; area : TPTC_AREA);
-
-Begin
-  Try
-    TPTCBaseSurface(obj).clip(TPTCArea(area));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_surface_width(obj : TPTC_SURFACE) : Integer;
-
-Begin
-  Try
-    ptc_surface_width := TPTCBaseSurface(obj).width;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_width := 0;
-    End;
-  End;
-End;
-
-Function ptc_surface_height(obj : TPTC_SURFACE) : Integer;
-
-Begin
-  Try
-    ptc_surface_height := TPTCBaseSurface(obj).height;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_height := 0;
-    End;
-  End;
-End;
-
-Function ptc_surface_pitch(obj : TPTC_SURFACE) : Integer;
-
-Begin
-  Try
-    ptc_surface_pitch := TPTCBaseSurface(obj).pitch;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_pitch := 0;
-    End;
-  End;
-End;
-
-Function ptc_surface_area(obj : TPTC_SURFACE) : TPTC_AREA;
-
-Begin
-  Try
-    ptc_surface_area := TPTC_AREA(TPTCBaseSurface(obj).area);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_area := Nil;
-    End;
-  End;
-End;
-
-Function ptc_surface_clip(obj : TPTC_SURFACE) : TPTC_AREA;
-
-Begin
-  Try
-    ptc_surface_clip := TPTC_AREA(TPTCBaseSurface(obj).clip);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_clip := Nil;
-    End;
-  End;
-End;
-
-Function ptc_surface_format(obj : TPTC_SURFACE) : TPTC_FORMAT;
-
-Begin
-  Try
-    ptc_surface_format := TPTC_FORMAT(TPTCBaseSurface(obj).format);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_format := Nil;
-    End;
-  End;
-End;
-
-Function ptc_surface_option(obj : TPTC_SURFACE; _option : String) : Boolean;
-
-Begin
-  Try
-    ptc_surface_option := TPTCBaseSurface(obj).option(_option);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_surface_option := False;
-    End;
-  End;
-End;

packages/ptc/src/c_api/surfaced.inc

@@ -1,42 +0,0 @@
-{ setup }
-Function ptc_surface_create(width, height : Integer; format : TPTC_FORMAT) : TPTC_SURFACE;
-Procedure ptc_surface_destroy(obj : TPTC_SURFACE);
-
-{ copy to surface }
-Procedure ptc_surface_copy(obj : TPTC_SURFACE; surface : TPTC_SURFACE);
-Procedure ptc_surface_copy_area(obj : TPTC_SURFACE; surface : TPTC_SURFACE; source, destination : TPTC_AREA);
-
-{ memory access }
-Function ptc_surface_lock(obj : TPTC_SURFACE) : Pointer;
-Procedure ptc_surface_unlock(obj : TPTC_SURFACE);
-
-{ load pixels to surface }
-Procedure ptc_surface_load(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE);
-Procedure ptc_surface_load_area(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA);
-
-{ save surface pixels }
-Procedure ptc_surface_save(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE);
-Procedure ptc_surface_save_area(obj : TPTC_SURFACE; pixels : Pointer; width, height, pitch : Integer; format : TPTC_FORMAT; palette : TPTC_PALETTE; source, destination : TPTC_AREA);
-
-{ clear surface }
-Procedure ptc_surface_clear(obj : TPTC_SURFACE);
-Procedure ptc_surface_clear_color(obj : TPTC_SURFACE; color : TPTC_COLOR);
-Procedure ptc_surface_clear_color_area(obj : TPTC_SURFACE; color : TPTC_COLOR; area : TPTC_AREA);
-
-{ surface palette }
-Procedure ptc_surface_palette_set(obj : TPTC_SURFACE; palette : TPTC_PALETTE);
-Function ptc_surface_palette_get(obj : TPTC_SURFACE) : TPTC_PALETTE;
-
-{ surface clip area }
-Procedure ptc_surface_clip_set(obj : TPTC_SURFACE; area : TPTC_AREA);
-
-{ data access }
-Function ptc_surface_width(obj : TPTC_SURFACE) : Integer;
-Function ptc_surface_height(obj : TPTC_SURFACE) : Integer;
-Function ptc_surface_pitch(obj : TPTC_SURFACE) : Integer;
-Function ptc_surface_area(obj : TPTC_SURFACE) : TPTC_AREA;
-Function ptc_surface_clip(obj : TPTC_SURFACE) : TPTC_AREA;
-Function ptc_surface_format(obj : TPTC_SURFACE) : TPTC_FORMAT;
-
-{ surface option string }
-Function ptc_surface_option(obj : TPTC_SURFACE; _option : String) : Boolean;

packages/ptc/src/c_api/timer.inc

@@ -1,126 +0,0 @@
-Function ptc_timer_create : TPTC_TIMER;
-
-Begin
-  Try
-    ptc_timer_create := TPTC_TIMER(TPTCTimer.Create);
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_timer_create := Nil;
-    End;
-  End;
-End;
-
-Procedure ptc_timer_destroy(obj : TPTC_TIMER);
-
-Begin
-  If obj = Nil Then
-    Exit;
-  Try
-    TPTCTimer(obj).Destroy;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_timer_set(obj : TPTC_TIMER; time : Double);
-
-Begin
-  Try
-    TPTCTimer(obj).settime(time);
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_timer_start(obj : TPTC_TIMER);
-
-Begin
-  Try
-    TPTCTimer(obj).start;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Procedure ptc_timer_stop(obj : TPTC_TIMER);
-
-Begin
-  Try
-    TPTCTimer(obj).stop;
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_timer_time(obj : TPTC_TIMER) : Double;
-
-Begin
-  Try
-    ptc_timer_time := TPTCTimer(obj).time;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_timer_time := 0;
-    End;
-  End;
-End;
-
-Function ptc_timer_delta(obj : TPTC_TIMER) : Double;
-
-Begin
-  Try
-    ptc_timer_delta := TPTCTimer(obj).delta;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_timer_delta := 0;
-    End;
-  End;
-End;
-
-Function ptc_timer_resolution(obj : TPTC_TIMER) : Double;
-
-Begin
-  Try
-    ptc_timer_resolution := TPTCTimer(obj).resolution;
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_timer_resolution := 0;
-    End;
-  End;
-End;
-
-Procedure ptc_timer_assign(obj, timer : TPTC_TIMER);
-
-Begin
-  Try
-    TPTCTimer(obj).ASSign(TPTCTimer(timer));
-  Except
-    On error : TPTCError Do
-      ptc_exception_handle(error);
-  End;
-End;
-
-Function ptc_timer_equals(obj, timer : TPTC_TIMER) : Boolean;
-
-Begin
-  Try
-    ptc_timer_equals := TPTCTimer(obj).equals(TPTCTimer(timer));
-  Except
-    On error : TPTCError Do
-    Begin
-      ptc_exception_handle(error);
-      ptc_timer_equals := False;
-    End;
-  End;
-End;

packages/ptc/src/c_api/timerd.inc

@@ -1,19 +0,0 @@
-{ setup }
-Function ptc_timer_create : TPTC_TIMER;
-Procedure ptc_timer_destroy(obj : TPTC_TIMER);
-
-{ set time }
-Procedure ptc_timer_set(obj : TPTC_TIMER; time : Double);
-
-{ control }
-Procedure ptc_timer_start(obj : TPTC_TIMER);
-Procedure ptc_timer_stop(obj : TPTC_TIMER);
-
-{ time data }
-Function ptc_timer_time(obj : TPTC_TIMER) : Double;
-Function ptc_timer_delta(obj : TPTC_TIMER) : Double;
-Function ptc_timer_resolution(obj : TPTC_TIMER) : Double;
-
-{ operators }
-Procedure ptc_timer_assign(obj, timer : TPTC_TIMER);
-Function ptc_timer_equals(obj, timer : TPTC_TIMER) : Boolean;

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

@@ -78,7 +78,8 @@ var
   AsciiBuf: Word;
   press: Boolean;
   uni: Integer;
-  tmp: Integer;
+  TranslatedCharacters, TranslatedWideCharacters: Integer;
+  WideStr: WideString;
   KeyCode: Integer;
 begin
   Result := 0;
@@ -117,21 +118,18 @@ begin
     begin
       scancode := (lParam shr 16) and $FF;
       {todo: ToUnicode (Windows NT)}
-      tmp := ToAscii(wParam, scancode, @KeyStateArray, @AsciiBuf, 0);
-      if (tmp = 1) or (tmp = 2) then
+      TranslatedCharacters := ToAscii(wParam, scancode, @KeyStateArray, @AsciiBuf, 0);
+      if (TranslatedCharacters = 1) or (TranslatedCharacters = 2) then
       begin
-        if tmp = 2 then
+        TranslatedWideCharacters := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, @AsciiBuf, TranslatedCharacters, nil, 0);
+        if TranslatedWideCharacters <> 0 then
         begin
-//          Writeln('[', AsciiBuf, ']'); {???? todo: dead keys ????}
-        end
-        else
-        begin
-//          Write(Chr(AsciiBuf));
-          {todo: codepage -> unicode}
-          if (AsciiBuf and $FF) <= 126 then
-            uni := AsciiBuf and $FF;
-        end;
+          SetLength(WideStr, TranslatedWideCharacters);
+          MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, @AsciiBuf, TranslatedCharacters, @WideStr[1], TranslatedWideCharacters);
 
+          if Length(WideStr) = 1 then
+            uni := Ord(WideStr[1]);
+        end;
       end;
     end;
 

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

@@ -134,7 +134,10 @@ begin
     exit;
   if not FMultithreaded then
   begin
-    while PeekMessage(message, FWindow, 0, 0, PM_REMOVE) do
+    { updated to pump all window messages, and not just for our FWindow;
+      this fixes keyboard layout switching and maybe other bugs and side effects...
+      Seems like Windows wants everything pumped :) }
+    while PeekMessage(message, {FWindow}0, 0, 0, PM_REMOVE) do
     begin
       TranslateMessage(message);
       DispatchMessage(message);

packages/ptc/src/x11/x11dgadisplayd.inc

@@ -1,40 +0,0 @@
-Type
-  TX11DGADisplay = Class(TX11Display)
-  Private
-    Function NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean; Override;
-    Function PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent; Override;
-    
-    Procedure HandleEvents;
-    
-    modeinfo : PPXF86VidModeModeInfo;
-    num_modeinfo : Integer;
-    previousmode : Integer;
-    
-    dga_addr : PByte;
-    dga_linewidth : Integer;
-    dga_banksize : Integer;
-    dga_memsize : Integer;
-    dga_width, dga_height : Integer;
-    
-    { Coordinates of upper left frame corner }
-    m_destx, m_desty : Integer;
-    
-    m_indirect, m_inmode : Boolean;
-  Public
-    Constructor Create;
-    Destructor Destroy; Override;
-    
-    Procedure open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer); Override;
-    Procedure open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat); Override;
-    Procedure open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer); Override;
-    Procedure close; Override;
-    Procedure update; Override;
-    Procedure update(Const _area : TPTCArea); Override;
-    Function lock : Pointer; Override;
-    Procedure unlock; Override;
-    Procedure palette(Const _palette : TPTCPalette); Override;
-    Function pitch : Integer; Override;
-    Function getX11Window : TWindow; Override;
-    Function isFullScreen : Boolean; Override;
-    Procedure SetCursor(visible : Boolean); Override;
-  End;

packages/ptc/src/x11/x11dgadisplayi.inc

@@ -1,528 +0,0 @@
-Constructor TX11DGADisplay.Create;
-
-Begin
-  m_indirect := False;
-  m_inmode := False;
-  modeinfo := Nil;
-  Inherited Create;
-  
-//  dga_LoadLibrary;
-
-{  If (XF86DGAQueryExtension = Nil) Or (XF86DGAGetVideo = Nil) Or
-     (XF86DGAGetViewPortSize = Nil) Or (XF86DGAForkApp = Nil) Or
-     (XF86DGADirectVideo = Nil) Or (XF86DGASetViewPort = Nil) Or
-     (XF86DGAInstallColormap = Nil) Then
-    Raise TPTCError.Create('DGA extension not available');}
-End;
-
-Destructor TX11DGADisplay.Destroy;
-
-Begin
-  close; {fix close!}
-//  dga_UnloadLibrary;
-  Inherited Destroy;
-End;
-
-Procedure TX11DGADisplay.open(title : String; _width, _height : Integer; Const _format : TPTCFormat; disp : PDisplay; screen : Integer);
-
-Var
-  dummy1, dummy2 : Integer;
-  vml : PXF86VidModeModeLine;
-  dotclock : Integer;
-  i : Integer;
-  found : Boolean;
-  root : TWindow;
-  e : TXEvent;
-  tmpArea : TPTCArea;
-  r, g, b : Single;
-  found_mode : Integer;
-  min_diff : Integer;
-  d_x, d_y : Integer;
-
-Begin
-  m_disp := disp;
-  m_screen := screen;
-  m_width := _width;
-  m_height := _height;
-  
-  { Check if we are root }
-  If fpgeteuid <> 0 Then
-    Raise TPTCError.Create('Have to be root to switch to DGA mode');
-  
-  { Check if the DGA extension and VidMode extension can be used }
-  If Not XF86DGAQueryExtension(disp, @dummy1, @dummy2) Then
-    Raise TPTCError.Create('DGA extension not available');
-  If Not XF86VidModeQueryExtension(disp, @dummy1, @dummy2) Then
-    Raise TPTCError.Create('VidMode extension not available');
-
-  { Get all availabe video modes }
-  XF86VidModeGetAllModeLines(m_disp, m_screen, @num_modeinfo, @modeinfo);
-
-  previousmode := -1;
-  { Save previous mode }
-  New(vml);
-  Try
-    XF86VidModeGetModeLine(m_disp, m_screen, @dotclock, vml);
-    Try
-      For i := 0 To num_modeinfo - 1 Do
-      Begin
-        If (vml^.hdisplay = modeinfo[i]^.hdisplay) And
-           (vml^.vdisplay = modeinfo[i]^.vdisplay) Then
-        Begin
-          previousmode := i;
-	  Break;
-        End;
-      End;
-    Finally
-      If vml^.privsize <> 0 Then
-        XFree(vml^.c_private);
-    End;
-  Finally
-    Dispose(vml);
-  End;
-  If previousmode = -1 Then
-    Raise TPTCError.Create('Current mode not found in modelist?! Err, this shouldn''t happen :)');
-  
-  { Find a video mode to set }
-  
-  { Normal modesetting first, find exactly matching mode }
-  If Not (PTC_X11_PEDANTIC_DGA In m_flags) Then
-  Begin
-    found := False;
-    For i := 0 To num_modeinfo - 1 Do
-    Begin
-      If (modeinfo[i]^.hdisplay = _width) And (modeinfo[i]^.vdisplay = _height) Then
-      Begin
-        If Not XF86VidModeSwitchToMode(m_disp, m_screen, modeinfo[i]) Then
-	  Raise TPTCError.Create('Error switching to requested video mode');
-	m_destx := 0;
-	m_desty := 0;
-	found := True;
-	Break;
-      End;
-    End;
-    If Not found Then
-      Raise TPTCError.Create('Cannot find matching DGA video mode');
-  End
-  Else
-  Begin
-    found_mode := $FFFF;
-    
-    { Try to find a mode that matches the width first }
-    For i := 0 To num_modeinfo - 1 Do
-    Begin
-      If (modeinfo[i]^.hdisplay = _width) And
-         (modeinfo[i]^.vdisplay >= _height) Then
-      Begin
-        found_mode := i;
-	Break;
-      End;
-    End;
-    
-    { Next try to match the height }
-    If found_mode = $FFFF Then
-      For i := 0 To num_modeinfo - 1 Do
-      Begin
-        If (modeinfo[i]^.hdisplay >= _width) And
-           (modeinfo[i]^.vdisplay = _height) Then
-        Begin
-          found_mode := i;
-	  Break;
-        End;
-      End;
-    
-    { Finally, find the mode that is bigger than the requested one and makes }
-    { the least difference }
-    min_diff := 987654321;
-    
-    For i := 0 To num_modeinfo - 1 Do
-    Begin
-      If (modeinfo[i]^.hdisplay >= _width) And (modeinfo[i]^.vdisplay >= _height) Then
-      Begin
-        d_x := modeinfo[i]^.hdisplay - _width;
-	d_x *= d_x;
-	d_y := modeinfo[i]^.vdisplay - _height;
-	d_y *= d_y;
-	If (d_x + d_y) < min_diff Then
-	Begin
-	  min_diff := d_x + d_y;
-	  found_mode := i;
-	End;
-      End;
-    End;
-    
-    If found_mode <> $FFFF Then
-    Begin
-      If Not XF86VidModeSwitchToMode(m_disp, m_screen, modeinfo[found_mode]) Then
-        Raise TPTCError.Create('Error switching to requested video mode');
-      m_destx := (modeinfo[found_mode]^.hdisplay Div 2) - (_width Div 2);
-      m_desty := (modeinfo[found_mode]^.vdisplay Div 2) - (_height Div 2);
-    End
-    Else
-      Raise TPTCError.Create('Cannot find a video mode to use');
-  End;
-  XFlush(m_disp);
-  m_inmode := True;
-
-  { Check if the requested colour mode is available }
-  m_format := getFormat(_format);
-  
-  { Grab exclusive control over the keyboard and mouse }
-  root := XRootWindow(m_disp, m_screen);
-  XGrabKeyboard(m_disp, root, True, GrabModeAsync, GrabModeAsync, CurrentTime);
-  XGrabPointer(m_disp, root, True, PointerMotionMask Or ButtonPressMask Or
-               ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None,
-	       CurrentTime);
-  XFlush(m_disp);
-  
-  { Get Display information }
-  XF86DGAGetVideo(m_disp, m_screen, @dga_addr, @dga_linewidth,
-                  @dga_banksize, @dga_memsize);
-  
-  { Don't have to be root anymore }
-{  setuid(getuid);...}
-  
-  XF86DGAGetViewPortSize(m_disp, m_screen, @dga_width, @dga_height);
-  
-  If XF86DGAForkApp(m_screen) <> 0 Then
-    Raise TPTCError.Create('cannot do safety fork')
-  Else
-  Begin
-    If XF86DGADirectVideo(m_disp, m_screen, XF86DGADirectGraphics Or
-      XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then
-      Raise TPTCError.Create('cannot switch to DGA mode');
-  End;
-  
-  m_indirect := True;
-  FillChar(dga_addr^, dga_linewidth * dga_height * (m_format.bits Div 8), 0);
-  
-  XSelectInput(m_disp, DefaultRootWindow(m_disp),
-               KeyPressMask Or KeyReleaseMask);
-  
-  XF86DGASetViewPort(m_disp, m_screen, 0, 0); { Important.. sort of =) }
-
-  found := False;
-  Repeat
-    { Stupid loop. The key }
-    { events were causing }
-    { problems.. }
-    found := XCheckMaskEvent(m_disp, KeyPressMask Or KeyReleaseMask, @e);
-  Until Not found;
-  
-  { Create colour map in 8 bit mode }
-  If m_format.bits = 8 Then
-  Begin
-    m_colours := GetMem(256 * SizeOf(TXColor));
-    If m_colours = Nil Then
-      Raise TPTCError.Create('Cannot allocate colour map cells');
-    m_cmap := XCreateColormap(m_disp, RootWindow(m_disp, m_screen),
-                              DefaultVisual(m_disp, m_screen), AllocAll);
-    If m_cmap = 0 Then
-      Raise TPTCError.Create('Cannot create colour map');
-  End
-  Else
-    m_cmap := 0;
-
-  { Set 332 palette, for now }
-  If (m_format.bits = 8) And m_format.direct Then
-  Begin
-    {Taken from PTC 0.72, i hope it's fine}
-    For i := 0 To 255 Do
-    Begin
-      r := ((i And $E0) Shr 5) * 255 / 7;
-      g := ((i And $1C) Shr 2) * 255 / 7;
-      b := (i And $03) * 255 / 3;
-      
-      m_colours[i].pixel := i;
-      
-      m_colours[i].red := Round(r) Shl 8;
-      m_colours[i].green := Round(g) Shl 8;
-      m_colours[i].blue := Round(b) Shl 8;
-      
-      Byte(m_colours[i].flags) := DoRed Or DoGreen Or DoBlue;
-    End;
-    XStoreColors(m_disp, m_cmap, m_colours, 256);
-    XF86DGAInstallColormap(m_disp, m_screen, m_cmap);
-  End;
-  
-  { Set clipping area }
-  tmpArea := TPTCArea.Create(0, 0, m_width, m_height);
-  Try
-    m_clip.ASSign(tmpArea);
-  Finally
-    tmpArea.Free;
-  End;
-End;
-
-{ Not in DGA mode }
-Procedure TX11DGADisplay.open(disp : PDisplay; screen : Integer; w : TWindow; Const _format : TPTCFormat);
-
-Begin
-  If disp = Nil Then; { Prevent warnings }
-  If screen = 0 Then;
-  If w = 0 Then;
-  If _format = Nil Then;
-End;
-
-Procedure TX11DGADisplay.open(disp : PDisplay; screen : Integer; _window : TWindow; Const _format : TPTCFormat; x, y, w, h : Integer);
-
-Begin
-  If (disp = Nil) Or (screen = 0) Or (_window = 0) Or (_format = Nil) Or (x = 0) Or
-     (y = 0) Or (w = 0) Or (h = 0) Then;
-End;
-
-Procedure TX11DGADisplay.close;
-
-Begin
-  If m_indirect Then
-  Begin
-    m_indirect := False;
-    XF86DGADirectVideo(m_disp, m_screen, 0);
-  End;
-  
-//  Writeln('lala1');
-  If m_inmode Then
-  Begin
-    m_inmode := False;
-    XF86VidModeSwitchToMode(m_disp, m_screen, modeinfo[previousmode]);
-    XUngrabKeyboard(m_disp, CurrentTime);
-    XUngrabPointer(m_disp, CurrentTime);
-  End;
-  
-//  Writeln('lala2');
-  If m_disp <> Nil Then
-    XFlush(m_disp);
-//  Writeln('lala3');
-
-  If m_cmap <> 0 Then
-  Begin
-    XFreeColormap(m_disp, m_cmap);
-    m_cmap := 0;
-  End;
-  
-//  Writeln('lala4');
-  FreeMemAndNil(m_colours);
-  
-//  Writeln('lala5');
-  If modeinfo <> Nil Then
-  Begin
-    XFree(modeinfo);
-    modeinfo := Nil;
-  End;
-//  Writeln('lala6');
-End;
-
-Procedure TX11DGADisplay.update;
-
-Begin
-End;
-
-Procedure TX11DGADisplay.update(Const _area : TPTCArea);
-
-Begin
-End;
-
-Procedure TX11DGADisplay.HandleEvents;
-
-Var
-  e : TXEvent;
-  NewFocus : Boolean;
-  NewFocusSpecified : Boolean;
-
-  Function UsefulEventsPending : Boolean;
-  
-  Var
-    tmpEvent : TXEvent;
-  
-  Begin
-    If XCheckTypedEvent(m_disp, ClientMessage, @tmpEvent) Then
-    Begin
-      Result := True;
-      XPutBackEvent(m_disp, @tmpEvent);
-      Exit;
-    End;
-    
-    If XCheckMaskEvent(m_disp, FocusChangeMask Or
-                       KeyPressMask Or KeyReleaseMask Or
-		       ButtonPressMask Or ButtonReleaseMask Or
-		       PointerMotionMask Or ExposureMask, @tmpEvent) Then
-    Begin
-      Result := True;
-      XPutBackEvent(m_disp, @tmpEvent);
-      Exit;
-    End;
-    
-    Result := False;
-  End;
-
-  Procedure HandleKeyEvent;
-  
-  Var
-    sym : TKeySym;
-    sym_modded : TKeySym; { modifiers like shift are taken into account here }
-    press : Boolean;
-    alt, shift, ctrl : Boolean;
-    uni : Integer;
-    key : TPTCKeyEvent;
-    buf : Array[1..16] Of Char;
-  
-  Begin
-    sym := XLookupKeySym(@e.xkey, 0);
-    XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil);
-    uni := X11ConvertKeySymToUnicode(sym_modded);
-    alt := (e.xkey.state And Mod1Mask) <> 0;
-    shift := (e.xkey.state And ShiftMask) <> 0;
-    ctrl := (e.xkey.state And ControlMask) <> 0;
-    If e._type = KeyPress Then
-      press := True
-    Else
-      press := False;
-
-    key := Nil;
-    Case sym Shr 8 Of
-      0 : key := TPTCKeyEvent.Create(m_normalkeys[sym And $FF], uni, alt, shift, ctrl, press);
-      $FF : key := TPTCKeyEvent.Create(m_functionkeys[sym And $FF], uni, alt, shift, ctrl, press);
-      Else
-        key := TPTCKeyEvent.Create;
-    End;
-    FEventQueue.AddEvent(key);
-  End;
-
-Begin
-  NewFocusSpecified := False;
-  While UsefulEventsPending Do
-  Begin
-    XNextEvent(m_disp, @e);
-    Case e._type Of
-      FocusIn : Begin
-        NewFocus := True;
-	NewFocusSpecified := True;
-      End;
-      FocusOut : Begin
-        NewFocus := False;
-	NewFocusSpecified := True;
-      End;
-      ClientMessage : Begin
-{        If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then
-          Halt(0);}
-      End;
-      Expose : Begin
-        {...}
-      End;
-      KeyPress, KeyRelease : HandleKeyEvent;
-      ButtonPress, ButtonRelease : Begin
-        {...}
-      End;
-      MotionNotify : Begin
-        {...}
-      End;
-    End;
-  End;
-//  HandleChangeFocus(NewFocus);
-End;
-
-Function TX11DGADisplay.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean;
-
-Var
-  tmpEvent : TXEvent;
-
-Begin
-  FreeAndNil(event);
-  Repeat
-    { process all events from the X queue and put them on our FEventQueue }
-    HandleEvents;
-    
-    { try to find an event that matches the EventMask }
-    event := FEventQueue.NextEvent(EventMask);
-    
-    If wait And (event = Nil) Then
-    Begin
-      { if the X event queue is empty, block until an event is received }
-      XPeekEvent(m_disp, @tmpEvent);
-    End;
-  Until (Not Wait) Or (event <> Nil);
-  Result := event <> Nil;
-End;
-
-Function TX11DGADisplay.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent;
-
-Var
-  tmpEvent : TXEvent;
-
-Begin
-  Repeat
-    { process all events from the X queue and put them on our FEventQueue }
-    HandleEvents;
-    
-    { try to find an event that matches the EventMask }
-    Result := FEventQueue.PeekEvent(EventMask);
-    
-    If wait And (Result = Nil) Then
-    Begin
-      { if the X event queue is empty, block until an event is received }
-      XPeekEvent(m_disp, @tmpEvent);
-    End;
-  Until (Not Wait) Or (Result <> Nil);
-End;
-
-
-Function TX11DGADisplay.lock : Pointer;
-
-Begin
-  lock := dga_addr + dga_linewidth * m_desty * (m_format.bits Div 8) +
-                     m_destx * (m_format.bits Div 8);
-End;
-
-Procedure TX11DGADisplay.unlock;
-
-Begin
-End;
-
-Procedure TX11DGADisplay.palette(Const _palette : TPTCPalette);
-
-Var
-  pal : PUint32;
-  i : Integer;
-
-Begin
-  pal := _palette.data;
-  If Not m_format.indexed Then
-    Exit;
-  For i := 0 To 255 Do
-  Begin
-    m_colours[i].pixel := i;
-
-    m_colours[i].red := ((pal[i] Shr 16) And $FF) Shl 8;
-    m_colours[i].green := ((pal[i] Shr 8) And $FF) Shl 8;
-    m_colours[i].blue := (pal[i] And $FF) Shl 8;
-
-    Byte(m_colours[i].flags) := DoRed Or DoGreen Or DoBlue;
-  End;
-  XStoreColors(m_disp, m_cmap, m_colours, 256);
-  XF86DGAInstallColormap(m_disp, m_screen, m_cmap);
-End;
-
-Function TX11DGADisplay.pitch : Integer;
-
-Begin
-  pitch := dga_linewidth * (m_format.bits Div 8);
-End;
-
-Function TX11DGADisplay.getX11Window : TWindow;
-
-Begin
-  Result := DefaultRootWindow(m_disp);
-End;
-
-Function TX11DGADisplay.isFullScreen : Boolean;
-
-Begin
-  { DGA is always fullscreen }
-  Result := True;
-End;
-
-Procedure TX11DGADisplay.SetCursor(visible : Boolean);
-
-Begin
-  {nothing... raise exception if visible=true?}
-End;

packages/sdl/src/powersdl.inc

@@ -109,6 +109,7 @@ function SDL_GetCursor : pSDL_Cursor; syscall basesysv PowerSDLBase 646;
 procedure SDL_FreeCursor(cursor : pSDL_Cursor); syscall basesysv PowerSDLBase 652;
 function SDL_ShowCursor(toggle : LongInt) : LongInt; syscall basesysv PowerSDLBase 658;
 function SDL_GetAppState : Byte; syscall basesysv PowerSDLBase 664;
+procedure SDL_SetError(fmt: PChar); syscall basesysv PowerSDLBase 670;
 function SDL_GetError : pChar; syscall basesysv PowerSDLBase 676;
 procedure SDL_ClearError; syscall basesysv PowerSDLBase 682;
 function SDL_AudioInit(const driver_name : pChar) : LongInt; syscall basesysv PowerSDLBase 688;

packages/sdl/src/powersdl_gfx.inc

@@ -0,0 +1,117 @@
+var PowerSDLGfxBase : pLibrary;
+
+const
+    POWERSDL_GFXNAME : PChar = 'powersdl_gfx.library';
+
+
+procedure SDL_initFramerate(manager : pFPSmanager); syscall r12base PowerSDLGfxBase 028;
+function SDL_setFramerate(manager : pFPSmanager; rate : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 034;
+function SDL_getFramerate(manager : pFPSmanager) : LongInt; syscall r12base PowerSDLGfxBase 040;
+procedure SDL_framerateDelay(manager : pFPSmanager); syscall r12base PowerSDLGfxBase 046;
+function pixelColor(dst : pSDL_Surface; x : Integer; y : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 052;
+function pixelRGBA(dst : pSDL_Surface; x : Integer; y : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 058;
+function hlineColor(dst : pSDL_Surface; x1 : Integer; x2 : Integer; y : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 064;
+function hlineRGBA(dst : pSDL_Surface; x1 : Integer; x2 : Integer; y : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 070;
+function vlineColor(dst : pSDL_Surface; x : Integer; y1 : Integer; y2 : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 076;
+function vlineRGBA(dst : pSDL_Surface; x : Integer; y1 : Integer; y2 : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 082;
+function rectangleColor(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 088;
+function rectangleRGBA(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 094;
+function boxColor(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 100;
+function boxRGBA(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 106;
+function lineColor(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 112;
+function lineRGBA(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 118;
+function aalineColor(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 124;
+function aalineRGBA(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 130;
+function circleColor(dst : pSDL_Surface; x : Integer; y : Integer; r : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 136;
+function circleRGBA(dst : pSDL_Surface; x : Integer; y : Integer; rad : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 142;
+function aacircleColor(dst : pSDL_Surface; x : Integer; y : Integer; r : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 148;
+function aacircleRGBA(dst : pSDL_Surface; x : Integer; y : Integer; rad : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 154;
+function filledCircleColor(dst : pSDL_Surface; x : Integer; y : Integer; r : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 160;
+function filledCircleRGBA(dst : pSDL_Surface; x : Integer; y : Integer; rad : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 166;
+function ellipseColor(dst : pSDL_Surface; x : Integer; y : Integer; rx : Integer; ry : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 172;
+function ellipseRGBA(dst : pSDL_Surface; x : Integer; y : Integer; rx : Integer; ry : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 178;
+function aaellipseColor(dst : pSDL_Surface; xc : Integer; yc : Integer; rx : Integer; ry : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 184;
+function aaellipseRGBA(dst : pSDL_Surface; x : Integer; y : Integer; rx : Integer; ry : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 190;
+function filledEllipseColor(dst : pSDL_Surface; x : Integer; y : Integer; rx : Integer; ry : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 196;
+function filledEllipseRGBA(dst : pSDL_Surface; x : Integer; y : Integer; rx : Integer; ry : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 202;
+function pieColor(dst : pSDL_Surface; x : Integer; y : Integer; rad : Integer; start : Integer; _end : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 208;
+function pieRGBA(dst : pSDL_Surface; x : Integer; y : Integer; rad : Integer; start : Integer; _end : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 214;
+function filledPieColor(dst : pSDL_Surface; x : Integer; y : Integer; rad : Integer; start : Integer; _end : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 220;
+function filledPieRGBA(dst : pSDL_Surface; x : Integer; y : Integer; rad : Integer; start : Integer; _end : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 226;
+function trigonColor(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; x3 : Integer; y3 : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 232;
+function trigonRGBA(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; x3 : Integer; y3 : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 238;
+function aatrigonColor(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; x3 : Integer; y3 : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 244;
+function aatrigonRGBA(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; x3 : Integer; y3 : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 250;
+function filledTrigonColor(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; x3 : Integer; y3 : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 256;
+function filledTrigonRGBA(dst : pSDL_Surface; x1 : Integer; y1 : Integer; x2 : Integer; y2 : Integer; x3 : Integer; y3 : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 262;
+function polygonColor(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 268;
+function polygonRGBA(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 274;
+function aapolygonColor(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 280;
+function aapolygonRGBA(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 286;
+function filledPolygonColor(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 292;
+function filledPolygonRGBA(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 298;
+function bezierColor(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; s : LongInt; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 304;
+function bezierRGBA(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; s : LongInt; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 310;
+function characterColor(dst : pSDL_Surface; x : Integer; y : Integer; c : ShortInt; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 316;
+function characterRGBA(dst : pSDL_Surface; x : Integer; y : Integer; c : ShortInt; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 322;
+function stringColor(dst : pSDL_Surface; x : Integer; y : Integer; const c : pChar; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 328;
+function stringRGBA(dst : pSDL_Surface; x : Integer; y : Integer; const c : pChar; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 334;
+procedure gfxPrimitivesSetFont(const fontdata : Pointer; cw : LongInt; ch : LongInt); syscall r12base PowerSDLGfxBase 340;
+function SDL_imageFilterMMXdetect : LongInt; syscall r12base PowerSDLGfxBase 346;
+procedure SDL_imageFilterMMXoff; syscall r12base PowerSDLGfxBase 352;
+procedure SDL_imageFilterMMXon; syscall r12base PowerSDLGfxBase 358;
+function SDL_imageFilterAdd(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 364;
+function SDL_imageFilterMean(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 370;
+function SDL_imageFilterSub(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 376;
+function SDL_imageFilterAbsDiff(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 382;
+function SDL_imageFilterMult(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 388;
+function SDL_imageFilterMultNor(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 394;
+function SDL_imageFilterMultDivby2(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 400;
+function SDL_imageFilterMultDivby4(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 406;
+function SDL_imageFilterBitAnd(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 412;
+function SDL_imageFilterBitOr(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 418;
+function SDL_imageFilterDiv(Src1 : pChar; Src2 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 424;
+function SDL_imageFilterBitNegation(Src1 : pChar; Dest : pChar; length : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 430;
+function SDL_imageFilterAddByte(Src1 : pChar; Dest : pChar; length : LongInt; C : Byte) : LongInt; syscall r12base PowerSDLGfxBase 436;
+function SDL_imageFilterAddByteToHalf(Src1 : pChar; Dest : pChar; length : LongInt; C : Byte) : LongInt; syscall r12base PowerSDLGfxBase 442;
+function SDL_imageFilterSubByte(Src1 : pChar; Dest : pChar; length : LongInt; C : Byte) : LongInt; syscall r12base PowerSDLGfxBase 448;
+function SDL_imageFilterShiftRight(Src1 : pChar; Dest : pChar; length : LongInt; N : Byte) : LongInt; syscall r12base PowerSDLGfxBase 454;
+function SDL_imageFilterMultByByte(Src1 : pChar; Dest : pChar; length : LongInt; C : Byte) : LongInt; syscall r12base PowerSDLGfxBase 460;
+function SDL_imageFilterShiftRightAndMultByByte(Src1 : pChar; Dest : pChar; length : LongInt; N : Byte; C : Byte) : LongInt; syscall r12base PowerSDLGfxBase 466;
+function SDL_imageFilterShiftLeftByte(Src1 : pChar; Dest : pChar; length : LongInt; N : Byte) : LongInt; syscall r12base PowerSDLGfxBase 472;
+function SDL_imageFilterShiftLeft(Src1 : pChar; Dest : pChar; length : LongInt; N : Byte) : LongInt; syscall r12base PowerSDLGfxBase 478;
+function SDL_imageFilterBinarizeUsingThreshold(Src1 : pChar; Dest : pChar; length : LongInt; T : Byte) : LongInt; syscall r12base PowerSDLGfxBase 484;
+function SDL_imageFilterClipToRange(Src1 : pChar; Dest : pChar; length : LongInt; Tmin : Byte; Tmax : Byte) : LongInt; syscall r12base PowerSDLGfxBase 490;
+function SDL_imageFilterNormalizeLinear(Src1 : pChar; Dest : pChar; length : LongInt; Cmin : LongInt; Cmax : LongInt; Nmin : LongInt; Nmax : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 496;
+function SDL_imageFilterConvolveKernel3x3Divide(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt; var Kernel : Integer; Divisor : Byte) : LongInt; syscall r12base PowerSDLGfxBase 502;
+function SDL_imageFilterConvolveKernel5x5Divide(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt; var Kernel : Integer; Divisor : Byte) : LongInt; syscall r12base PowerSDLGfxBase 508;
+function SDL_imageFilterConvolveKernel7x7Divide(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt; var Kernel : Integer; Divisor : Byte) : LongInt; syscall r12base PowerSDLGfxBase 514;
+function SDL_imageFilterConvolveKernel9x9Divide(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt; var Kernel : Integer; Divisor : Byte) : LongInt; syscall r12base PowerSDLGfxBase 520;
+function SDL_imageFilterConvolveKernel3x3ShiftRight(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt; var Kernel : Integer; NRightShift : Byte) : LongInt; syscall r12base PowerSDLGfxBase 526;
+function SDL_imageFilterConvolveKernel5x5ShiftRight(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt; var Kernel : Integer; NRightShift : Byte) : LongInt; syscall r12base PowerSDLGfxBase 532;
+function SDL_imageFilterConvolveKernel7x7ShiftRight(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt; var Kernel : Integer; NRightShift : Byte) : LongInt; syscall r12base PowerSDLGfxBase 538;
+function SDL_imageFilterConvolveKernel9x9ShiftRight(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt; var Kernel : Integer; NRightShift : Byte) : LongInt; syscall r12base PowerSDLGfxBase 544;
+function SDL_imageFilterSobelX(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 550;
+function SDL_imageFilterSobelXShiftRight(Src : pChar; Dest : pChar; rows : LongInt; columns : LongInt; NRightShift : Byte) : LongInt; syscall r12base PowerSDLGfxBase 556;
+procedure SDL_imageFilterAlignStack; syscall r12base PowerSDLGfxBase 562;
+procedure SDL_imageFilterRestoreStack; syscall r12base PowerSDLGfxBase 568;
+function rotozoomSurface(src : pSDL_Surface; angle : LongInt; zoom : LongInt; smooth : LongInt) : pSDL_Surface; syscall r12base PowerSDLGfxBase 574;
+procedure rotozoomSurfaceSize(width : LongInt; height : LongInt; angle : LongInt; zoom : LongInt; dstwidth : pLongInt; dstheight : pLongInt); syscall r12base PowerSDLGfxBase 580;
+function zoomSurface(src : pSDL_Surface; zoomx : LongInt; zoomy : LongInt; smooth : LongInt) : pSDL_Surface; syscall r12base PowerSDLGfxBase 586;
+procedure zoomSurfaceSize(width : LongInt; height : LongInt; zoomx : LongInt; zoomy : LongInt; dstwidth : pLongInt; dstheight : pLongInt); syscall r12base PowerSDLGfxBase 592;
+function SDL_imageFilterAddUint(Src1 : pChar; Dest : pChar; length : LongInt; C : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 598;
+function SDL_imageFilterSubUint(Src1 : pChar; Dest : pChar; length : LongInt; C : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 604;
+function SDL_imageFilterShiftRightUint(Src1 : pChar; Dest : pChar; length : LongInt; N : Byte) : LongInt; syscall r12base PowerSDLGfxBase 610;
+function SDL_imageFilterShiftLeftUint(Src1 : pChar; Dest : pChar; length : LongInt; N : Byte) : LongInt; syscall r12base PowerSDLGfxBase 616;
+function rotozoomSurfaceXY(src : pSDL_Surface; angle : LongInt; zoomx : LongInt; zoomy : LongInt; smooth : LongInt) : pSDL_Surface; syscall r12base PowerSDLGfxBase 622;
+procedure rotozoomSurfaceSizeXY(width : LongInt; height : LongInt; angle : LongInt; zoomx : LongInt; zoomy : LongInt; dstwidth : pLongInt; dstheight : pLongInt); syscall r12base PowerSDLGfxBase 628;
+function texturedPolygon(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; texture : pSDL_Surface; texture_dx : LongInt; texture_dy : LongInt) : LongInt; syscall r12base PowerSDLGfxBase 634;
+function shrinkSurface(src : pSDL_Surface; factorx : LongInt; factory : LongInt) : pSDL_Surface; syscall r12base PowerSDLGfxBase 640;
+function SDL_gfxBlitRGBA(src : pSDL_Surface; srcrect : pSDL_Rect; dst : pSDL_Surface; dstrect : pSDL_Rect) : LongInt; syscall r12base PowerSDLGfxBase 646;
+function SDL_gfxSetAlpha(src : pSDL_Surface; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 652;
+function arcColor(dst : pSDL_Surface; x : Integer; y : Integer; r : Integer; start : Integer; _end : Integer; color : DWord) : LongInt; syscall r12base PowerSDLGfxBase 658;
+function arcRGBA(dst : pSDL_Surface; x : Integer; y : Integer; rad : Integer; start : Integer; _end : Integer; r : Byte; g : Byte; b : Byte; a : Byte) : LongInt; syscall r12base PowerSDLGfxBase 664;
+function filledPolygonColorMT(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; color : DWord; var polyInts : pLongInt; polyAllocated : pLongInt) : LongInt; syscall r12base PowerSDLGfxBase 670;
+function filledPolygonRGBAMT(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; r : Byte; g : Byte; b : Byte; a : Byte; var polyInts : pLongInt; polyAllocated : pLongInt) : LongInt; syscall r12base PowerSDLGfxBase 676;
+function texturedPolygonMT(dst : pSDL_Surface; var vx : Integer; var vy : Integer; n : LongInt; texture : pSDL_Surface; texture_dx : LongInt; texture_dy : LongInt; var polyInts : pLongInt; polyAllocated : pLongInt) : LongInt; syscall r12base PowerSDLGfxBase 682;
+function rotateSurface90Degrees(pSurf : pSDL_Surface; numClockwiseTurns : LongInt) : pSDL_Surface; syscall r12base PowerSDLGfxBase 688;

packages/sdl/src/powersdl_image.inc

@@ -0,0 +1,35 @@
+
+var PowerSDLImageBase : pLibrary;
+
+const
+    POWERSDL_IMAGENAME : PChar = 'powersdl_image.library';
+
+function IMG_LoadTyped_RW(src : pSDL_RWops; freesrc : LongInt; type_ : pChar) : pSDL_Surface; syscall r12base PowerSDLImageBase 028;
+function IMG_Load(const file_ : pChar) : pSDL_Surface; syscall r12base PowerSDLImageBase 034;
+function IMG_Load_RW(src : pSDL_RWops; freesrc : LongInt) : pSDL_Surface; syscall r12base PowerSDLImageBase 040;
+function IMG_InvertAlpha(on : LongInt) : LongInt; syscall r12base PowerSDLImageBase 046;
+function IMG_isBMP(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 052;
+function IMG_isPNM(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 058;
+function IMG_isXPM(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 064;
+function IMG_isXCF(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 070;
+function IMG_isPCX(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 076;
+function IMG_isGIF(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 082;
+function IMG_isJPG(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 088;
+function IMG_isTIF(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 094;
+function IMG_isPNG(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 100;
+function IMG_isLBM(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 106;
+function IMG_LoadBMP_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 112;
+function IMG_LoadPNM_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 118;
+function IMG_LoadXPM_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 124;
+function IMG_LoadXCF_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 130;
+function IMG_LoadPCX_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 136;
+function IMG_LoadGIF_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 142;
+function IMG_LoadJPG_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 148;
+function IMG_LoadTIF_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 154;
+function IMG_LoadPNG_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 160;
+function IMG_LoadTGA_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 166;
+function IMG_LoadLBM_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 172;
+function IMG_ReadXPMFromArray(var xpm : pShortInt) : pSDL_Surface; syscall r12base PowerSDLImageBase 178;
+function IMG_Linked_Version : pSDL_version; syscall r12base PowerSDLImageBase 184;
+function IMG_isXV(src : pSDL_RWops) : LongInt; syscall r12base PowerSDLImageBase 190;
+function IMG_LoadXV_RW(src : pSDL_RWops) : pSDL_Surface; syscall r12base PowerSDLImageBase 196;

packages/sdl/src/powersdl_mixer.inc

@@ -0,0 +1,69 @@
+
+var PowerSDLMixerBase : pLibrary;
+
+const
+    POWERSDL_MIXERNAME : PChar = 'powersdl_mixer.library';
+
+function Mix_OpenAudio(frequency : LongInt; format : Word; channels : LongInt; chunksize : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 028;
+function Mix_AllocateChannels(numchans : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 034;
+function Mix_QuerySpec(frequency : pLongInt; var format : Word; channels : pLongInt) : LongInt; syscall r12base PowerSDLMixerBase 040;
+function Mix_LoadWAV_RW(src : pSDL_RWops; freesrc : LongInt) : pMix_Chunk; syscall r12base PowerSDLMixerBase 046;
+function Mix_LoadMUS(const file_ : pChar) : pMix_Music; syscall r12base PowerSDLMixerBase 052;
+function Mix_LoadMUS_RW(rw : pSDL_RWops) : pMix_Music; syscall r12base PowerSDLMixerBase 058;
+function Mix_QuickLoad_WAV(mem : pChar) : pMix_Chunk; syscall r12base PowerSDLMixerBase 064;
+function Mix_QuickLoad_RAW(mem : pChar; len : DWord) : pMix_Chunk; syscall r12base PowerSDLMixerBase 070;
+procedure Mix_FreeChunk(chunk : pMix_Chunk); syscall r12base PowerSDLMixerBase 076;
+procedure Mix_FreeMusic(music : pMix_Music); syscall r12base PowerSDLMixerBase 082;
+function Mix_GetMusicType(const music : pMix_Music) : LongInt; syscall r12base PowerSDLMixerBase 088;
+procedure Mix_SetPostMix(mix_func : TProcedure; arg : Pointer); syscall r12base PowerSDLMixerBase 094;
+procedure Mix_HookMusic(mix_func : TProcedure; arg : Pointer); syscall r12base PowerSDLMixerBase 100;
+procedure Mix_HookMusicFinished(music_finished : TProcedure); syscall r12base PowerSDLMixerBase 106;
+function Mix_GetMusicHookData : Pointer; syscall r12base PowerSDLMixerBase 112;
+procedure Mix_ChannelFinished(channel_finished : TProcedure); syscall r12base PowerSDLMixerBase 118;
+function Mix_RegisterEffect(chan : LongInt; f : TProcedure; d : TProcedure; arg : Pointer) : LongInt; syscall r12base PowerSDLMixerBase 124;
+function Mix_UnregisterEffect(channel : LongInt; f : TProcedure) : LongInt; syscall r12base PowerSDLMixerBase 130;
+function Mix_UnregisterAllEffects(channel : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 136;
+function Mix_SetPanning(channel : LongInt; left : Byte; right : Byte) : LongInt; syscall r12base PowerSDLMixerBase 142;
+function Mix_SetPosition(channel : LongInt; angle : Integer; distance : Byte) : LongInt; syscall r12base PowerSDLMixerBase 148;
+function Mix_SetDistance(channel : LongInt; distance : Byte) : LongInt; syscall r12base PowerSDLMixerBase 154;
+function Mix_SetReverseStereo(channel : LongInt; flip : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 166;
+function Mix_ReserveChannels(num : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 172;
+function Mix_GroupChannel(which : LongInt; mtag : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 178;
+function Mix_GroupChannels(from : LongInt; _to : LongInt; mtag : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 184;
+function Mix_GroupAvailable(mtag : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 190;
+function Mix_GroupCount(mtag : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 196;
+function Mix_GroupOldest(mtag : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 202;
+function Mix_GroupNewer(mtag : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 208;
+function Mix_PlayChannelTimed(channel : LongInt; chunk : pMix_Chunk; loops : LongInt; ticks : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 214;
+function Mix_PlayMusic(music : pMix_Music; loops : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 220;
+function Mix_FadeInMusic(music : pMix_Music; loops : LongInt; ms : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 226;
+function Mix_FadeInMusicPos(music : pMix_Music; loops : LongInt; ms : LongInt; position : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 232;
+function Mix_FadeInChannelTimed(channel : LongInt; chunk : pMix_Chunk; loops : LongInt; ms : LongInt; ticks : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 238;
+function Mix_Volume(channel : LongInt; volume : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 244;
+function Mix_VolumeChunk(chunk : pMix_Chunk; volume : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 250;
+function Mix_VolumeMusic(volume : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 256;
+function Mix_HaltChannel(channel : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 262;
+function Mix_HaltGroup(mtag : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 268;
+function Mix_HaltMusic : LongInt; syscall r12base PowerSDLMixerBase 274;
+function Mix_ExpireChannel(channel : LongInt; ticks : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 280;
+function Mix_FadeOutChannel(which : LongInt; ms : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 286;
+function Mix_FadeOutGroup(mtag : LongInt; ms : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 292;
+function Mix_FadeOutMusic(ms : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 298;
+function Mix_FadingMusic : LongInt; syscall r12base PowerSDLMixerBase 304;
+function Mix_FadingChannel(which : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 310;
+procedure Mix_Pause(channel : LongInt); syscall r12base PowerSDLMixerBase 316;
+procedure Mix_Resume(channel : LongInt); syscall r12base PowerSDLMixerBase 322;
+function Mix_Paused(channel : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 328;
+procedure Mix_PauseMusic; syscall r12base PowerSDLMixerBase 334;
+procedure Mix_ResumeMusic; syscall r12base PowerSDLMixerBase 340;
+procedure Mix_RewindMusic; syscall r12base PowerSDLMixerBase 346;
+function Mix_PausedMusic : LongInt; syscall r12base PowerSDLMixerBase 352;
+function Mix_SetMusicPosition(position : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 358;
+function Mix_Playing(channel : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 364;
+function Mix_PlayingMusic : LongInt; syscall r12base PowerSDLMixerBase 370;
+function Mix_SetMusicCMD(const command : pChar) : LongInt; syscall r12base PowerSDLMixerBase 376;
+function Mix_SetSynchroValue(value : LongInt) : LongInt; syscall r12base PowerSDLMixerBase 382;
+function Mix_GetSynchroValue : LongInt; syscall r12base PowerSDLMixerBase 388;
+function Mix_GetChunk(channel : LongInt) : pMix_Chunk; syscall r12base PowerSDLMixerBase 394;
+procedure Mix_CloseAudio; syscall r12base PowerSDLMixerBase 400;
+function Mix_Linked_Version : pSDL_version; syscall r12base PowerSDLMixerBase 406;

packages/sdl/src/powersdl_net.inc

@@ -0,0 +1,37 @@
+
+var PowerSDLNetBase : pLibrary;
+
+const
+    POWERSDL_NETNAME : PChar = 'powersdl_net.library';
+
+
+function SDLNet_Init : LongInt; syscall r12base PowerSDLNetBase 028;
+procedure SDLNet_Quit; syscall r12base PowerSDLNetBase 034;
+function SDLNet_ResolveHost(address : pIPaddress; const host : pChar; port : Word) : LongInt; syscall r12base PowerSDLNetBase 040;
+function SDLNet_ResolveIP(ip : pIPaddress) : pChar; syscall r12base PowerSDLNetBase 046;
+function SDLNet_TCP_Open(ip : pIPaddress) : Pointer; syscall r12base PowerSDLNetBase 052;
+function SDLNet_TCP_Accept(server : Pointer) : Pointer; syscall r12base PowerSDLNetBase 058;
+function SDLNet_TCP_GetPeerAddress(sock : Pointer) : pIPaddress; syscall r12base PowerSDLNetBase 064;
+function SDLNet_TCP_Send(sock : Pointer; const data : Pointer; len : LongInt) : LongInt; syscall r12base PowerSDLNetBase 070;
+function SDLNet_TCP_Recv(sock : Pointer; data : Pointer; maxlen : LongInt) : LongInt; syscall r12base PowerSDLNetBase 076;
+procedure SDLNet_TCP_Close(sock : Pointer); syscall r12base PowerSDLNetBase 082;
+function SDLNet_AllocPacket(size : LongInt) : pUDPpacket; syscall r12base PowerSDLNetBase 088;
+function SDLNet_ResizePacket(packet : pUDPpacket; newsize : LongInt) : LongInt; syscall r12base PowerSDLNetBase 094;
+procedure SDLNet_FreePacket(packet : pUDPpacket); syscall r12base PowerSDLNetBase 100;
+function SDLNet_AllocPacketV(howmany : LongInt; size : LongInt) : ppUDPpacket; syscall r12base PowerSDLNetBase 106;
+procedure SDLNet_FreePacketV(var packetV : pUDPpacket); syscall r12base PowerSDLNetBase 112;
+function SDLNet_UDP_Open(port : Word) : Pointer; syscall r12base PowerSDLNetBase 118;
+function SDLNet_UDP_Bind(sock : Pointer; channel : LongInt; address : pIPaddress) : LongInt; syscall r12base PowerSDLNetBase 124;
+procedure SDLNet_UDP_Unbind(sock : Pointer; channel : LongInt); syscall r12base PowerSDLNetBase 130;
+function SDLNet_UDP_GetPeerAddress(sock : Pointer; channel : LongInt) : pIPaddress; syscall r12base PowerSDLNetBase 136;
+function SDLNet_UDP_SendV(sock : Pointer; var packets : pUDPpacket; npackets : LongInt) : LongInt; syscall r12base PowerSDLNetBase 142;
+function SDLNet_UDP_Send(sock : Pointer; channel : LongInt; packet : pUDPpacket) : LongInt; syscall r12base PowerSDLNetBase 148;
+function SDLNet_UDP_RecvV(sock : Pointer; var packets : pUDPpacket) : LongInt; syscall r12base PowerSDLNetBase 154;
+function SDLNet_UDP_Recv(sock : Pointer; packet : pUDPpacket) : LongInt; syscall r12base PowerSDLNetBase 160;
+procedure SDLNet_UDP_Close(sock : Pointer); syscall r12base PowerSDLNetBase 166;
+function SDLNet_AllocSocketSet(maxsockets : LongInt) : Pointer; syscall r12base PowerSDLNetBase 172;
+function SDLNet_AddSocket(set_ : Pointer; sock : Pointer) : LongInt; syscall r12base PowerSDLNetBase 178;
+function SDLNet_DelSocket(set_ : Pointer; sock : Pointer) : LongInt; syscall r12base PowerSDLNetBase 184;
+function SDLNet_CheckSockets(set_ : Pointer; timeout : DWord) : LongInt; syscall r12base PowerSDLNetBase 190;
+procedure SDLNet_FreeSocketSet(set_ : Pointer); syscall r12base PowerSDLNetBase 196;
+function SDLNet_Linked_Version : pSDL_version; syscall r12base PowerSDLNetBase 202;

packages/sdl/src/powersdl_smpeg.inc

@@ -0,0 +1,34 @@
+var SMPEGBase : pLibrary;
+
+const
+    SMPEGNAME : PChar = 'smpeg.library';
+
+function SMPEG_new(const _file: PChar; info: PSMPEG_Info; sdl_audio: Integer): PSMPEG; syscall r12base SMPEGBase 28;
+function SMPEG_new_descr(_file: Integer; info: PSMPEG_Info; sdl_audio: Integer): PSMPEG; syscall r12base SMPEGBase 34;
+function SMPEG_new_data(data: Pointer; size: Integer; info: PSMPEG_Info; sdl_audio: Integer): PSMPEG; syscall r12base SMPEGBase 40;
+procedure SMPEG_getinfo(mpeg: PSMPEG; info: PSMPEG_Info); syscall r12base SMPEGBase 52;
+procedure SMPEG_enableaudio(mpeg: PSMPEG; enable: Integer); syscall r12base SMPEGBase 58;
+procedure SMPEG_enablevideo(mpeg: PSMPEG; enable: Integer); syscall r12base SMPEGBase 64;
+procedure SMPEG_delete(mpeg: PSMPEG); syscall r12base SMPEGBase 70;
+function SMPEG_status(mpeg: PSMPEG): TSMPEGstatus; syscall r12base SMPEGBase 76;
+procedure SMPEG_setvolume(mpeg: PSMPEG; volume: Integer); syscall r12base SMPEGBase 82;
+procedure SMPEG_setdisplay(mpeg: PSMPEG; dst: PSDL_Surface; surfLock: PSDL_mutex; callback: TSMPEG_DisplayCallback); syscall r12base SMPEGBase 88;
+procedure SMPEG_loop(mpeg: PSMPEG; _repeat: Integer); syscall r12base SMPEGBase 94;
+procedure SMPEG_scaleXY(mpeg: PSMPEG; width, height: Integer); syscall r12base SMPEGBase 100;
+procedure SMPEG_scale(mpeg: PSMPEG; scale: Integer); syscall r12base SMPEGBase 106;
+procedure SMPEG_move(mpeg: PSMPEG; x, y: Integer); syscall r12base SMPEGBase 112;
+procedure SMPEG_setdisplayregion(mpeg: PSMPEG; x, y, w, h: Integer); syscall r12base SMPEGBase 118;
+procedure SMPEG_play(mpeg: PSMPEG); syscall r12base SMPEGBase 124;
+procedure SMPEG_pause(mpeg: PSMPEG); syscall r12base SMPEGBase 130;
+procedure SMPEG_stop(mpeg: PSMPEG); syscall r12base SMPEGBase 136;
+procedure SMPEG_rewind(mpeg: PSMPEG); syscall r12base SMPEGBase 142;
+procedure SMPEG_seek(mpeg: PSMPEG; bytes: Integer); syscall r12base SMPEGBase 148;
+procedure SMPEG_skip(mpeg: PSMPEG; seconds: single); syscall r12base SMPEGBase 152;
+procedure SMPEG_renderFrame(mpeg: PSMPEG; framenum: Integer); syscall r12base SMPEGBase 158;
+procedure SMPEG_renderFinal(mpeg: PSMPEG; dst: PSDL_Surface; x, y: Integer); syscall r12base SMPEGBase 164;
+function SMPEG_filter(mpeg: PSMPEG; filter: PSMPEG_Filter): PSMPEG_Filter; syscall r12base SMPEGBase 172;
+function SMPEG_error(mpeg: PSMPEG): PChar; syscall r12base SMPEGBase 178;
+function SMPEG_playAudio(mpeg: PSMPEG; stream: PUInt8; len: Integer): Integer; syscall r12base SMPEGBase 184;
+procedure SMPEG_playAudioSDL(mpeg: Pointer; stream: PUInt8; len: Integer); syscall r12base SMPEGBase 190;
+function SMPEG_wantedSpec(mpeg: PSMPEG; wanted: PSDL_AudioSpec): Integer; syscall r12base SMPEGBase 196;
+procedure SMPEG_actualSpec(mpeg: PSMPEG; spec: PSDL_AudioSpec); syscall r12base SMPEGBase 202;

packages/sdl/src/powersdl_ttf.inc

@@ -0,0 +1,42 @@
+
+var PowerSDLTTFBase : pLibrary;
+
+const
+    POWERSDL_TTFNAME : PChar = 'powersdl_ttf.library';
+
+function TTF_Linked_Version : pSDL_version; syscall r12base PowerSDLTTFBase 028;
+procedure TTF_ByteSwappedUNICODE(swapped : LongInt); syscall r12base PowerSDLTTFBase 034;
+function TTF_Init : LongInt; syscall r12base PowerSDLTTFBase 040;
+function TTF_OpenFont(const file_ : pChar; ptsize : LongInt) : pTTF_Font; syscall r12base PowerSDLTTFBase 046;
+function TTF_OpenFontIndex(const file_ : pChar; ptsize : LongInt; index : LongInt) : pTTF_Font; syscall r12base PowerSDLTTFBase 052;
+function TTF_OpenFontRW(src : pSDL_RWops; freesrc : LongInt; ptsize : LongInt) : pTTF_Font; syscall r12base PowerSDLTTFBase 058;
+function TTF_OpenFontIndexRW(src : pSDL_RWops; freesrc : LongInt; ptsize : LongInt; index : LongInt) : pTTF_Font; syscall r12base PowerSDLTTFBase 064;
+function TTF_GetFontStyle(font : pTTF_Font) : LongInt; syscall r12base PowerSDLTTFBase 070;
+procedure TTF_SetFontStyle(font : pTTF_Font; style : LongInt); syscall r12base PowerSDLTTFBase 076;
+function TTF_FontHeight(font : pTTF_Font) : LongInt; syscall r12base PowerSDLTTFBase 082;
+function TTF_FontAscent(font : pTTF_Font) : LongInt; syscall r12base PowerSDLTTFBase 088;
+function TTF_FontDescent(font : pTTF_Font) : LongInt; syscall r12base PowerSDLTTFBase 094;
+function TTF_FontLineSkip(font : pTTF_Font) : LongInt; syscall r12base PowerSDLTTFBase 100;
+function TTF_FontFaces(font : pTTF_Font) : LongInt; syscall r12base PowerSDLTTFBase 106;
+function TTF_FontFaceIsFixedWidth(font : pTTF_Font) : LongInt; syscall r12base PowerSDLTTFBase 112;
+function TTF_FontFaceFamilyName(font : pTTF_Font) : pChar; syscall r12base PowerSDLTTFBase 118;
+function TTF_FontFaceStyleName(font : pTTF_Font) : pChar; syscall r12base PowerSDLTTFBase 124;
+function TTF_GlyphMetrics(font : pTTF_Font; ch : Word; minx : pLongInt; maxx : pLongInt; miny : pLongInt; maxy : pLongInt; advance : pLongInt) : LongInt; syscall r12base PowerSDLTTFBase 130;
+function TTF_SizeText(font : pTTF_Font; const text : pChar; w : pLongInt; h : pLongInt) : LongInt; syscall r12base PowerSDLTTFBase 136;
+function TTF_SizeUTF8(font : pTTF_Font; const text : pChar; w : pLongInt; h : pLongInt) : LongInt; syscall r12base PowerSDLTTFBase 142;
+function TTF_SizeUNICODE(font : pTTF_Font; const text : Word; w : pLongInt; h : pLongInt) : LongInt; syscall r12base PowerSDLTTFBase 148;
+function TTF_RenderText_Solid(font : pTTF_Font; const text : pChar; fg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 154;
+function TTF_RenderUTF8_Solid(font : pTTF_Font; const text : pChar; fg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 160;
+function TTF_RenderUNICODE_Solid(font : pTTF_Font; const text : Word; fg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 166;
+function TTF_RenderGlyph_Solid(font : pTTF_Font; ch : Word; fg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 172;
+function TTF_RenderText_Shaded(font : pTTF_Font; const text : pChar; fg : tSDL_Color; bg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 178;
+function TTF_RenderUTF8_Shaded(font : pTTF_Font; const text : pChar; fg : tSDL_Color; bg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 184;
+function TTF_RenderUNICODE_Shaded(font : pTTF_Font; const text : Word; fg : tSDL_Color; bg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 190;
+function TTF_RenderGlyph_Shaded(font : pTTF_Font; ch : Word; fg : tSDL_Color; bg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 196;
+function TTF_RenderText_Blended(font : pTTF_Font; const text : pChar; fg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 202;
+function TTF_RenderUTF8_Blended(font : pTTF_Font; const text : pChar; fg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 208;
+function TTF_RenderUNICODE_Blended(font : pTTF_Font; const text : Word; fg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 214;
+function TTF_RenderGlyph_Blended(font : pTTF_Font; ch : Word; fg : tSDL_Color) : pSDL_Surface; syscall r12base PowerSDLTTFBase 220;
+procedure TTF_CloseFont(font : pTTF_Font); syscall r12base PowerSDLTTFBase 226;
+procedure TTF_Quit; syscall r12base PowerSDLTTFBase 232;
+function TTF_WasInit : LongInt; syscall r12base PowerSDLTTFBase 238;

packages/sdl/src/sdl_gfx.pas

@@ -23,6 +23,9 @@ unit sdl_gfx;
 interface
 
 uses
+{$IFDEF MORPHOS}
+  exec,
+{$ENDIF}
   sdl;
 
 const
@@ -42,6 +45,10 @@ const
   SDLgfxLibName = 'SDL_gfx';
 {$ENDIF}
 
+{$IFDEF MORPHOS}
+  SDLgfxLibName = 'powersdl_gfx.library';
+{$ENDIF}
+
   // Some rates in Hz
   FPS_UPPER_LIMIT	= 200;
   FPS_LOWER_LIMIT	= 1;
@@ -77,6 +84,10 @@ type
     y :	Uint8;
   end;
 
+{$IFDEF MORPHOS}
+{$INCLUDE powersdl_gfx.inc}
+{$ELSE MORPHOS}
+
 {
 
  SDL_framerate: framerate manager
@@ -686,6 +697,8 @@ procedure zoomSurfaceSize( width : integer; height : integer; zoomx : double; zo
 cdecl; external {$IFDEF __GPC__}name 'zoomSurfaceSize'{$ELSE} SDLgfxLibName{$ENDIF __GPC__};
 {$EXTERNALSYM zoomSurfaceSize}
 
+{$ENDIF MORPHOS}
+
 implementation
 
 end.

packages/sdl/src/sdl_image.pas

@@ -136,6 +136,9 @@ interface
 uses
 {$IFDEF __GPC__}
   gpc,
+{$ENDIF}
+{$IFDEF MORPHOS}
+  exec,
 {$ENDIF}
   sdl;
 
@@ -160,6 +163,10 @@ const
   SDL_ImageLibName = 'SDL_image';
 {$ENDIF}
 
+{$IFDEF MORPHOS}
+  SDL_ImageLibName = 'powersdl_image.library';
+{$ENDIF}
+
   // Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL
   SDL_IMAGE_MAJOR_VERSION = 1;
 {$EXTERNALSYM SDL_IMAGE_MAJOR_VERSION}
@@ -168,6 +175,9 @@ const
   SDL_IMAGE_PATCHLEVEL    = 5;
 {$EXTERNALSYM SDL_IMAGE_PATCHLEVEL}
 
+{$IFDEF MORPHOS}
+{$INCLUDE powersdl_image.inc}
+{$ELSE MORPHOS}
 { This macro can be used to fill a version structure with the compile-time
   version of the SDL_image library. }
 procedure SDL_IMAGE_VERSION( var X : TSDL_Version );
@@ -305,7 +315,7 @@ function IMG_ReadXPMFromArray( xpm : PPChar ): PSDL_Surface;
 cdecl; external {$IFDEF __GPC__}name 'IMG_ReadXPMFromArray'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
 {$EXTERNALSYM IMG_ReadXPMFromArray}
 
-
+{$ENDIF MORPHOS}
 
 
 { used internally, NOT an exported function }

packages/sdl/src/sdl_mixer.pas

@@ -161,6 +161,9 @@ uses
 {$IFNDEF no_smpeg}
   smpeg,
 {$ENDIF}
+{$ENDIF}
+{$IFDEF MORPHOS}
+  exec,
 {$ENDIF}
   sdl;
 
@@ -185,6 +188,10 @@ const
   SDL_MixerLibName = 'SDL_mixer';
 {$ENDIF}
 
+{$IFDEF MACOS}
+  SDL_MixerLibName = 'powersdl_mixer.library';
+{$ENDIF}
+
   {* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *}
   SDL_MIXER_MAJOR_VERSION = 1;
 {$EXTERNALSYM MIX_MAJOR_VERSION}
@@ -478,6 +485,10 @@ type
 procedure SDL_MIXER_VERSION(var X: TSDL_Version);
 {$EXTERNALSYM SDL_MIXER_VERSION}
 
+{$IFDEF MORPHOS}
+{$INCLUDE powersdl_mixer.inc}
+{$ELSE MORPHOS}
+
 { This function gets the version of the dynamically linked SDL_mixer library.
      It should NOT be used to fill a version structure, instead you should use the
      SDL_MIXER_VERSION() macro. }
@@ -570,6 +581,8 @@ function Mix_GetMusicHookData : Pointer;
 cdecl; external {$IFDEF __GPC__}name 'Mix_GetMusicHookData'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_GetMusicHookData}
 
+{$ENDIF MORPHOS}
+
 {* Add your own callback when a channel has finished playing. NULL
  * to disable callback.*}
 type
@@ -579,10 +592,14 @@ type
   TChannel_finished = procedure( channel: Integer );
   {$ENDIF}
 
+{$IFNDEF MORPHOS}
+
 procedure Mix_ChannelFinished( channel_finished : TChannel_finished );
 cdecl; external {$IFDEF __GPC__}name 'Mix_ChannelFinished'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_ChannelFinished}
 
+{$ENDIF MORPHOS}
+
 const
   MIX_CHANNEL_POST = -2;
 
@@ -663,6 +680,9 @@ type
   * returns zero if error (no such channel), nonzero if added.
   *  Error messages can be retrieved from Mix_GetError().
   *}
+
+{$IFNDEF MORPHOS}
+
 function Mix_RegisterEffect( chan : integer; f : TMix_EffectFunc; d : TMix_EffectDone; arg : Pointer ) : integer;
 cdecl; external {$IFDEF __GPC__}name 'Mix_RegisterEffect'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_RegisterEffect}
@@ -694,9 +714,12 @@ function Mix_UnregisterAllEffects( channel : integer ) : integer;
 cdecl; external {$IFDEF __GPC__}name 'Mix_UnregisterAllEffects'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_UnregisterAllEffects}
 
+{$ENDIF MORPHOS}
+
 const
   MIX_EFFECTSMAXSPEED = 'MIX_EFFECTSMAXSPEED';
 
+{$IFNDEF MORPHOS}
   {*
   * These are the internally - defined mixing effects.They use the same API that
   * effects defined in the application use, but are provided here as a
@@ -1069,6 +1092,8 @@ procedure Mix_CloseAudio;
 cdecl; external {$IFDEF __GPC__}name 'Mix_CloseAudio'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_CloseAudio}
 
+{$ENDIF MORPHOS}
+
 { We'll use SDL for reporting errors }
 procedure Mix_SetError( fmt : PChar );
 

packages/sdl/src/sdl_mixer_nosmpeg.pas

@@ -10,6 +10,9 @@ interface
 uses
 {$IFDEF __GPC__}
   gpc,
+{$ENDIF}
+{$IFDEF MORPHOS}
+  exec,
 {$ENDIF}
   sdl;
 
@@ -34,6 +37,10 @@ const
   SDL_MixerLibName = 'SDL_mixer';
 {$ENDIF}
 
+{$IFDEF MORPHOS}
+  SDL_MixerLibName = 'powersdl_mixer.library';
+{$ENDIF}
+
   {* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *}
   SDL_MIXER_MAJOR_VERSION = 1;
 {$EXTERNALSYM MIX_MAJOR_VERSION}
@@ -323,6 +330,10 @@ type
 procedure SDL_MIXER_VERSION(var X: TSDL_Version);
 {$EXTERNALSYM SDL_MIXER_VERSION}
 
+{$IFDEF MORPHOS}
+{$INCLUDE powersdl_mixer.inc}
+{$ELSE MORPHOS}
+
 { This function gets the version of the dynamically linked SDL_mixer library.
      It should NOT be used to fill a version structure, instead you should use the
      SDL_MIXER_VERSION() macro. }
@@ -415,6 +426,8 @@ function Mix_GetMusicHookData : Pointer;
 cdecl; external {$IFDEF __GPC__}name 'Mix_GetMusicHookData'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_GetMusicHookData}
 
+{$ENDIF MORPHOS}
+
 {* Add your own callback when a channel has finished playing. NULL
  * to disable callback.*}
 type
@@ -424,10 +437,14 @@ type
   TChannel_finished = procedure( channel: Integer );
   {$ENDIF}
 
+{$IFNDEF MORPHOS}
+
 procedure Mix_ChannelFinished( channel_finished : TChannel_finished );
 cdecl; external {$IFDEF __GPC__}name 'Mix_ChannelFinished'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_ChannelFinished}
 
+{$ENDIF MORPHOS}
+
 const
   MIX_CHANNEL_POST = -2;
 
@@ -508,6 +525,8 @@ type
   * returns zero if error (no such channel), nonzero if added.
   *  Error messages can be retrieved from Mix_GetError().
   *}
+{$IFNDEF MORPHOS}
+
 function Mix_RegisterEffect( chan : integer; f : TMix_EffectFunc; d : TMix_EffectDone; arg : Pointer ) : integer;
 cdecl; external {$IFDEF __GPC__}name 'Mix_RegisterEffect'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_RegisterEffect}
@@ -539,9 +558,12 @@ function Mix_UnregisterAllEffects( channel : integer ) : integer;
 cdecl; external {$IFDEF __GPC__}name 'Mix_UnregisterAllEffects'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_UnregisterAllEffects}
 
+{$ENDIF MORPHOS}
+
 const
   MIX_EFFECTSMAXSPEED = 'MIX_EFFECTSMAXSPEED';
 
+{$IFNDEF MORPHOS}
   {*
   * These are the internally - defined mixing effects.They use the same API that
   * effects defined in the application use, but are provided here as a
@@ -914,6 +936,8 @@ procedure Mix_CloseAudio;
 cdecl; external {$IFDEF __GPC__}name 'Mix_CloseAudio'{$ELSE} SDL_MixerLibName{$ENDIF __GPC__};
 {$EXTERNALSYM Mix_CloseAudio}
 
+{$ENDIF MORPHOS}
+
 { We'll use SDL for reporting errors }
 procedure Mix_SetError( fmt : PChar );
 

packages/sdl/src/sdl_net.pas

@@ -124,6 +124,10 @@ uses
 {$IFNDEF __GPC__}
   Windows,
 {$ENDIF}
+{$ENDIF}
+
+{$IFDEF MORPHOS}
+  exec,
 {$ENDIF}
   sdl;
 
@@ -144,6 +148,10 @@ const
   SDLNetLibName = 'SDL_net';
 {$ENDIF}
 
+{$IFDEF MACOS}
+  SDLNetLibName = 'powersdl_net.library';
+{$ENDIF}
+
   {* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *}
   SDL_NET_MAJOR_VERSION = 1;
 {$EXTERNALSYM SDL_NET_MAJOR_VERSION}
@@ -268,6 +276,10 @@ type
 procedure SDL_NET_VERSION( var X : TSDL_version );
 {$EXTERNALSYM SDL_NET_VERSION}
 
+{$IFDEF MORPHOS}
+{$INCLUDE powersdl_net.inc}
+{$ELSE MORPHOS}
+
 {* Initialize/Cleanup the network API
    SDL must be initialized before calls to functions in this library,
    because this library uses utility functions from the SDL library.
@@ -494,10 +506,11 @@ function SDLNet_AddSocket( set_ : PSDLNet_SocketSet; sock : PSDLNet_GenericSocke
 cdecl; external{$IFDEF __GPC__}name 'SDLNet_AddSocket'{$ELSE}SDLNetLibName{$ENDIF __GPC__};
 {$EXTERNALSYM SDLNet_AddSocket}
 
+{$ENDIF MORPHOS}
 function SDLNet_TCP_AddSocket( set_ : PSDLNet_SocketSet; sock : PTCPSocket ) : integer;
 
 function SDLNet_UDP_AddSocket( set_ : PSDLNet_SocketSet; sock : PUDPSocket ) : integer;
-
+{$IFNDEF MORPHOS}
 
 {* Remove a socket from a set of sockets to be checked for available data *}
 function SDLNet_DelSocket( set_ : PSDLNet_SocketSet; sock : PSDLNet_GenericSocket ) : integer;
@@ -523,7 +536,10 @@ cdecl; external{$IFDEF __GPC__}name 'SDLNet_CheckSockets'{$ELSE}SDLNetLibName{$E
    socket that was in the socket set, to find out if data is available
    for reading.
 *}
+
+{$ENDIF MORPHOS}
 function SDLNet_SocketReady( sock : PSDLNet_GenericSocket ) : boolean;
+{$IFNDEF MORPHOS}
 
 {* Free a set of sockets allocated by SDL_NetAllocSocketSet() *}
 procedure SDLNet_FreeSocketSet( set_ : PSDLNet_SocketSet );
@@ -556,6 +572,8 @@ cdecl; external{$IFDEF __GPC__}name 'SDLNet_Read32'{$ELSE}SDLNetLibName{$ENDIF _
 {* Error reporting functions                                           *}
 {***********************************************************************}
 
+{$ENDIF MORPHOS}
+
 {* We'll use SDL's functions for error reporting *}
 procedure SDLNet_SetError( fmt : PChar );
 function SDLNet_GetError : PChar;

packages/sdl/src/sdl_ttf.pas

@@ -171,6 +171,9 @@ uses
   {$IFNDEF __GPC__}
   Windows,
   {$ENDIF}
+{$ENDIF}
+{$IFDEF MORPHOS}
+  exec,
 {$ENDIF}
   sdl;
 
@@ -195,6 +198,10 @@ const
   SDLttfLibName = 'SDL_ttf';
 {$ENDIF}
 
+{$IFDEF MACOS}
+  SDLttfLibName = 'powersdl_ttf.library';
+{$ENDIF}
+
   {* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *}
   SDL_TTF_MAJOR_VERSION = 2;
 {$EXTERNALSYM SDL_TTF_MAJOR_VERSION}
@@ -232,6 +239,10 @@ type
 procedure SDL_TTF_VERSION( var X : TSDL_version );
 {$EXTERNALSYM SDL_TTF_VERSION}
 
+{$IFDEF MORPHOS}
+{$INCLUDE powersdl_ttf.inc}
+{$ELSE MORPHOS}
+
 { This function gets the version of the dynamically linked SDL_ttf library.
      It should NOT be used to fill a version structure, instead you should use the
      SDL_TTF_VERSION() macro. }
@@ -460,6 +471,8 @@ function TTF_WasInit : integer;
 cdecl; external {$IFDEF __GPC__}name 'TTF_WasInit'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
 {$EXTERNALSYM TTF_WasInit}
 
+{$ENDIF MORPHOS}
+
 // We'll use SDL for reporting errors
 procedure TTF_SetError( fmt : PChar );
 

packages/sdl/src/smpeg.pas

@@ -134,7 +134,9 @@ uses
 {$IFDEF __GPC__}
   gpc,
 {$ENDIF}
-
+{$IFDEF MORPHOS}
+  exec,
+{$ENDIF}
   sdl;
 
 const
@@ -154,6 +156,10 @@ const
   SmpegLibName = 'smpeg';
 {$ENDIF}
 
+{$IFDEF MORPHOS}
+  SmpegLibName = 'smpeg.library';
+{$ENDIF}
+
 //------------------------------------------------------------------------------
 // MPEGFilter.h
 //------------------------------------------------------------------------------
@@ -195,6 +201,8 @@ type
     destroy: TSMPEG_FilterDestroy;
   end;
 
+{$IFNDEF MORPHOS}
+{* This part is a bit confusing in PowerSDL includes, fix later. KB *}
 { The null filter (default). It simply copies the source rectangle to the video overlay. }
 function SMPEGfilter_null: PSMPEG_Filter;
 cdecl; external {$IFDEF __GPC__}name 'SMPEGfilter_null'{$ELSE} SmpegLibName{$ENDIF __GPC__};
@@ -206,6 +214,7 @@ cdecl; external {$IFDEF __GPC__}name 'SMPEGfilter_bilinear'{$ELSE} SmpegLibName{
 { The deblocking filter. It filters block borders and non-intra coded blocks to reduce blockiness }
 function SMPEGfilter_deblocking: PSMPEG_Filter;
 cdecl; external {$IFDEF __GPC__}name 'SMPEGfilter_deblocking'{$ELSE} SmpegLibName{$ENDIF __GPC__};
+{$ENDIF}
 
 //------------------------------------------------------------------------------
 // SMPEG.h
@@ -269,6 +278,9 @@ type
   TSMPEG_DisplayCallback = function( dst: PSDL_Surface; x, y: Integer; w, h: Cardinal ): Pointer;
   {$ENDIF}
 
+{$IFDEF MORPHOS}
+{$INCLUDE powersdl_smpeg.inc}
+{$ELSE MORPHOS}
 
 { Create a new SMPEG object from an MPEG file.
   On return, if 'info' is not NULL, it will be filled with information
@@ -334,8 +346,6 @@ cdecl; external {$IFDEF __GPC__}name 'SMPEG_scaleXY'{$ELSE} SmpegLibName{$ENDIF
 procedure SMPEG_scale(mpeg: PSMPEG; scale: Integer);
 cdecl; external {$IFDEF __GPC__}name 'SMPEG_scale'{$ELSE} SmpegLibName{$ENDIF __GPC__};
 
-procedure SMPEG_Double(mpeg : PSMPEG; doubleit : Boolean );
-
 { Move the video display area within the destination surface }
 procedure SMPEG_move(mpeg: PSMPEG; x, y: Integer);
 cdecl; external {$IFDEF __GPC__}name 'SMPEG_move'{$ELSE} SmpegLibName{$ENDIF __GPC__};
@@ -407,10 +417,14 @@ cdecl; external {$IFDEF __GPC__}name 'SMPEG_wantedSpec'{$ELSE} SmpegLibName{$END
 procedure SMPEG_actualSpec(mpeg: PSMPEG; spec: PSDL_AudioSpec);
 cdecl; external {$IFDEF __GPC__}name 'SMPEG_actualSpec'{$ELSE} SmpegLibName{$ENDIF __GPC__};
 
+{$ENDIF MORPHOS}
+
 { This macro can be used to fill a version structure with the compile-time
   version of the SDL library. }
 procedure SMPEG_GETVERSION( var X : TSMPEG_version );
 
+procedure SMPEG_Double(mpeg : PSMPEG; doubleit : Boolean );
+
 implementation
 
 {$IFDEF __GPC__}

packages/winceunits/Makefile.fpc

@@ -13,7 +13,7 @@ implicitunits_wince=aygshell commctrl commdlg iphlpapi notify oleauto power shel
                     sipapi cpl bt_api bt_sdp bthapi bthutil pimstore ril sms ws2bth keybd nled \
                     phone connmgr devload devmgmt mmreg mmsystem msacm wininet ras raserror \
                     sip projects wap tsp extapi imm \
-                    activex ole2 comconst rapitypes
+                    activex ole2 comconst rapitypes tlhelp32
 
 units_win32=rapi cesync rapitypes
 

packages/winceunits/src/buildwinceunits.pp

@@ -26,7 +26,7 @@ uses
   sipapi, cpl, bt_api, bt_sdp, bthapi, bthutil, pimstore, ril, sms, ws2bth,
   keybd, nled, phone, connmgr, devload, devmgmt, mmreg, mmsystem, msacm,
   wininet, ras, raserror, sip, projects, wap, tsp, extapi, imm, rapitypes,
-  storemgr, pnp;
+  storemgr, pnp, tlhelp32;
 
 implementation
 

packages/winceunits/src/tlhelp32.pas

@@ -0,0 +1,239 @@
+{******************************************************************************}
+{                                                                              }
+{ ToolHelp API interface Unit for Object Pascal                                }
+{                                                                              }
+{ Portions created by Microsoft are Copyright (C) 1995-2001 Microsoft          }
+{ Corporation. All Rights Reserved.                                            }
+{                                                                              }
+{ The original file is: tlhelp32.h, released June 2000. The original Pascal    }
+{ code is: TlHelp32.pas, released December 2000. The initial developer of the  }
+{ Pascal code is Marcel van Brakel (brakelm att chello dott nl).               }
+{                                                                              }
+{ Portions created by Marcel van Brakel are Copyright (C) 1999-2001            }
+{ Marcel van Brakel. All Rights Reserved.                                      }
+{                                                                              }
+{ Modified for usage with WinCE by Sven Barth                                  }
+{ Based on JwaTlHelp32.pas,v 1.11 2007/09/05 11:58:52                          }
+{ FPC revision 15911                                                           }
+{                                                                              }
+{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI)        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project JEDI         }
+{ APILIB home page, located at http://jedi-apilib.sourceforge.net              }
+{                                                                              }
+{ The contents of this file are used with permission, subject to the Mozilla   }
+{ Public License Version 1.1 (the "License"); you may not use this file except }
+{ in compliance with the License. You may obtain a copy of the License at      }
+{ http://www.mozilla.org/MPL/MPL-1.1.html                                      }
+{                                                                              }
+{ Software distributed under the License is distributed on an "AS IS" basis,   }
+{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for }
+{ the specific language governing rights and limitations under the License.    }
+{                                                                              }
+{ Alternatively, the contents of this file may be used under the terms of the  }
+{ GNU Lesser General Public License (the  "LGPL License"), in which case the   }
+{ provisions of the LGPL License are applicable instead of those above.        }
+{ If you wish to allow use of your version of this file only under the terms   }
+{ of the LGPL License and not to allow others to use your version of this file }
+{ under the MPL, indicate your decision by deleting  the provisions above and  }
+{ replace  them with the notice and other provisions required by the LGPL      }
+{ License.  If you do not delete the provisions above, a recipient may use     }
+{ your version of this file under either the MPL or the LGPL License.          }
+{                                                                              }
+{ For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html }
+{                                                                              }
+{******************************************************************************}
+
+unit TlHelp32;
+
+{$mode objfpc}
+
+interface
+
+uses
+  windows;
+
+const
+  libtoolhelp = 'toolhelp.dll';
+
+// Snapshot function
+
+function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): HANDLE; cdecl;
+  external libtoolhelp name 'CreateToolhelp32Snapshot';
+function CloseToolhelp32Snapshot(hSnapshot: HANDLE): BOOL; cdecl;
+  external libtoolhelp name 'CloseToolhelp32Snapshot';
+
+//
+// The th32ProcessID argument is only used if TH32CS_SNAPHEAPLIST or
+// TH32CS_SNAPMODULE is specified. th32ProcessID == 0 means the current
+// process.
+//
+// NOTE that all of the snapshots are global except for the heap and module
+//      lists which are process specific. To enumerate the heap or module
+//      state for all WIN32 processes call with TH32CS_SNAPALL and the
+//      current process. Then for each process in the TH32CS_SNAPPROCESS
+//      list that isn't the current process, do a call with just
+//      TH32CS_SNAPHEAPLIST and/or TH32CS_SNAPMODULE.
+//
+// dwFlags
+//
+
+const
+  TH32CS_SNAPHEAPLIST = $00000001;
+  TH32CS_SNAPPROCESS  = $00000002;
+  TH32CS_SNAPTHREAD   = $00000004;
+  TH32CS_SNAPMODULE   = $00000008;
+  TH32CS_SNAPALL      = TH32CS_SNAPHEAPLIST or TH32CS_SNAPPROCESS or
+                        TH32CS_SNAPTHREAD or TH32CS_SNAPMODULE;
+  TH32CS_GETALLMODS   = $80000000;
+
+//
+// Use CloseToolhelp32Snapshot to destroy the snapshot
+//
+
+// Heap walking
+
+type
+  PHEAPLIST32 = ^HEAPLIST32;
+  tagHEAPLIST32 = record
+    dwSize: DWORD;
+    th32ProcessID: DWORD;   // owning process
+    th32HeapID: DWORD;  // heap (in owning process's context!)
+    dwFlags: DWORD;
+  end;
+  HEAPLIST32 = tagHEAPLIST32;
+  LPHEAPLIST32 = ^HEAPLIST32;
+  THeapList32 = HEAPLIST32;
+
+//
+// dwFlags
+//
+
+const
+  HF32_DEFAULT    = 1;  // process's default heap
+  HF32_SHARED     = 2;  // is shared heap
+
+function Heap32ListFirst(hSnapshot: HANDLE; var lphl: HEAPLIST32): BOOL; cdecl;
+  external libtoolhelp name 'Heap32ListFirst';
+function Heap32ListNext(hSnapshot: HANDLE; var lphl: HEAPLIST32): BOOL; cdecl;
+  external libtoolhelp name 'Heap32ListNext';
+
+type
+  PHEAPENTRY32 = ^HEAPENTRY32;
+  tagHEAPENTRY32 = record
+    dwSize: DWORD;
+    hHandle: HANDLE;       // Handle of this heap block
+    dwAddress: DWORD;  // Linear address of start of block
+    dwBlockSize: DWORD;   // Size of block in bytes
+    dwFlags: DWORD;
+    dwLockCount: DWORD;
+    dwResvd: DWORD;
+    th32ProcessID: DWORD;  // owning process
+    th32HeapID: DWORD; // heap block is in
+  end;
+  HEAPENTRY32 = tagHEAPENTRY32;
+  LPHEAPENTRY32 = ^HEAPENTRY32;
+  THeapEntry32 = HEAPENTRY32;
+
+//
+// dwFlags
+//
+
+const
+  LF32_FIXED    = $00000001;
+  LF32_FREE     = $00000002;
+  LF32_MOVEABLE = $00000004;
+
+function Heap32First(var lphe: HEAPENTRY32; th32ProcessID: DWORD;
+  th32HeapID: ULONG_PTR): BOOL; cdecl; external libtoolhelp name 'Heap32First';
+function Heap32Next(var lphe: HEAPENTRY32): BOOL; cdecl; external libtoolhelp
+  name 'Heap32Next';
+
+function Toolhelp32ReadProcessMemory(th32ProcessID: DWORD; lpBaseAddress: LPCVOID;
+  lpBuffer: LPVOID; cbRead: DWORD; lpNumberOfBytesRead: LPDWORD): BOOL; cdecl;
+  external libtoolhelp name 'Toolhelp32ReadProcessMemory';
+
+// Process walking
+
+type
+  PPROCESSENTRY32 = ^PROCESSENTRY32;
+  tagPROCESSENTRY32 = record
+    dwSize: DWORD;
+    cntUsage: DWORD;
+    th32ProcessID: DWORD;          // this process
+    th32DefaultHeapID: DWORD;
+    th32ModuleID:DWORD;            // associated exe
+    cntThreads: DWORD;
+    th32ParentProcessID: DWORD;    // this process's parent process
+    pcPriClassBase: LONG;          // Base priority of process's threads
+    dwFlags: DWORD;
+    szExeFile: array [0..MAX_PATH - 1] of WCHAR;   // Path
+    th32MemoryBase: DWORD;
+    th32AccessKey: DWORD;
+  end;
+  PROCESSENTRY32 = tagPROCESSENTRY32;
+  LPPROCESSENTRY32 = ^PROCESSENTRY32;
+  TProcessEntry32 = PROCESSENTRY32;
+
+function Process32First(hSnapshot: HANDLE; var lppe: PROCESSENTRY32): BOOL; cdecl;
+  external libtoolhelp name 'Process32First';
+function Process32Next(hSnapshot: HANDLE; var lppe: PROCESSENTRY32): BOOL; cdecl;
+  external libtoolhelp name 'Process32Next';
+
+// Thread walking
+
+type
+  PTHREADENTRY32 = ^THREADENTRY32;
+  tagTHREADENTRY32 = record
+    dwSize: DWORD;
+    cntUsage: DWORD;
+    th32ThreadID: DWORD;       // this thread
+    th32OwnerProcessID: DWORD; // Process this thread is associated with
+    tpBasePri: LONG;
+    tpDeltaPri: LONG;
+    dwFlags: DWORD;
+    th32AccessKey: DWORD;
+    th32CurrentProcessID: DWORD;
+  end;
+  THREADENTRY32 = tagTHREADENTRY32;
+  LPTHREADENTRY32 = ^THREADENTRY32;
+  TThreadEntry32 = THREADENTRY32;
+
+function Thread32First(hSnapshot: HANDLE; var lpte: THREADENTRY32): BOOL; cdecl;
+  external libtoolhelp name 'Thread32First';
+function Thread32Next(hSnapshot: HANDLE; var lpte: THREADENTRY32): BOOL; cdecl;
+  external libtoolhelp name 'Thread32Next';
+
+// Module walking
+
+type
+  PMODULEENTRY32 = ^MODULEENTRY32;
+  tagMODULEENTRY32 = record
+    dwSize: DWORD;
+    th32ModuleID: DWORD;       // This module
+    th32ProcessID: DWORD;      // owning process
+    GlblcntUsage: DWORD;       // Global usage count on the module
+    ProccntUsage: DWORD;       // Module usage count in th32ProcessID's context
+    modBaseAddr: LPBYTE;       // Base address of module in th32ProcessID's context
+    modBaseSize: DWORD;        // Size in bytes of module starting at modBaseAddr
+    hModule: HMODULE;          // The hModule of this module in th32ProcessID's context
+    szModule: array [0..MAX_PATH - 1] of WCHAR;
+    szExePath: array [0..MAX_PATH - 1] of WCHAR;
+    dwFlags: DWORD;            // Reserved
+  end;
+  MODULEENTRY32 = tagMODULEENTRY32;
+  LPMODULEENTRY32 = ^MODULEENTRY32;
+  TModuleEntry32 = MODULEENTRY32;
+
+//
+// NOTE CAREFULLY that the modBaseAddr and hModule fields are valid ONLY
+// in th32ProcessID's process context.
+//
+function Module32First(hSnapshot: HANDLE; var lpme: MODULEENTRY32): BOOL; cdecl;
+  external libtoolhelp name 'Module32First';
+function Module32Next(hSnapshot: HANDLE; var lpme: MODULEENTRY32): BOOL; cdecl;
+  external libtoolhelp name 'Module32Next';
+
+implementation
+
+end.

rtl/amiga/system.pp

@@ -52,7 +52,7 @@ const
   FileNameCaseSensitive : Boolean = False;
   CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
 
-  sLineBreak : string[1] = LineEnding;
+  sLineBreak = LineEnding;
   DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
 
   BreakOn : Boolean = True;