- set svn:eol-style to native

- removed some svn:executable properties from non-executable files

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1144 b956fd51-792f-4845-bead-9b4dfca2ff2c

15 files changed, 15903 insertions, 15903 deletions

diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt b/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt
index 76d63a9d..f176d0c9 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt
@@ -1,27 +1,27 @@
-Delphi interface unit for OpenGL version 1.2 compilable with Delphi 3-6 and Kylix.

-

-This unit is open source under the Mozilla Public License and 

-the original author is Dipl. Ing. Mike Lischke (public@lischke-online.de).

-

-You can obtain this unit also from the JEDI (Joint Endeavor of Delphi Innovators) 

-API page at www.delphi-jedi.org.

-

-Note for GLScene users: Eric Grange has provided a general vector types unit which 

-resolves conflicts for types which are defined in OpenGL12.pas as well as Geometry.pas.

-This unit is located in the sub folder "GLScene AddOn".

-Please add this unit to the uses clause of OpenGL12.pas and remove the few types which 

-are already declared in VectorTypes.pas.

-

-For tests and as starting point three demos are included into the package. Two of them (GLDiag and GLTest)

-need the (also provided) simple OpenGL control GLControl (see "GLControl\Package").

-

-- Basic is a very simple test program which only uses an empty form.

-- GLTest (in GLControl) uses GLControl to show four rendering contexts simultanously.

-- GLDiag is a diagnosis tool similar to DXDiag which shows some properties of the current

-   OpenGL driver implementation.

-

-Have fun and 

-

-Ciao, Mike

-www.lischke-online.de

+Delphi interface unit for OpenGL version 1.2 compilable with Delphi 3-6 and Kylix.
+
+This unit is open source under the Mozilla Public License and 
+the original author is Dipl. Ing. Mike Lischke (public@lischke-online.de).
+
+You can obtain this unit also from the JEDI (Joint Endeavor of Delphi Innovators) 
+API page at www.delphi-jedi.org.
+
+Note for GLScene users: Eric Grange has provided a general vector types unit which 
+resolves conflicts for types which are defined in OpenGL12.pas as well as Geometry.pas.
+This unit is located in the sub folder "GLScene AddOn".
+Please add this unit to the uses clause of OpenGL12.pas and remove the few types which 
+are already declared in VectorTypes.pas.
+
+For tests and as starting point three demos are included into the package. Two of them (GLDiag and GLTest)
+need the (also provided) simple OpenGL control GLControl (see "GLControl\Package").
+
+- Basic is a very simple test program which only uses an empty form.
+- GLTest (in GLControl) uses GLControl to show four rendering contexts simultanously.
+- GLDiag is a diagnosis tool similar to DXDiag which shows some properties of the current
+   OpenGL driver implementation.
+
+Have fun and 
+
+Ciao, Mike
+www.lischke-online.de
 www.delphi-unicode.net
\ No newline at end of file
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc b/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc
index 31283d40..0130ad32 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc
@@ -1,438 +1,438 @@
-{

-  $Id: jedi-sdl.inc,v 1.15 2007/05/29 21:30:48 savage Exp $

-}

-{******************************************************************************}

-{                                                                              }

-{       Borland Delphi SDL - Simple DirectMedia Layer                          }

-{       Global Conditional Definitions for JEDI-SDL cross-compilation          }

-{                                                                              }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{  Prof. Abimbola Olowofoyeku <http://www.bigfoot.com/~African_Chief/>         }

-{                                                                              }

-{ Portions created by Prof. Abimbola Olowofoyeku are                           }

-{ Copyright (C) 2000 - 2100 Prof. Abimbola Olowofoyeku.                        }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{  Prof. Abimbola Olowofoyeku <http://www.bigfoot.com/~African_Chief/>         }

-{  Dominqiue Louis <Dominique@SavageSoftware.com.au>                           }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{ This code has been copied from...                                            }

-{ Global Conditional Definitions for Chief's UNZIP package                     }

-{ By Prof. Abimbola Olowofoyeku (The African Chief)                            }

-{          http://www.bigfoot.com/~African_Chief/                              }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }

-{   They are available from...                                                 }

-{   http://www.libsdl.org .                                                    }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{   2003-04-03   DL - Initial addition                                         }

-{                                                                              }

-{   2003-04-07   DL - Added Macro ON derective for FPC and OpenGL and removed  }

-{                WEAKPACKAGE derective. WEAKPACKAGE should be set when         }

-{                appropriate.                                                  }

-{                                                                              }

-{   2003-04-23 - DL : under instruction from Alexey Barkovoy I have added      }

-{                          better TMT Pascal support and under instruction     }

-{                          from Prof. Abimbola Olowofoyeku (The African Chief) }

-{                          I have added better Gnu Pascal support              }

-{                                                                              }

-{   2004-01-19 - DL : Under instruction from Marco van de Voort, I have added  }

-{                     Better FPC support for FreeBSD.                          }

-{                                                                              }

-(*

-  $Log: jedi-sdl.inc,v $

-  Revision 1.15  2007/05/29 21:30:48  savage

-  Changes as suggested by Almindor for 64bit compatibility.

-

-  Revision 1.14  2007/05/20 20:29:11  savage

-  Initial Changes to Handle 64 Bits

-

-  Revision 1.13  2007/01/21 15:51:45  savage

-  Added Delphi 2006 support

-

-  Revision 1.12  2006/11/19 18:41:01  savage

-  removed THREADING ON flag as it is no longer needed in latest versions of FPC.

-

-  Revision 1.11  2006/01/04 00:52:41  drellis

-  Updated to include defined for ENDIAN values, SDL_BYTEORDER should now be correctly defined depending onthe platform. Code taken from sdl_mixer

-

-  Revision 1.10  2005/05/22 18:42:31  savage

-  Changes as suggested by Michalis Kamburelis. Thanks again.

-

-  Revision 1.9  2004/12/23 23:42:17  savage

-  Applied Patches supplied by Michalis Kamburelis ( THANKS! ), for greater FreePascal compatability.

-

-  Revision 1.8  2004/10/20 22:43:04  savage

-  Ensure that UNSAFE type warning are off in D9 as well

-

-  Revision 1.7  2004/04/05 09:59:51  savage

-  Changes for FreePacal as suggested by Marco

-

-  Revision 1.6  2004/03/31 22:18:15  savage

-  Small comment for turning off warning under GnuPascal

-

-  Revision 1.5  2004/03/30 22:41:02  savage

-  Added extra commenting due to previous compiler directive

-

-  Revision 1.4  2004/03/30 22:08:33  savage

-  Added Kylix Define

-

-  Revision 1.3  2004/03/30 21:34:40  savage

-  {$H+} needed for FPC compatiblity

-

-  Revision 1.2  2004/02/14 00:23:39  savage

-  As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.

-

-*)

-{******************************************************************************}

-

-{.$define Debug}           { uncomment for debugging }

-

-{$IFNDEF FPC}

-  {$IFDEF __GPC__}

-    {$I-}

-    {$W-} // turn off GPC warnings

-    {$X+}

-  {$ELSE} {__GPC__}

-    {$IFDEF Debug}

-      {$F+,D+,Q-,L+,R+,I-,S+,Y+,A+}

-    {$ELSE}

-      {$F+,Q-,R-,S-,I-,A+}

-    {$ENDIF}

-  {$ENDIF} {__GPC__}

-{$ELSE}  {FPC}

-  //{$M+}

-{$ENDIF} {FPC}

-

-{$IFDEF LINUX}

-{$DEFINE UNIX}

-{$ENDIF}

-

-{$IFDEF ver70}

-   {$IFDEF Windows}

-     {$DEFINE Win16}

-   {$ENDIF Windows}

-   {$IFDEF MSDOS}

-     {$DEFINE NO_EXPORTS}

-   {$ENDIF MSDOS}

-   {$IFDEF DPMI}

-     {$DEFINE BP_DPMI}

-   {$ENDIF}

-   {$DEFINE OS_16_BIT}

-   {$DEFINE __OS_DOS__}

-{$ENDIF ver70}

-

-{$IFDEF ver80}

-   {$DEFINE Delphi}      {Delphi 1.x}

-   {$DEFINE Delphi16}

-   {$DEFINE Win16}

-   {$DEFINE OS_16_BIT}

-   {$DEFINE __OS_DOS__}

-{$ENDIF ver80}

-

-{$IFDEF ver90}

-   {$DEFINE Delphi}      {Delphi 2.x}

-   {$DEFINE Delphi32}

-   {$DEFINE WIN32}

-   {$DEFINE WINDOWS}

-{$ENDIF ver90}

-

-{$IFDEF ver100}

-   {$DEFINE Delphi}      {Delphi 3.x}

-   {$DEFINE Delphi32}

-   {$DEFINE WIN32}

-   {$DEFINE WINDOWS}

-{$ENDIF ver100}

-

-{$IFDEF ver93}

-   {$DEFINE Delphi}      {C++ Builder 1.x}

-   {$DEFINE Delphi32}

-   {$DEFINE WINDOWS}

-{$ENDIF ver93}

-

-{$IFDEF ver110}

-   {$DEFINE Delphi}      {C++ Builder 3.x}

-   {$DEFINE Delphi32}

-   {$DEFINE WINDOWS}

-{$ENDIF ver110}

-

-{$IFDEF ver120}

-   {$DEFINE Delphi}      {Delphi 4.x}

-   {$DEFINE Delphi32}

-   {$DEFINE Delphi4UP}

-   {$DEFINE Has_Int64}

-   {$DEFINE WINDOWS}

-{$ENDIF ver120}

-

-{$IFDEF ver130}

-   {$DEFINE Delphi}      {Delphi 5.x}

-   {$DEFINE Delphi32}

-   {$DEFINE Delphi4UP}

-   {$DEFINE Delphi5UP}

-   {$DEFINE Has_Int64}

-   {$DEFINE WINDOWS}

-{$ENDIF ver130}

-

-{$IFDEF ver140}

-   {$DEFINE Delphi}      {Delphi 6.x}

-   {$DEFINE Delphi32}

-   {$DEFINE Delphi4UP}

-   {$DEFINE Delphi5UP}

-   {$DEFINE Delphi6UP}

-   {$DEFINE Has_Int64}

-   {$DEFINE HAS_TYPES}

-{$ENDIF ver140}

-

-{$IFDEF ver150}

-   {$DEFINE Delphi}      {Delphi 7.x}

-   {$DEFINE Delphi32}

-   {$DEFINE Delphi4UP}

-   {$DEFINE Delphi5UP}

-   {$DEFINE Delphi6UP}

-   {$DEFINE Delphi7UP}

-   {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}

-   {$DEFINE Has_Int64}

-   {$DEFINE HAS_TYPES}

-{$ENDIF ver150}

-

-{$IFDEF ver160}

-   {$DEFINE Delphi}      {Delphi 8}

-   {$DEFINE Delphi32}

-   {$DEFINE Delphi4UP}

-   {$DEFINE Delphi5UP}

-   {$DEFINE Delphi6UP}

-   {$DEFINE Delphi7UP}

-   {$DEFINE Delphi8UP}

-   {$DEFINE Has_Int64}

-   {$DEFINE HAS_TYPES}

-{$ENDIF ver160}

-

-{$IFDEF ver170}

-   {$DEFINE Delphi}      {Delphi 2005}

-   {$DEFINE Delphi32}

-   {$DEFINE Delphi4UP}

-   {$DEFINE Delphi5UP}

-   {$DEFINE Delphi6UP}

-   {$DEFINE Delphi7UP}

-   {$DEFINE Delphi8UP}

-   {$DEFINE Delphi9UP}

-   {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}

-   {$DEFINE Has_Int64}

-   {$DEFINE HAS_TYPES}

-{$ENDIF ver170}

-

-{$IFDEF ver180}

-   {$DEFINE Delphi}      {Delphi 2006}

-   {$DEFINE Delphi32}

-   {$DEFINE Delphi4UP}

-   {$DEFINE Delphi5UP}

-   {$DEFINE Delphi6UP}

-   {$DEFINE Delphi7UP}

-   {$DEFINE Delphi8UP}

-   {$DEFINE Delphi9UP}

-   {$DEFINE Delphi10UP}

-   {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}

-   {$DEFINE Has_Int64}

-   {$DEFINE HAS_TYPES}

-{$ENDIF ver180}

-

-{$IFDEF ver185}

-   {$DEFINE Delphi}      {Delphi 2007}

-   {$DEFINE Delphi32}

-   {$DEFINE Delphi4UP}

-   {$DEFINE Delphi5UP}

-   {$DEFINE Delphi6UP}

-   {$DEFINE Delphi7UP}

-   {$DEFINE Delphi8UP}

-   {$DEFINE Delphi9UP}

-   {$DEFINE Delphi10UP}

-   {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}

-   {$DEFINE Has_Int64}

-   {$DEFINE HAS_TYPES}

-{$ENDIF ver180}

-

-{$IFDEF UNIX}

-  {$ifdef VER140}    // Kylix 1 & 2

-    {$DEFINE KYLIX}

-    {$DEFINE KYLIX1UP}

-    {$DEFINE KYLIX2UP}

-    {$DEFINE HAS_TYPES}

-  {$endif}

-

-  {$ifdef VER150}   // Kylix 3

-    {$DEFINE KYLIX}

-    {$DEFINE KYLIX1UP}

-    {$DEFINE KYLIX2UP}

-    {$DEFINE KYLIX3UP}

-    {$DEFINE HAS_TYPES}

-  {$endif}

-{$ENDIF UNIX}

-

-{$IFDEF VirtualPascal} {  Virtual Pascal 2.x }

-   {$DEFINE Delphi}    {  Use Delphi Syntax }

-   {$DEFINE VP2}

-   {&Delphi+}

-{$ENDIF VirtualPascal}

-

-{$IFDEF Delphi}

-  {$DEFINE Windows}

-  {$DEFINE USE_STDCALL}

-  //{$ALIGN ON}

-{$ENDIF Delphi}

-

-{$IFDEF FPC}

-  {$MODE Delphi}          { use Delphi compatibility mode }

-  {$H+}

-  {$PACKRECORDS C}        // Added for record

-  {$MACRO ON}             // Added For OpenGL

-  {$DEFINE Delphi}

-  {$DEFINE UseAT}

-  {$UNDEF USE_STDCALL}

-  {$DEFINE OS_BigMem}

-  {$DEFINE NO_EXPORTS}

-  {$DEFINE Has_Int64}

-  {$DEFINE NOCRT}

-  {$IFDEF UNIX}

-     {$DEFINE fpc_unix}

-  {$ELSE}

-     {$DEFINE __OS_DOS__}

-  {$ENDIF}

-  {$IFDEF WIN32}

-   {$DEFINE UseWin}

-  {$ENDIF}

-  {$DEFINE HAS_TYPES}

-{$ENDIF FPC}

-

-{$IFDEF Win16}

-  {$K+}   {smart callbacks}

-{$ENDIF Win16}

-

- {$IFDEF OS2}

-    {$UNDEF Windows}

-    {$DEFINE UseWin}

-    {$DEFINE OS_BigMem}

- {$ENDIF OS2}

-

-{$IFDEF __GPC__}

-  {$UNDEF UseWin}

-  {$UNDEF USE_STDCALL}

-  {$DEFINE OS_BigMem}

-  {$DEFINE NO_EXPORTS}

-  {$DEFINE NOCRT}

-  {$DEFINE cdecl attribute(cdecl)}

-{$ENDIF}

-

-{$IFDEF __TMT__}

-  {$DEFINE OS_BigMem}

-  {$DEFINE NO_EXPORTS}

-  {$DEFINE __OS_DOS__}

-  {$DEFINE UseAT}

-  {$IFNDEF MSDOS}

-    {$DEFINE USE_STDCALL}

-  {$ENDIF}

-

-  {$IFDEF __WIN32__}

-    {$DEFINE Win32}

-    {$DEFINE UseWin}

-    {$DEFINE NOCRT}

-    {$DEFINE Win32}

-    {$IFNDEF __CON__}

-      {$DEFINE Windows}

-    {$ENDIF}

-  {$ENDIF}

-

-  {$A+}  // Word alignment data

-  {$OA+} // Objects and structures align

-{$ENDIF}

-

-{$IFDEF Win32}

-  {$DEFINE OS_BigMem}

-{$ELSE Win32}

-  {$IFDEF ver70}

-    {$DEFINE assembler}

-  {$ENDIF} { use 16-bit assembler! }

-{$ENDIF Win32}

-

-{ ************************** dos/dos-like platforms **************}

-{$IFDEF Windows}

-   {$DEFINE __OS_DOS__}

-   {$DEFINE UseWin}

-   {$DEFINE MSWINDOWS}

-{$ENDIF Delphi}

-

-{$IFDEF OS2}

-   {$DEFINE __OS_DOS__}

-   {$DEFINE Can_Use_DLL}

-{$ENDIF Delphi}

-

-{$IFDEF UseWin}

-   {$DEFINE Can_Use_DLL}

-{$ENDIF}

-

-{$IFDEF Win16}

-   {$DEFINE Can_Use_DLL}

-{$ENDIF}

-

-{$IFDEF BP_DPMI}

-   {$DEFINE Can_Use_DLL}

-{$ENDIF}

-

-{$IFDEF USE_STDCALL}

-   {$IFNDEF __TMT__}

-     {$DEFINE BY_NAME}

-   {$ENDIF}

-{$ENDIF}

-

-{$IFNDEF ver70}

-  {$UNDEF assembler}

-{$ENDIF}

-

-{*************** define LITTLE ENDIAN platforms ********************}

-

-

-{$IFDEF Delphi}

-{$DEFINE IA32}

-{$ENDIF}

-

-{$IFDEF KYLIX}

-{$DEFINE IA32}

-{$ENDIF}

-

-{$IFDEF FPC}

-{$IFDEF FPC_LITTLE_ENDIAN}

-{$DEFINE IA32}

-{$ENDIF}

-{$ENDIF}

+{
+  $Id: jedi-sdl.inc,v 1.15 2007/05/29 21:30:48 savage Exp $
+}
+{******************************************************************************}
+{                                                                              }
+{       Borland Delphi SDL - Simple DirectMedia Layer                          }
+{       Global Conditional Definitions for JEDI-SDL cross-compilation          }
+{                                                                              }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{  Prof. Abimbola Olowofoyeku <http://www.bigfoot.com/~African_Chief/>         }
+{                                                                              }
+{ Portions created by Prof. Abimbola Olowofoyeku are                           }
+{ Copyright (C) 2000 - 2100 Prof. Abimbola Olowofoyeku.                        }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{  Prof. Abimbola Olowofoyeku <http://www.bigfoot.com/~African_Chief/>         }
+{  Dominqiue Louis <Dominique@SavageSoftware.com.au>                           }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{ This code has been copied from...                                            }
+{ Global Conditional Definitions for Chief's UNZIP package                     }
+{ By Prof. Abimbola Olowofoyeku (The African Chief)                            }
+{          http://www.bigfoot.com/~African_Chief/                              }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }
+{   They are available from...                                                 }
+{   http://www.libsdl.org .                                                    }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{   2003-04-03   DL - Initial addition                                         }
+{                                                                              }
+{   2003-04-07   DL - Added Macro ON derective for FPC and OpenGL and removed  }
+{                WEAKPACKAGE derective. WEAKPACKAGE should be set when         }
+{                appropriate.                                                  }
+{                                                                              }
+{   2003-04-23 - DL : under instruction from Alexey Barkovoy I have added      }
+{                          better TMT Pascal support and under instruction     }
+{                          from Prof. Abimbola Olowofoyeku (The African Chief) }
+{                          I have added better Gnu Pascal support              }
+{                                                                              }
+{   2004-01-19 - DL : Under instruction from Marco van de Voort, I have added  }
+{                     Better FPC support for FreeBSD.                          }
+{                                                                              }
+(*
+  $Log: jedi-sdl.inc,v $
+  Revision 1.15  2007/05/29 21:30:48  savage
+  Changes as suggested by Almindor for 64bit compatibility.
+
+  Revision 1.14  2007/05/20 20:29:11  savage
+  Initial Changes to Handle 64 Bits
+
+  Revision 1.13  2007/01/21 15:51:45  savage
+  Added Delphi 2006 support
+
+  Revision 1.12  2006/11/19 18:41:01  savage
+  removed THREADING ON flag as it is no longer needed in latest versions of FPC.
+
+  Revision 1.11  2006/01/04 00:52:41  drellis
+  Updated to include defined for ENDIAN values, SDL_BYTEORDER should now be correctly defined depending onthe platform. Code taken from sdl_mixer
+
+  Revision 1.10  2005/05/22 18:42:31  savage
+  Changes as suggested by Michalis Kamburelis. Thanks again.
+
+  Revision 1.9  2004/12/23 23:42:17  savage
+  Applied Patches supplied by Michalis Kamburelis ( THANKS! ), for greater FreePascal compatability.
+
+  Revision 1.8  2004/10/20 22:43:04  savage
+  Ensure that UNSAFE type warning are off in D9 as well
+
+  Revision 1.7  2004/04/05 09:59:51  savage
+  Changes for FreePacal as suggested by Marco
+
+  Revision 1.6  2004/03/31 22:18:15  savage
+  Small comment for turning off warning under GnuPascal
+
+  Revision 1.5  2004/03/30 22:41:02  savage
+  Added extra commenting due to previous compiler directive
+
+  Revision 1.4  2004/03/30 22:08:33  savage
+  Added Kylix Define
+
+  Revision 1.3  2004/03/30 21:34:40  savage
+  {$H+} needed for FPC compatiblity
+
+  Revision 1.2  2004/02/14 00:23:39  savage
+  As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
+
+*)
+{******************************************************************************}
+
+{.$define Debug}           { uncomment for debugging }
+
+{$IFNDEF FPC}
+  {$IFDEF __GPC__}
+    {$I-}
+    {$W-} // turn off GPC warnings
+    {$X+}
+  {$ELSE} {__GPC__}
+    {$IFDEF Debug}
+      {$F+,D+,Q-,L+,R+,I-,S+,Y+,A+}
+    {$ELSE}
+      {$F+,Q-,R-,S-,I-,A+}
+    {$ENDIF}
+  {$ENDIF} {__GPC__}
+{$ELSE}  {FPC}
+  //{$M+}
+{$ENDIF} {FPC}
+
+{$IFDEF LINUX}
+{$DEFINE UNIX}
+{$ENDIF}
+
+{$IFDEF ver70}
+   {$IFDEF Windows}
+     {$DEFINE Win16}
+   {$ENDIF Windows}
+   {$IFDEF MSDOS}
+     {$DEFINE NO_EXPORTS}
+   {$ENDIF MSDOS}
+   {$IFDEF DPMI}
+     {$DEFINE BP_DPMI}
+   {$ENDIF}
+   {$DEFINE OS_16_BIT}
+   {$DEFINE __OS_DOS__}
+{$ENDIF ver70}
+
+{$IFDEF ver80}
+   {$DEFINE Delphi}      {Delphi 1.x}
+   {$DEFINE Delphi16}
+   {$DEFINE Win16}
+   {$DEFINE OS_16_BIT}
+   {$DEFINE __OS_DOS__}
+{$ENDIF ver80}
+
+{$IFDEF ver90}
+   {$DEFINE Delphi}      {Delphi 2.x}
+   {$DEFINE Delphi32}
+   {$DEFINE WIN32}
+   {$DEFINE WINDOWS}
+{$ENDIF ver90}
+
+{$IFDEF ver100}
+   {$DEFINE Delphi}      {Delphi 3.x}
+   {$DEFINE Delphi32}
+   {$DEFINE WIN32}
+   {$DEFINE WINDOWS}
+{$ENDIF ver100}
+
+{$IFDEF ver93}
+   {$DEFINE Delphi}      {C++ Builder 1.x}
+   {$DEFINE Delphi32}
+   {$DEFINE WINDOWS}
+{$ENDIF ver93}
+
+{$IFDEF ver110}
+   {$DEFINE Delphi}      {C++ Builder 3.x}
+   {$DEFINE Delphi32}
+   {$DEFINE WINDOWS}
+{$ENDIF ver110}
+
+{$IFDEF ver120}
+   {$DEFINE Delphi}      {Delphi 4.x}
+   {$DEFINE Delphi32}
+   {$DEFINE Delphi4UP}
+   {$DEFINE Has_Int64}
+   {$DEFINE WINDOWS}
+{$ENDIF ver120}
+
+{$IFDEF ver130}
+   {$DEFINE Delphi}      {Delphi 5.x}
+   {$DEFINE Delphi32}
+   {$DEFINE Delphi4UP}
+   {$DEFINE Delphi5UP}
+   {$DEFINE Has_Int64}
+   {$DEFINE WINDOWS}
+{$ENDIF ver130}
+
+{$IFDEF ver140}
+   {$DEFINE Delphi}      {Delphi 6.x}
+   {$DEFINE Delphi32}
+   {$DEFINE Delphi4UP}
+   {$DEFINE Delphi5UP}
+   {$DEFINE Delphi6UP}
+   {$DEFINE Has_Int64}
+   {$DEFINE HAS_TYPES}
+{$ENDIF ver140}
+
+{$IFDEF ver150}
+   {$DEFINE Delphi}      {Delphi 7.x}
+   {$DEFINE Delphi32}
+   {$DEFINE Delphi4UP}
+   {$DEFINE Delphi5UP}
+   {$DEFINE Delphi6UP}
+   {$DEFINE Delphi7UP}
+   {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
+   {$DEFINE Has_Int64}
+   {$DEFINE HAS_TYPES}
+{$ENDIF ver150}
+
+{$IFDEF ver160}
+   {$DEFINE Delphi}      {Delphi 8}
+   {$DEFINE Delphi32}
+   {$DEFINE Delphi4UP}
+   {$DEFINE Delphi5UP}
+   {$DEFINE Delphi6UP}
+   {$DEFINE Delphi7UP}
+   {$DEFINE Delphi8UP}
+   {$DEFINE Has_Int64}
+   {$DEFINE HAS_TYPES}
+{$ENDIF ver160}
+
+{$IFDEF ver170}
+   {$DEFINE Delphi}      {Delphi 2005}
+   {$DEFINE Delphi32}
+   {$DEFINE Delphi4UP}
+   {$DEFINE Delphi5UP}
+   {$DEFINE Delphi6UP}
+   {$DEFINE Delphi7UP}
+   {$DEFINE Delphi8UP}
+   {$DEFINE Delphi9UP}
+   {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
+   {$DEFINE Has_Int64}
+   {$DEFINE HAS_TYPES}
+{$ENDIF ver170}
+
+{$IFDEF ver180}
+   {$DEFINE Delphi}      {Delphi 2006}
+   {$DEFINE Delphi32}
+   {$DEFINE Delphi4UP}
+   {$DEFINE Delphi5UP}
+   {$DEFINE Delphi6UP}
+   {$DEFINE Delphi7UP}
+   {$DEFINE Delphi8UP}
+   {$DEFINE Delphi9UP}
+   {$DEFINE Delphi10UP}
+   {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
+   {$DEFINE Has_Int64}
+   {$DEFINE HAS_TYPES}
+{$ENDIF ver180}
+
+{$IFDEF ver185}
+   {$DEFINE Delphi}      {Delphi 2007}
+   {$DEFINE Delphi32}
+   {$DEFINE Delphi4UP}
+   {$DEFINE Delphi5UP}
+   {$DEFINE Delphi6UP}
+   {$DEFINE Delphi7UP}
+   {$DEFINE Delphi8UP}
+   {$DEFINE Delphi9UP}
+   {$DEFINE Delphi10UP}
+   {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
+   {$DEFINE Has_Int64}
+   {$DEFINE HAS_TYPES}
+{$ENDIF ver180}
+
+{$IFDEF UNIX}
+  {$ifdef VER140}    // Kylix 1 & 2
+    {$DEFINE KYLIX}
+    {$DEFINE KYLIX1UP}
+    {$DEFINE KYLIX2UP}
+    {$DEFINE HAS_TYPES}
+  {$endif}
+
+  {$ifdef VER150}   // Kylix 3
+    {$DEFINE KYLIX}
+    {$DEFINE KYLIX1UP}
+    {$DEFINE KYLIX2UP}
+    {$DEFINE KYLIX3UP}
+    {$DEFINE HAS_TYPES}
+  {$endif}
+{$ENDIF UNIX}
+
+{$IFDEF VirtualPascal} {  Virtual Pascal 2.x }
+   {$DEFINE Delphi}    {  Use Delphi Syntax }
+   {$DEFINE VP2}
+   {&Delphi+}
+{$ENDIF VirtualPascal}
+
+{$IFDEF Delphi}
+  {$DEFINE Windows}
+  {$DEFINE USE_STDCALL}
+  //{$ALIGN ON}
+{$ENDIF Delphi}
+
+{$IFDEF FPC}
+  {$MODE Delphi}          { use Delphi compatibility mode }
+  {$H+}
+  {$PACKRECORDS C}        // Added for record
+  {$MACRO ON}             // Added For OpenGL
+  {$DEFINE Delphi}
+  {$DEFINE UseAT}
+  {$UNDEF USE_STDCALL}
+  {$DEFINE OS_BigMem}
+  {$DEFINE NO_EXPORTS}
+  {$DEFINE Has_Int64}
+  {$DEFINE NOCRT}
+  {$IFDEF UNIX}
+     {$DEFINE fpc_unix}
+  {$ELSE}
+     {$DEFINE __OS_DOS__}
+  {$ENDIF}
+  {$IFDEF WIN32}
+   {$DEFINE UseWin}
+  {$ENDIF}
+  {$DEFINE HAS_TYPES}
+{$ENDIF FPC}
+
+{$IFDEF Win16}
+  {$K+}   {smart callbacks}
+{$ENDIF Win16}
+
+ {$IFDEF OS2}
+    {$UNDEF Windows}
+    {$DEFINE UseWin}
+    {$DEFINE OS_BigMem}
+ {$ENDIF OS2}
+
+{$IFDEF __GPC__}
+  {$UNDEF UseWin}
+  {$UNDEF USE_STDCALL}
+  {$DEFINE OS_BigMem}
+  {$DEFINE NO_EXPORTS}
+  {$DEFINE NOCRT}
+  {$DEFINE cdecl attribute(cdecl)}
+{$ENDIF}
+
+{$IFDEF __TMT__}
+  {$DEFINE OS_BigMem}
+  {$DEFINE NO_EXPORTS}
+  {$DEFINE __OS_DOS__}
+  {$DEFINE UseAT}
+  {$IFNDEF MSDOS}
+    {$DEFINE USE_STDCALL}
+  {$ENDIF}
+
+  {$IFDEF __WIN32__}
+    {$DEFINE Win32}
+    {$DEFINE UseWin}
+    {$DEFINE NOCRT}
+    {$DEFINE Win32}
+    {$IFNDEF __CON__}
+      {$DEFINE Windows}
+    {$ENDIF}
+  {$ENDIF}
+
+  {$A+}  // Word alignment data
+  {$OA+} // Objects and structures align
+{$ENDIF}
+
+{$IFDEF Win32}
+  {$DEFINE OS_BigMem}
+{$ELSE Win32}
+  {$IFDEF ver70}
+    {$DEFINE assembler}
+  {$ENDIF} { use 16-bit assembler! }
+{$ENDIF Win32}
+
+{ ************************** dos/dos-like platforms **************}
+{$IFDEF Windows}
+   {$DEFINE __OS_DOS__}
+   {$DEFINE UseWin}
+   {$DEFINE MSWINDOWS}
+{$ENDIF Delphi}
+
+{$IFDEF OS2}
+   {$DEFINE __OS_DOS__}
+   {$DEFINE Can_Use_DLL}
+{$ENDIF Delphi}
+
+{$IFDEF UseWin}
+   {$DEFINE Can_Use_DLL}
+{$ENDIF}
+
+{$IFDEF Win16}
+   {$DEFINE Can_Use_DLL}
+{$ENDIF}
+
+{$IFDEF BP_DPMI}
+   {$DEFINE Can_Use_DLL}
+{$ENDIF}
+
+{$IFDEF USE_STDCALL}
+   {$IFNDEF __TMT__}
+     {$DEFINE BY_NAME}
+   {$ENDIF}
+{$ENDIF}
+
+{$IFNDEF ver70}
+  {$UNDEF assembler}
+{$ENDIF}
+
+{*************** define LITTLE ENDIAN platforms ********************}
+
+
+{$IFDEF Delphi}
+{$DEFINE IA32}
+{$ENDIF}
+
+{$IFDEF KYLIX}
+{$DEFINE IA32}
+{$ENDIF}
+
+{$IFDEF FPC}
+{$IFDEF FPC_LITTLE_ENDIAN}
+{$DEFINE IA32}
+{$ENDIF}
+{$ENDIF}
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas
index 0cdf44c7..63e7b7fb 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas
@@ -1,2688 +1,2688 @@
-(**

-===============================================================================================

-Name    : LibXmlParser

-===============================================================================================

-Project : All Projects

-===============================================================================================

-Subject : Progressive XML Parser for all types of XML Files

-===============================================================================================

-Author  : Stefan Heymann

-          Eschenweg 3

-          72076 Tübingen

-          GERMANY

-

-E-Mail:   stefan@destructor.de

-URL:      www.destructor.de

-===============================================================================================

-Source, Legals ("Licence")

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

-The official site to get this parser is http://www.destructor.de/

-

-Usage and Distribution of this Source Code is ruled by the

-"Destructor.de Source code Licence" (DSL) which comes with this file or

-can be downloaded at http://www.destructor.de/

-

-IN SHORT: Usage and distribution of this source code is free.

-          You use it completely on your own risk.

-

-Postcardware

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

-If you like this code, please send a postcard of your city to my above address.

-===============================================================================================

-!!!  All parts of this code which are not finished or not conforming exactly to

-     the XmlSpec are marked with three exclamation marks

-

--!-  Parts where the parser may be able to detect errors in the document's syntax are

-     marked with the dash-exlamation mark-dash sequence.

-===============================================================================================

-Terminology:

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

-- Start:   Start of a buffer part

-- Final:   End (last character) of a buffer part

-- DTD:     Document Type Definition

-- DTDc:    Document Type Declaration

-- XMLSpec: The current W3C XML Recommendation (version 1.0 as of 1998-02-10), Chapter No.

-- Cur*:    Fields concerning the "Current" part passed back by the "Scan" method

-===============================================================================================

-Scanning the XML document

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

-- Create TXmlParser Instance                     MyXml := TXmlParser.Create;

-- Load XML Document                              MyXml.LoadFromFile (Filename);

-- Start Scanning                                 MyXml.StartScan;

-- Scan Loop                                      WHILE MyXml.Scan DO

-- Test for Part Type                               CASE MyXml.CurPartType OF

-- Handle Parts                                       ... : ;;;

-- Handle Parts                                       ... : ;;;

-- Handle Parts                                       ... : ;;;

-                                                     END;

-- Destroy                                        MyXml.Free;

-===============================================================================================

-Loading the XML document

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

-You can load the XML document from a file with the "LoadFromFile" method.

-It is beyond the scope of this parser to perform HTTP or FTP accesses. If you want your

-application to handle such requests (URLs), you can load the XML via HTTP or FTP or whatever

-protocol and hand over the data buffer using the "LoadFromBuffer" or "SetBuffer" method.

-"LoadFromBuffer" loads the internal buffer of TXmlParser with the given null-terminated

-string, thereby creating a copy of that buffer.

-"SetBuffer" just takes the pointer to another buffer, which means that the given

-buffer pointer must be valid while the document is accessed via TXmlParser.

-===============================================================================================

-Encodings:

-----------

-This XML parser kind of "understands" the following encodings:

-- UTF-8

-- ISO-8859-1

-- Windows-1252

-

-Any flavor of multi-byte characters (and this includes UTF-16) is not supported. Sorry.

-

-Every string which has to be passed to the application passes the virtual method

-"TranslateEncoding" which translates the string from the current encoding (stored in

-"CurEncoding") into the encoding the application wishes to receive.

-The "TranslateEncoding" method that is built into TXmlParser assumes that the application

-wants to receive Windows ANSI (Windows-1252, about the same as ISO-8859-1) and is able

-to convert UTF-8 and ISO-8859-1 encodings.

-For other source and target encodings, you will have to override "TranslateEncoding".

-===============================================================================================

-Buffer Handling

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

-- The document must be loaded completely into a piece of RAM

-- All character positions are referenced by PChar pointers

-- The TXmlParser instance can either "own" the buffer itself (then, FBufferSize is > 0)

-  or reference the buffer of another instance or object (then, FBuffersize is 0 and

-  FBuffer is not NIL)

-- The Property DocBuffer passes back a pointer to the first byte of the document. If there

-  is no document stored (FBuffer is NIL), the DocBuffer returns a pointer to a NULL character.

-===============================================================================================

-Whitespace Handling

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

-The TXmlParser property "PackSpaces" determines how Whitespace is returned in Text Content:

-While PackSpaces is true, all leading and trailing whitespace characters are trimmed of, all

-Whitespace is converted to Space #x20 characters and contiguous Whitespace characters are

-compressed to one.

-If the "Scan" method reports a ptContent part, the application can get the original text

-with all whitespace characters by extracting the characters from "CurStart" to "CurFinal".

-If the application detects an xml:space attribute, it can set "PackSpaces" accordingly or

-use CurStart/CurFinal.

-Please note that TXmlParser does _not_ normalize Line Breaks to single LineFeed characters

-as the XmlSpec requires (XmlSpec 2.11).

-The xml:space attribute is not handled by TXmlParser. This is on behalf of the application.

-===============================================================================================

-Non-XML-Conforming

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

-TXmlParser does not conform 100 % exactly to the XmlSpec:

-- UTF-16 is not supported (XmlSpec 2.2)

-  (Workaround: Convert UTF-16 to UTF-8 and hand the buffer over to TXmlParser)

-- As the parser only works with single byte strings, all Unicode characters > 255

-  can currently not be handled correctly.

-- Line breaks are not normalized to single Linefeed #x0A characters (XmlSpec 2.11)

-  (Workaround: The Application can access the text contents on its own [CurStart, CurFinal],

-  thereby applying every normalization it wishes to)

-- The attribute value normalization does not work exactly as defined in the

-  Second Edition of the XML 1.0 specification.

-- See also the code parts marked with three consecutive exclamation marks. These are

-  parts which are not finished in the current code release.

-

-This list may be incomplete, so it may grow if I get to know any other points.

-As work on the parser proceeds, this list may also shrink.

-===============================================================================================

-Things Todo

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

-- Introduce a new event/callback which is called when there is an unresolvable

-  entity or character reference

-- Support Unicode

-- Use Streams instead of reading the whole XML into memory

-===============================================================================================

-Change History, Version numbers

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

-The Date is given in ISO Year-Month-Day (YYYY-MM-DD) order.

-Versions are counted from 1.0.0 beginning with the version from 2000-03-16.

-Unreleased versions don't get a version number.

-

-Date        Author Version Changes

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

-2000-03-16  HeySt  1.0.0   Start

-2000-03-28  HeySt  1.0.1   Initial Publishing of TXmlParser on the destructor.de Web Site

-2000-03-30  HeySt  1.0.2   TXmlParser.AnalyzeCData: Call "TranslateEncoding" for CurContent

-2000-03-31  HeySt  1.0.3   Deleted the StrPosE function (was not needed anyway)

-2000-04-04  HeySt  1.0.4   TDtdElementRec modified: Start/Final for all Elements;

-                           Should be backwards compatible.

-                           AnalyzeDtdc: Set CurPartType to ptDtdc

-2000-04-23  HeySt  1.0.5   New class TObjectList. Eliminated reference to the Delphi 5

-                           "Contnrs" unit so LibXmlParser is Delphi 4 compatible.

-2000-07-03  HeySt  1.0.6   TNvpNode: Added Constructor

-2000-07-11  HeySt  1.0.7   Removed "Windows" from USES clause

-                           Added three-exclamation-mark comments for Utf8ToAnsi/AnsiToUtf8

-                           Added three-exclamation-mark comments for CHR function calls

-2000-07-23  HeySt  1.0.8   TXmlParser.Clear: CurAttr.Clear; EntityStack.Clear;

-                           (This was not a bug; just defensive programming)

-2000-07-29  HeySt  1.0.9   TNvpList: Added methods: Node(Index), Value(Index), Name(Index);

-2000-10-07  HeySt          Introduced Conditional Defines

-                           Uses Contnrs unit and its TObjectList class again for

-                           Delphi 5 and newer versions

-2001-01-30  HeySt          Introduced Version Numbering

-                           Made LoadFromFile and LoadFromBuffer BOOLEAN functions

-                           Introduced FileMode parameter for LoadFromFile

-                           BugFix: TAttrList.Analyze: Must add CWhitespace to ExtractName call

-                           Comments worked over

-2001-02-28  HeySt  1.0.10  Completely worked over and tested the UTF-8 functions

-                           Fixed a bug in TXmlParser.Scan which caused it to start over when it

-                           was called after the end of scanning, resulting in an endless loop

-                           TEntityStack is now a TObjectList instead of TList

-2001-07-03  HeySt  1.0.11  Updated Compiler Version IFDEFs for Kylix

-2001-07-11  HeySt  1.0.12  New TCustomXmlScanner component (taken over from LibXmlComps.pas)

-2001-07-14  HeySt  1.0.13  Bugfix TCustomXmlScanner.FOnTranslateEncoding

-2001-10-22  HeySt          Don't clear CurName anymore when the parser finds a CDATA section.

-2001-12-03  HeySt  1.0.14  TObjectList.Clear: Make call to INHERITED method (fixes a memory leak)

-2001-12-05  HeySt  1.0.15  TObjectList.Clear: removed call to INHERITED method

-                           TObjectList.Destroy: Inserted SetCapacity call.

-                           Reduces need for frequent re-allocation of pointer buffer

-                           Dedicated to my father, Theodor Heymann

-2002-06-26  HeySt  1.0.16  TXmlParser.Scan: Fixed a bug with PIs whose name is beginning

-                           with 'xml'. Thanks to Uwe Kamm for submitting this bug.

-                           The CurEncoding property is now always in uppercase letters (the XML

-                           spec wants it to be treated case independently so when it's uppercase

-                           comparisons are faster)

-2002-03-04  HeySt  1.0.17  Included an IFDEF for Delphi 7 (VER150) and Kylix

-                           There is a new symbol HAS_CONTNRS_UNIT which is used now to

-                           distinguish between IDEs which come with the Contnrs unit and

-                           those that don't.

-*)

-

-UNIT libxmlparser;

-

-{$I jedi-sdl.inc}

-

-INTERFACE

-

-USES

-  SysUtils, Classes,

-  (*$IFDEF HAS_CONTNRS_UNIT *)  // The Contnrs Unit was introduced in Delphi 5

-  Contnrs,

-  (*$ENDIF*)

-  Math;

-

-CONST

-  CVersion = '1.0.17';  // This variable will be updated for every release

-                        // (I hope, I won't forget to do it everytime ...)

-

-TYPE

-  TPartType    = // --- Document Part Types

-                 (ptNone,            // Nothing

-                  ptXmlProlog,       // XML Prolog                  XmlSpec 2.8 / 4.3.1

-                  ptComment,         // Comment                     XmlSpec 2.5

-                  ptPI,              // Processing Instruction      XmlSpec 2.6

-                  ptDtdc,            // Document Type Declaration   XmlSpec 2.8

-                  ptStartTag,        // Start Tag                   XmlSpec 3.1

-                  ptEmptyTag,        // Empty-Element Tag           XmlSpec 3.1

-                  ptEndTag,          // End Tag                     XmlSpec 3.1

-                  ptContent,         // Text Content between Tags

-                  ptCData);          // CDATA Section               XmlSpec 2.7

-

-  TDtdElemType = // --- DTD Elements

-                 (deElement,         // !ELEMENT declaration

-                  deAttList,         // !ATTLIST declaration

-                  deEntity,          // !ENTITY declaration

-                  deNotation,        // !NOTATION declaration

-                  dePI,              // PI in DTD

-                  deComment,         // Comment in DTD

-                  deError);          // Error found in the DTD

-

-TYPE

-  TAttrList    = CLASS;

-  TEntityStack = CLASS;

-  TNvpList     = CLASS;

-  TElemDef     = CLASS;

-  TElemList    = CLASS;

-  TEntityDef   = CLASS;

-  TNotationDef = CLASS;

-

-  TDtdElementRec = RECORD    // --- This Record is returned by the DTD parser callback function

-                     Start, Final : PChar;                             // Start/End of the Element's Declaration

-                     CASE ElementType : TDtdElemType OF                // Type of the Element

-                       deElement,                                      // <!ELEMENT>

-                       deAttList  : (ElemDef      : TElemDef);         // <!ATTLIST>

-                       deEntity   : (EntityDef    : TEntityDef);       // <!ENTITY>

-                       deNotation : (NotationDef  : TNotationDef);     // <!NOTATION>

-                       dePI       : (Target       : PChar;             // <?PI ?>

-                                     Content      : PChar;

-                                     AttrList     : TAttrList);

-                       deError    : (Pos          : PChar);            // Error

-                       // deComment : ((No additional fields here));   // <!-- Comment -->

-                   END;

-

-  TXmlParser = CLASS                             // --- Internal Properties and Methods

-               PROTECTED

-                 FBuffer      : PChar;           // NIL if there is no buffer available

-                 FBufferSize  : INTEGER;         // 0 if the buffer is not owned by the Document instance

-                 FSource      : STRING;          // Name of Source of document. Filename for Documents loaded with LoadFromFile

-

-                 FXmlVersion  : STRING;          // XML version from Document header. Default is '1.0'

-                 FEncoding    : STRING;          // Encoding from Document header. Default is 'UTF-8'

-                 FStandalone  : BOOLEAN;         // Standalone declaration from Document header. Default is 'yes'

-                 FRootName    : STRING;          // Name of the Root Element (= DTD name)

-                 FDtdcFinal   : PChar;           // Pointer to the '>' character terminating the DTD declaration

-

-                 FNormalize   : BOOLEAN;         // If true: Pack Whitespace and don't return empty contents

-                 EntityStack  : TEntityStack;    // Entity Stack for Parameter and General Entities

-                 FCurEncoding : STRING;          // Current Encoding during parsing (always uppercase)

-

-                 PROCEDURE AnalyzeProlog;                                         // Analyze XML Prolog or Text Declaration

-                 PROCEDURE AnalyzeComment (Start : PChar; VAR Final : PChar);     // Analyze Comments

-                 PROCEDURE AnalyzePI      (Start : PChar; VAR Final : PChar);     // Analyze Processing Instructions (PI)

-                 PROCEDURE AnalyzeDtdc;                                           // Analyze Document Type Declaration

-                 PROCEDURE AnalyzeDtdElements (Start : PChar; VAR Final : PChar); // Analyze DTD declarations

-                 PROCEDURE AnalyzeTag;                                            // Analyze Start/End/Empty-Element Tags

-                 PROCEDURE AnalyzeCData;                                          // Analyze CDATA Sections

-                 PROCEDURE AnalyzeText (VAR IsDone : BOOLEAN);                    // Analyze Text Content between Tags

-                 PROCEDURE AnalyzeElementDecl  (Start : PChar; VAR Final : PChar);

-                 PROCEDURE AnalyzeAttListDecl  (Start : PChar; VAR Final : PChar);

-                 PROCEDURE AnalyzeEntityDecl   (Start : PChar; VAR Final : PChar);

-                 PROCEDURE AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);

-

-                 PROCEDURE PushPE (VAR Start : PChar);

-                 PROCEDURE ReplaceCharacterEntities (VAR Str : STRING);

-                 PROCEDURE ReplaceParameterEntities (VAR Str : STRING);

-                 PROCEDURE ReplaceGeneralEntities   (VAR Str : STRING);

-

-                 FUNCTION GetDocBuffer : PChar;  // Returns FBuffer or a pointer to a NUL char if Buffer is empty

-

-               PUBLIC                         // --- Document Properties

-                 PROPERTY XmlVersion : STRING  READ FXmlVersion;                 // XML version from the Document Prolog

-                 PROPERTY Encoding   : STRING  READ FEncoding;                   // Document Encoding from Prolog

-                 PROPERTY Standalone : BOOLEAN READ FStandalone;                 // Standalone Declaration from Prolog

-                 PROPERTY RootName   : STRING  READ FRootName;                   // Name of the Root Element

-                 PROPERTY Normalize  : BOOLEAN READ FNormalize WRITE FNormalize; // True if Content is to be normalized

-                 PROPERTY Source     : STRING  READ FSource;                     // Name of Document Source (Filename)

-                 PROPERTY DocBuffer  : PChar   READ GetDocBuffer;                // Returns document buffer

-               PUBLIC                         // --- DTD Objects

-                 Elements    : TElemList;     // Elements: List of TElemDef (contains Attribute Definitions)

-                 Entities    : TNvpList;      // General Entities: List of TEntityDef

-                 ParEntities : TNvpList;      // Parameter Entities: List of TEntityDef

-                 Notations   : TNvpList;      // Notations: List of TNotationDef

-               PUBLIC

-                 CONSTRUCTOR Create;

-                 DESTRUCTOR Destroy;                                      OVERRIDE;

-

-                 // --- Document Handling

-                 FUNCTION  LoadFromFile   (Filename : STRING;

-                                           FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;

-                                                                          // Loads Document from given file

-                 FUNCTION  LoadFromBuffer (Buffer : PChar) : BOOLEAN;     // Loads Document from another buffer

-                 PROCEDURE SetBuffer      (Buffer : PChar);               // References another buffer

-                 PROCEDURE Clear;                                         // Clear Document

-

-               PUBLIC

-                 // --- Scanning through the document

-                 CurPartType : TPartType;                         // Current Type

-                 CurName     : STRING;                            // Current Name

-                 CurContent  : STRING;                            // Current Normalized Content

-                 CurStart    : PChar;                             // Current First character

-                 CurFinal    : PChar;                             // Current Last character

-                 CurAttr     : TAttrList;                         // Current Attribute List

-                 PROPERTY CurEncoding : STRING READ FCurEncoding; // Current Encoding

-                 PROCEDURE StartScan;

-                 FUNCTION  Scan : BOOLEAN;

-

-                 // --- Events / Callbacks

-                 FUNCTION  LoadExternalEntity (SystemId, PublicId,

-                                               Notation : STRING) : TXmlParser;     VIRTUAL;

-                 FUNCTION  TranslateEncoding  (CONST Source : STRING) : STRING;     VIRTUAL;

-                 PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec);        VIRTUAL;

-               END;

-

-  TValueType   = // --- Attribute Value Type

-                 (vtNormal,       // Normal specified Attribute

-                  vtImplied,      // #IMPLIED attribute value

-                  vtFixed,        // #FIXED attribute value

-                  vtDefault);     // Attribute value from default value in !ATTLIST declaration

-

-  TAttrDefault = // --- Attribute Default Type

-                 (adDefault,      // Normal default value

-                  adRequired,     // #REQUIRED attribute

-                  adImplied,      // #IMPLIED attribute

-                  adFixed);       // #FIXED attribute

-

-  TAttrType    = // --- Type of attribute

-                 (atUnknown,      // Unknown type

-                  atCData,        // Character data only

-                  atID,           // ID

-                  atIdRef,        // ID Reference

-                  atIdRefs,       // Several ID References, separated by Whitespace

-                  atEntity,       // Name of an unparsed Entity

-                  atEntities,     // Several unparsed Entity names, separated by Whitespace

-                  atNmToken,      // Name Token

-                  atNmTokens,     // Several Name Tokens, separated by Whitespace

-                  atNotation,     // A selection of Notation names (Unparsed Entity)

-                  atEnumeration); // Enumeration

-

-  TElemType    = // --- Element content type

-                 (etEmpty,        // Element is always empty

-                  etAny,          // Element can have any mixture of PCDATA and any elements

-                  etChildren,     // Element must contain only elements

-                  etMixed);       // Mixed PCDATA and elements

-

-  (*$IFDEF HAS_CONTNRS_UNIT *)

-  TObjectList = Contnrs.TObjectList;    // Re-Export this identifier

-  (*$ELSE *)

-  TObjectList = CLASS (TList)

-                  DESTRUCTOR Destroy; OVERRIDE;

-                  PROCEDURE Delete (Index : INTEGER);

-                  PROCEDURE Clear; OVERRIDE;

-                END;

-  (*$ENDIF *)

-

-  TNvpNode  = CLASS                     // Name-Value Pair Node

-                 Name  : STRING;

-                 Value : STRING;

-                 CONSTRUCTOR Create (TheName : STRING = ''; TheValue : STRING = '');

-              END;

-

-  TNvpList  = CLASS (TObjectList)       // Name-Value Pair List

-                PROCEDURE Add   (Node  : TNvpNode);

-                FUNCTION  Node  (Name  : STRING)  : TNvpNode;  OVERLOAD;

-                FUNCTION  Node  (Index : INTEGER) : TNvpNode;  OVERLOAD;

-                FUNCTION  Value (Name  : STRING)  : STRING;    OVERLOAD;

-                FUNCTION  Value (Index : INTEGER) : STRING;    OVERLOAD;

-                FUNCTION  Name  (Index : INTEGER) : STRING;

-              END;

-

-  TAttr     = CLASS (TNvpNode)          // Attribute of a Start-Tag or Empty-Element-Tag

-                 ValueType : TValueType;

-                 AttrType  : TAttrType;

-               END;

-

-  TAttrList = CLASS (TNvpList)          // List of Attributes

-                PROCEDURE Analyze (Start : PChar; VAR Final : PChar);

-              END;

-

-  TEntityStack = CLASS (TObjectList)    // Stack where current position is stored before parsing entities

-                 PROTECTED

-                   Owner : TXmlParser;

-                 PUBLIC

-                   CONSTRUCTOR Create (TheOwner : TXmlParser);

-                   PROCEDURE Push (LastPos : PChar);                      OVERLOAD;

-                   PROCEDURE Push (Instance : TObject; LastPos : PChar);  OVERLOAD;

-                   FUNCTION  Pop : PChar;         // Returns next char or NIL if EOF is reached. Frees Instance.

-                 END;

-

-  TAttrDef    = CLASS (TNvpNode)        // Represents a <!ATTLIST Definition. "Value" is the default value

-                  TypeDef     : STRING;           // Type definition from the DTD

-                  Notations   : STRING;           // Notation List, separated by pipe symbols '|'

-                  AttrType    : TAttrType;        // Attribute Type

-                  DefaultType : TAttrDefault;     // Default Type

-                END;

-

-  TElemDef    = CLASS (TNvpList)       // Represents a <!ELEMENT Definition. Is a list of TAttrDef-Nodes

-                  Name       : STRING;            // Element name

-                  ElemType   : TElemType;         // Element type

-                  Definition : STRING;            // Element definition from DTD

-                END;

-

-  TElemList   = CLASS (TObjectList)    // List of TElemDef nodes

-                  FUNCTION  Node (Name : STRING) : TElemDef;

-                  PROCEDURE Add (Node : TElemDef);

-                END;

-

-  TEntityDef  = CLASS (TNvpNode)       // Represents a <!ENTITY Definition.

-                  SystemId     : STRING;

-                  PublicId     : STRING;

-                  NotationName : STRING;

-                END;

-

-  TNotationDef = CLASS (TNvpNode)      // Represents a <!NOTATION Definition. Value is the System ID

-                   PublicId : STRING;

-                 END;

-

-  TCharset = SET OF CHAR;

-

-

-CONST

-  CWhitespace   = [#32, #9, #13, #10];                // Whitespace characters (XmlSpec 2.3)

-  CLetter       = [#$41..#$5A, #$61..#$7A, #$C0..#$D6, #$D8..#$F6, #$F8..#$FF];

-  CDigit        = [#$30..#$39];

-  CNameChar     = CLetter + CDigit + ['.', '-', '_', ':', #$B7];

-  CNameStart    = CLetter + ['_', ':'];

-  CQuoteChar    = ['"', ''''];

-  CPubidChar    = [#32, ^M, ^J, #9, 'a'..'z', 'A'..'Z', '0'..'9',

-                   '-', '''', '(', ')', '+', ',', '.', '/', ':',

-                   '=', '?', ';', '!', '*', '#', '@', '$', '_', '%'];

-

-  CDStart       = '<![CDATA[';

-  CDEnd         = ']]>';

-

-  // --- Name Constants for the above enumeration types

-  CPartType_Name : ARRAY [TPartType] OF STRING =

-                   ('', 'XML Prolog', 'Comment', 'PI',

-                    'DTD Declaration', 'Start Tag', 'Empty Tag', 'End Tag',

-                    'Text', 'CDATA');

-  CValueType_Name   : ARRAY [TValueType]    OF STRING = ('Normal', 'Implied', 'Fixed', 'Default');

-  CAttrDefault_Name : ARRAY [TAttrDefault]  OF STRING = ('Default', 'Required', 'Implied', 'Fixed');

-  CElemType_Name    : ARRAY [TElemType]     OF STRING = ('Empty', 'Any', 'Childs only', 'Mixed');

-  CAttrType_Name    : ARRAY [TAttrType]     OF STRING = ('Unknown', 'CDATA',

-                                                         'ID', 'IDREF', 'IDREFS',

-                                                         'ENTITY', 'ENTITIES',

-                                                         'NMTOKEN', 'NMTOKENS',

-                                                         'Notation', 'Enumeration');

-

-FUNCTION  ConvertWs   (Source: STRING; PackWs: BOOLEAN) : STRING;          // Convert WS to spaces #x20

-PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar);  // SetString by Start/Final of buffer

-FUNCTION  StrSFPas    (Start, Finish : PChar) : STRING;                    // Convert buffer part to Pascal string

-FUNCTION  TrimWs      (Source : STRING) : STRING;                          // Trim Whitespace

-

-FUNCTION  AnsiToUtf8  (Source : ANSISTRING) : STRING;                            // Convert Win-1252 to UTF-8

-FUNCTION  Utf8ToAnsi  (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING;  // Convert UTF-8 to Win-1252

-

-

-(*

-===============================================================================================

-TCustomXmlScanner event based component wrapper for TXmlParser

-===============================================================================================

-*)

-

-TYPE

-  TCustomXmlScanner = CLASS;

-  TXmlPrologEvent   = PROCEDURE (Sender : TObject; XmlVersion, Encoding: STRING; Standalone : BOOLEAN) OF OBJECT;

-  TCommentEvent     = PROCEDURE (Sender : TObject; Comment : STRING)                                   OF OBJECT;

-  TPIEvent          = PROCEDURE (Sender : TObject; Target, Content: STRING; Attributes : TAttrList)    OF OBJECT;

-  TDtdEvent         = PROCEDURE (Sender : TObject; RootElementName : STRING)                           OF OBJECT;

-  TStartTagEvent    = PROCEDURE (Sender : TObject; TagName : STRING; Attributes : TAttrList)           OF OBJECT;

-  TEndTagEvent      = PROCEDURE (Sender : TObject; TagName : STRING)                                   OF OBJECT;

-  TContentEvent     = PROCEDURE (Sender : TObject; Content : STRING)                                   OF OBJECT;

-  TElementEvent     = PROCEDURE (Sender : TObject; ElemDef : TElemDef)                                 OF OBJECT;

-  TEntityEvent      = PROCEDURE (Sender : TObject; EntityDef : TEntityDef)                             OF OBJECT;

-  TNotationEvent    = PROCEDURE (Sender : TObject; NotationDef : TNotationDef)                         OF OBJECT;

-  TErrorEvent       = PROCEDURE (Sender : TObject; ErrorPos : PChar)                                   OF OBJECT;

-  TExternalEvent    = PROCEDURE (Sender : TObject; SystemId, PublicId, NotationId : STRING;

-                                 VAR Result : TXmlParser)                                              OF OBJECT;

-  TEncodingEvent    = FUNCTION  (Sender : TObject; CurrentEncoding, Source : STRING) : STRING          OF OBJECT;

-

-

-  TCustomXmlScanner = CLASS (TComponent)

-    PROTECTED

-      FXmlParser           : TXmlParser;

-      FOnXmlProlog         : TXmlPrologEvent;

-      FOnComment           : TCommentEvent;

-      FOnPI                : TPIEvent;

-      FOnDtdRead           : TDtdEvent;

-      FOnStartTag          : TStartTagEvent;

-      FOnEmptyTag          : TStartTagEvent;

-      FOnEndTag            : TEndTagEvent;

-      FOnContent           : TContentEvent;

-      FOnCData             : TContentEvent;

-      FOnElement           : TElementEvent;

-      FOnAttList           : TElementEvent;

-      FOnEntity            : TEntityEvent;

-      FOnNotation          : TNotationEvent;

-      FOnDtdError          : TErrorEvent;

-      FOnLoadExternal      : TExternalEvent;

-      FOnTranslateEncoding : TEncodingEvent;

-      FStopParser          : BOOLEAN;

-      FUNCTION  GetNormalize : BOOLEAN;

-      PROCEDURE SetNormalize (Value : BOOLEAN);

-

-      PROCEDURE WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN); VIRTUAL;

-      PROCEDURE WhenComment  (Comment : STRING);                                   VIRTUAL;

-      PROCEDURE WhenPI       (Target, Content: STRING; Attributes : TAttrList);    VIRTUAL;

-      PROCEDURE WhenDtdRead  (RootElementName : STRING);                           VIRTUAL;

-      PROCEDURE WhenStartTag (TagName : STRING; Attributes : TAttrList);           VIRTUAL;

-      PROCEDURE WhenEmptyTag (TagName : STRING; Attributes : TAttrList);           VIRTUAL;

-      PROCEDURE WhenEndTag   (TagName : STRING);                                   VIRTUAL;

-      PROCEDURE WhenContent  (Content : STRING);                                   VIRTUAL;

-      PROCEDURE WhenCData    (Content : STRING);                                   VIRTUAL;

-      PROCEDURE WhenElement  (ElemDef : TElemDef);                                 VIRTUAL;

-      PROCEDURE WhenAttList  (ElemDef : TElemDef);                                 VIRTUAL;

-      PROCEDURE WhenEntity   (EntityDef : TEntityDef);                             VIRTUAL;

-      PROCEDURE WhenNotation (NotationDef : TNotationDef);                         VIRTUAL;

-      PROCEDURE WhenDtdError (ErrorPos : PChar);                                   VIRTUAL;

-

-    PUBLIC

-      CONSTRUCTOR Create (AOwner: TComponent); OVERRIDE;

-      DESTRUCTOR Destroy;                      OVERRIDE;

-

-      PROCEDURE LoadFromFile   (Filename : TFilename);   // Load XML Document from file

-      PROCEDURE LoadFromBuffer (Buffer : PChar);         // Load XML Document from buffer

-      PROCEDURE SetBuffer      (Buffer : PChar);         // Refer to Buffer

-      FUNCTION  GetFilename : TFilename;

-

-      PROCEDURE Execute;                                 // Perform scanning

-

-    PROTECTED

-      PROPERTY XmlParser           : TXmlParser        READ FXmlParser;

-      PROPERTY StopParser          : BOOLEAN           READ FStopParser          WRITE FStopParser;

-      PROPERTY Filename            : TFilename         READ GetFilename          WRITE LoadFromFile;

-      PROPERTY Normalize           : BOOLEAN           READ GetNormalize         WRITE SetNormalize;

-      PROPERTY OnXmlProlog         : TXmlPrologEvent   READ FOnXmlProlog         WRITE FOnXmlProlog;

-      PROPERTY OnComment           : TCommentEvent     READ FOnComment           WRITE FOnComment;

-      PROPERTY OnPI                : TPIEvent          READ FOnPI                WRITE FOnPI;

-      PROPERTY OnDtdRead           : TDtdEvent         READ FOnDtdRead           WRITE FOnDtdRead;

-      PROPERTY OnStartTag          : TStartTagEvent    READ FOnStartTag          WRITE FOnStartTag;

-      PROPERTY OnEmptyTag          : TStartTagEvent    READ FOnEmptyTag          WRITE FOnEmptyTag;

-      PROPERTY OnEndTag            : TEndTagEvent      READ FOnEndTag            WRITE FOnEndTag;

-      PROPERTY OnContent           : TContentEvent     READ FOnContent           WRITE FOnContent;

-      PROPERTY OnCData             : TContentEvent     READ FOnCData             WRITE FOnCData;

-      PROPERTY OnElement           : TElementEvent     READ FOnElement           WRITE FOnElement;

-      PROPERTY OnAttList           : TElementEvent     READ FOnAttList           WRITE FOnAttList;

-      PROPERTY OnEntity            : TEntityEvent      READ FOnEntity            WRITE FOnEntity;

-      PROPERTY OnNotation          : TNotationEvent    READ FOnNotation          WRITE FOnNotation;

-      PROPERTY OnDtdError          : TErrorEvent       READ FOnDtdError          WRITE FOnDtdError;

-      PROPERTY OnLoadExternal      : TExternalEvent    READ FOnLoadExternal      WRITE FOnLoadExternal;

-      PROPERTY OnTranslateEncoding : TEncodingEvent    READ FOnTranslateEncoding WRITE FOnTranslateEncoding;

-    END;

-

-(*

-===============================================================================================

-IMPLEMENTATION

-===============================================================================================

-*)

-

-IMPLEMENTATION

-

-

-(*

-===============================================================================================

-Unicode and UTF-8 stuff

-===============================================================================================

-*)

-

-CONST

-  // --- Character Translation Table for Unicode <-> Win-1252

-  WIN1252_UNICODE : ARRAY [$00..$FF] OF WORD = (

-                    $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009,

-                    $000A, $000B, $000C, $000D, $000E, $000F, $0010, $0011, $0012, $0013,

-                    $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D,

-                    $001E, $001F, $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027,

-                    $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F, $0030, $0031,

-                    $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B,

-                    $003C, $003D, $003E, $003F, $0040, $0041, $0042, $0043, $0044, $0045,

-                    $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,

-                    $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059,

-                    $005A, $005B, $005C, $005D, $005E, $005F, $0060, $0061, $0062, $0063,

-                    $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D,

-                    $006E, $006F, $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077,

-                    $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,

-

-                    $20AC, $0081, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030,

-                    $0160, $2039, $0152, $008D, $017D, $008F, $0090, $2018, $2019, $201C,

-                    $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $009D,

-                    $017E, $0178, $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,

-                    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, $00B0, $00B1,

-                    $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB,

-                    $00BC, $00BD, $00BE, $00BF, $00C0, $00C1, $00C2, $00C3, $00C4, $00C5,

-                    $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,

-                    $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9,

-                    $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, $00E0, $00E1, $00E2, $00E3,

-                    $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED,

-                    $00EE, $00EF, $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,

-                    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF);

-

-(* UTF-8  (somewhat simplified)

-   -----

-   Character Range    Byte sequence

-   ---------------    --------------------------     (x=Bits from original character)

-   $0000..$007F       0xxxxxxx

-   $0080..$07FF       110xxxxx 10xxxxxx

-   $8000..$FFFF       1110xxxx 10xxxxxx 10xxxxxx

-

-   Example

-   --------

-   Transforming the Unicode character U+00E4 LATIN SMALL LETTER A WITH DIAERESIS  ("ä"):

-

-         ISO-8859-1,           Decimal  228

-         Win1252,              Hex      $E4

-         ANSI                  Bin      1110 0100

-                                        abcd efgh

-

-         UTF-8                 Binary   1100xxab 10cdefgh

-                               Binary   11000011 10100100

-                               Hex      $C3      $A4

-                               Decimal  195      164

-                               ANSI     Ã        ¤         *)

-

-

-FUNCTION  AnsiToUtf8 (Source : ANSISTRING) : STRING;

-          (* Converts the given Windows ANSI (Win1252) String to UTF-8. *)

-VAR

-  I   : INTEGER;  // Loop counter

-  U   : WORD;     // Current Unicode value

-  Len : INTEGER;  // Current real length of "Result" string

-BEGIN

-  SetLength (Result, Length (Source) * 3);   // Worst case

-  Len := 0;

-  FOR I := 1 TO Length (Source) DO BEGIN

-    U := WIN1252_UNICODE [ORD (Source [I])];

-    CASE U OF

-      $0000..$007F : BEGIN

-                       INC (Len);

-                       Result [Len] := CHR (U);

-                     END;

-      $0080..$07FF : BEGIN

-                       INC (Len);

-                       Result [Len] := CHR ($C0 OR (U SHR 6));

-                       INC (Len);

-                       Result [Len] := CHR ($80 OR (U AND $3F));

-                     END;

-      $0800..$FFFF : BEGIN

-                       INC (Len);

-                       Result [Len] := CHR ($E0 OR (U SHR 12));

-                       INC (Len);

-                       Result [Len] := CHR ($80 OR ((U SHR 6) AND $3F));

-                       INC (Len);

-                       Result [Len] := CHR ($80 OR (U AND $3F));

-                     END;

-      END;

-    END;

-  SetLength (Result, Len);

-END;

-

-

-FUNCTION  Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING;

-          (* Converts the given UTF-8 String to Windows ANSI (Win-1252).

-             If a character can not be converted, the "UnknownChar" is inserted. *)

-VAR

-  SourceLen : INTEGER;  // Length of Source string

-  I, K      : INTEGER;

-  A         : BYTE;     // Current ANSI character value

-  U         : WORD;

-  Ch        : CHAR;     // Dest char

-  Len       : INTEGER;  // Current real length of "Result" string

-BEGIN

-  SourceLen := Length (Source);

-  SetLength (Result, SourceLen);   // Enough room to live

-  Len := 0;

-  I   := 1;

-  WHILE I <= SourceLen DO BEGIN

-    A := ORD (Source [I]);

-    IF A < $80 THEN BEGIN                                               // Range $0000..$007F

-      INC (Len);

-      Result [Len] := Source [I];

-      INC (I);

-      END

-    ELSE BEGIN                                                          // Determine U, Inc I

-      IF (A AND $E0 = $C0) AND (I < SourceLen) THEN BEGIN               // Range $0080..$07FF

-        U := (WORD (A AND $1F) SHL 6) OR (ORD (Source [I+1]) AND $3F);

-        INC (I, 2);

-        END

-      ELSE IF (A AND $F0 = $E0) AND (I < SourceLen-1) THEN BEGIN        // Range $0800..$FFFF

-        U := (WORD (A AND $0F) SHL 12) OR

-             (WORD (ORD (Source [I+1]) AND $3F) SHL 6) OR

-             (      ORD (Source [I+2]) AND $3F);

-        INC (I, 3);

-        END

-      ELSE BEGIN                                                        // Unknown/unsupported

-        INC (I);

-        FOR K := 7 DOWNTO 0 DO

-          IF A AND (1 SHL K) = 0 THEN BEGIN

-            INC (I, (A SHR (K+1))-1);

-            BREAK;

-            END;

-        U := WIN1252_UNICODE [ORD (UnknownChar)];

-        END;

-      Ch := UnknownChar;                                                // Retrieve ANSI char

-      FOR A := $00 TO $FF DO

-        IF WIN1252_UNICODE [A] = U THEN BEGIN

-          Ch := CHR (A);

-          BREAK;

-          END;

-      INC (Len);

-      Result [Len] := Ch;

-      END;

-    END;

-  SetLength (Result, Len);

-END;

-

-

-(*

-===============================================================================================

-"Special" Helper Functions

-

-Don't ask me why. But including these functions makes the parser *DRAMATICALLY* faster

-on my K6-233 machine. You can test it yourself just by commenting them out.

-They do exactly the same as the Assembler routines defined in SysUtils.

-(This is where you can see how great the Delphi compiler really is. The compiled code is

-faster than hand-coded assembler!)

-===============================================================================================

---> Just move this line below the StrScan function -->  *)

-

-

-FUNCTION StrPos (CONST Str, SearchStr : PChar) : PChar;

-         // Same functionality as SysUtils.StrPos

-VAR

-  First : CHAR;

-  Len   : INTEGER;

-BEGIN

-  First  := SearchStr^;

-  Len    := StrLen (SearchStr);

-  Result := Str;

-  REPEAT

-    IF Result^ = First THEN

-      IF StrLComp (Result, SearchStr, Len) = 0 THEN BREAK;

-    IF Result^ = #0 THEN BEGIN

-      Result := NIL;

-      BREAK;

-      END;

-    INC (Result);

-  UNTIL FALSE;

-END;

-

-

-FUNCTION StrScan (CONST Start : PChar; CONST Ch : CHAR) : PChar;

-         // Same functionality as SysUtils.StrScan

-BEGIN

-  Result := Start;

-  WHILE Result^ <> Ch DO BEGIN

-    IF Result^ = #0 THEN BEGIN

-      Result := NIL;

-      EXIT;

-      END;

-    INC (Result);

-    END;

-END;

-

-

-(*

-===============================================================================================

-Helper Functions

-===============================================================================================

-*)

-

-FUNCTION  DelChars (Source : STRING; CharsToDelete : TCharset) : STRING;

-          // Delete all "CharsToDelete" from the string

-VAR

-  I : INTEGER;

-BEGIN

-  Result := Source;

-  FOR I := Length (Result) DOWNTO 1 DO

-    IF Result [I] IN CharsToDelete THEN

-      Delete (Result, I, 1);

-END;

-

-

-FUNCTION  TrimWs (Source : STRING) : STRING;

-          // Trimms off Whitespace characters from both ends of the string

-VAR

-  I : INTEGER;

-BEGIN

-  // --- Trim Left

-  I := 1;

-  WHILE (I <= Length (Source)) AND (Source [I] IN CWhitespace) DO

-    INC (I);

-  Result := Copy (Source, I, MaxInt);

-

-  // --- Trim Right

-  I := Length (Result);

-  WHILE (I > 1) AND (Result [I] IN CWhitespace) DO

-    DEC (I);

-  Delete (Result, I+1, Length (Result)-I);

-END;

-

-

-FUNCTION  ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING;

-          // Converts all Whitespace characters to the Space #x20 character

-          // If "PackWs" is true, contiguous Whitespace characters are packed to one

-VAR

-  I : INTEGER;

-BEGIN

-  Result := Source;

-  FOR I := Length (Result) DOWNTO 1 DO

-    IF (Result [I] IN CWhitespace) THEN

-      IF PackWs AND (I > 1) AND (Result [I-1] IN CWhitespace)

-        THEN Delete (Result, I, 1)

-        ELSE Result [I] := #32;

-END;

-

-

-PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar);

-BEGIN

-  SetString (S, BufferStart, BufferFinal-BufferStart+1);

-END;

-

-

-FUNCTION  StrLPas  (Start : PChar; Len : INTEGER) : STRING;

-BEGIN

-  SetString (Result, Start, Len);

-END;

-

-

-FUNCTION  StrSFPas (Start, Finish : PChar) : STRING;

-BEGIN

-  SetString (Result, Start, Finish-Start+1);

-END;

-

-

-FUNCTION  StrScanE (CONST Source : PChar; CONST CharToScanFor : CHAR) : PChar;

-          // If "CharToScanFor" is not found, StrScanE returns the last char of the

-          // buffer instead of NIL

-BEGIN

-  Result := StrScan (Source, CharToScanFor);

-  IF Result = NIL THEN

-    Result := StrEnd (Source)-1;

-END;

-

-

-PROCEDURE ExtractName (Start : PChar; Terminators : TCharset; VAR Final : PChar);

-          (* Extracts the complete Name beginning at "Start".

-             It is assumed that the name is contained in Markup, so the '>' character is

-             always a Termination.

-             Start:       IN  Pointer to first char of name. Is always considered to be valid

-             Terminators: IN  Characters which terminate the name

-             Final:       OUT Pointer to last char of name *)

-BEGIN

-  Final := Start+1;

-  Include (Terminators, #0);

-  Include (Terminators, '>');

-  WHILE NOT (Final^ IN Terminators) DO

-    INC (Final);

-  DEC (Final);

-END;

-

-

-PROCEDURE ExtractQuote (Start : PChar; VAR Content : STRING; VAR Final : PChar);

-          (* Extract a string which is contained in single or double Quotes.

-             Start:    IN   Pointer to opening quote

-             Content:  OUT  The quoted string

-             Final:    OUT  Pointer to closing quote *)

-BEGIN

-  Final := StrScan (Start+1, Start^);

-  IF Final = NIL THEN BEGIN

-    Final := StrEnd (Start+1)-1;

-    SetString (Content, Start+1, Final-Start);

-    END

-  ELSE

-    SetString (Content, Start+1, Final-1-Start);

-END;

-

-

-(*

-===============================================================================================

-TEntityStackNode

-This Node is pushed to the "Entity Stack" whenever the parser parses entity replacement text.

-The "Instance" field holds the Instance pointer of an External Entity buffer. When it is

-popped, the Instance is freed.

-The "Encoding" field holds the name of the Encoding. External Parsed Entities may have

-another encoding as the document entity (XmlSpec 4.3.3). So when there is an "<?xml" PI

-found in the stream (= Text Declaration at the beginning of external parsed entities), the

-Encoding found there is used for the External Entity (is assigned to TXmlParser.CurEncoding)

-Default Encoding is for the Document Entity is UTF-8. It is assumed that External Entities

-have the same Encoding as the Document Entity, unless they carry a Text Declaration.

-===============================================================================================

-*)

-

-TYPE

-  TEntityStackNode = CLASS

-                       Instance : TObject;

-                       Encoding : STRING;

-                       LastPos  : PChar;

-                     END;

-

-(*

-===============================================================================================

-TEntityStack

-For nesting of Entities.

-When there is an entity reference found in the data stream, the corresponding entity

-definition is searched and the current position is pushed to this stack.

-From then on, the program scans the entitiy replacement text as if it were normal content.

-When the parser reaches the end of an entity, the current position is popped off the

-stack again.

-===============================================================================================

-*)

-

-CONSTRUCTOR TEntityStack.Create (TheOwner : TXmlParser);

-BEGIN

-  INHERITED Create;

-  Owner := TheOwner;

-END;

-

-

-PROCEDURE TEntityStack.Push (LastPos : PChar);

-BEGIN

-  Push (NIL, LastPos);

-END;

-

-

-PROCEDURE TEntityStack.Push (Instance : TObject; LastPos : PChar);

-VAR

-  ESN : TEntityStackNode;

-BEGIN

-  ESN := TEntityStackNode.Create;

-  ESN.Instance := Instance;

-  ESN.Encoding := Owner.FCurEncoding;  // Save current Encoding

-  ESN.LastPos  := LastPos;

-  Add (ESN);

-END;

-

-

-FUNCTION  TEntityStack.Pop : PChar;

-VAR

-  ESN : TEntityStackNode;

-BEGIN

-  IF Count > 0 THEN BEGIN

-    ESN := TEntityStackNode (Items [Count-1]);

-    Result := ESN.LastPos;

-    IF ESN.Instance <> NIL THEN

-      ESN.Instance.Free;

-    IF ESN.Encoding <> '' THEN

-      Owner.FCurEncoding := ESN.Encoding;   // Restore current Encoding

-    Delete (Count-1);

-    END

-  ELSE

-    Result := NIL;

-END;

-

-

-(*

-===============================================================================================

-TExternalID

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

-XmlSpec 4.2.2:  ExternalID ::= 'SYSTEM' S SystemLiteral |

-                               'PUBLIC' S PubidLiteral S SystemLiteral

-XmlSpec 4.7:    PublicID   ::= 'PUBLIC' S PubidLiteral

-SystemLiteral and PubidLiteral are quoted

-===============================================================================================

-*)

-

-TYPE

-  TExternalID = CLASS

-                  PublicId : STRING;

-                  SystemId : STRING;

-                  Final    : PChar;

-                  CONSTRUCTOR Create (Start : PChar);

-                END;

-

-CONSTRUCTOR TExternalID.Create (Start : PChar);

-BEGIN

-  INHERITED Create;

-  Final := Start;

-  IF StrLComp (Start, 'SYSTEM', 6) = 0 THEN BEGIN

-    WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);

-    IF NOT (Final^ IN CQuoteChar) THEN EXIT;

-    ExtractQuote (Final, SystemID, Final);

-    END

-  ELSE IF StrLComp (Start, 'PUBLIC', 6) = 0 THEN BEGIN

-    WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);

-    IF NOT (Final^ IN CQuoteChar) THEN EXIT;

-    ExtractQuote (Final, PublicID, Final);

-    INC (Final);

-    WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);

-    IF NOT (Final^ IN CQuoteChar) THEN EXIT;

-    ExtractQuote (Final, SystemID, Final);

-    END;

-END;

-

-

-(*

-===============================================================================================

-TXmlParser

-===============================================================================================

-*)

-

-CONSTRUCTOR TXmlParser.Create;

-BEGIN

-  INHERITED Create;

-  FBuffer     := NIL;

-  FBufferSize := 0;

-  Elements    := TElemList.Create;

-  Entities    := TNvpList.Create;

-  ParEntities := TNvpList.Create;

-  Notations   := TNvpList.Create;

-  CurAttr     := TAttrList.Create;

-  EntityStack := TEntityStack.Create (Self);

-  Clear;

-END;

-

-

-DESTRUCTOR TXmlParser.Destroy;

-BEGIN

-  Clear;

-  Elements.Free;

-  Entities.Free;

-  ParEntities.Free;

-  Notations.Free;

-  CurAttr.Free;

-  EntityStack.Free;

-  INHERITED Destroy;

-END;

-

-

-PROCEDURE TXmlParser.Clear;

-          // Free Buffer and clear all object attributes

-BEGIN

-  IF (FBufferSize > 0) AND (FBuffer <> NIL) THEN

-    FreeMem (FBuffer);

-  FBuffer     := NIL;

-  FBufferSize := 0;

-  FSource     := '';

-  FXmlVersion := '';

-  FEncoding   := '';

-  FStandalone := FALSE;

-  FRootName   := '';

-  FDtdcFinal  := NIL;

-  FNormalize  := TRUE;

-  Elements.Clear;

-  Entities.Clear;

-  ParEntities.Clear;

-  Notations.Clear;

-  CurAttr.Clear;

-  EntityStack.Clear;

-END;

-

-

-FUNCTION  TXmlParser.LoadFromFile (Filename : STRING; FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;

-          // Loads Document from given file

-          // Returns TRUE if successful

-VAR

-  f           : FILE;

-  ReadIn      : INTEGER;

-  OldFileMode : INTEGER;

-BEGIN

-  Result := FALSE;

-  Clear;

-

-  // --- Open File

-  OldFileMode := SYSTEM.FileMode;

-  TRY

-    SYSTEM.FileMode := FileMode;

-    TRY

-      AssignFile (f, Filename);

-      Reset (f, 1);

-    EXCEPT

-      EXIT;

-      END;

-

-    TRY

-      // --- Allocate Memory

-      TRY

-        FBufferSize := Filesize (f) + 1;

-        GetMem (FBuffer, FBufferSize);

-      EXCEPT

-        Clear;

-        EXIT;

-        END;

-

-      // --- Read File

-      TRY

-        BlockRead (f, FBuffer^, FBufferSize, ReadIn);

-        (FBuffer+ReadIn)^ := #0;  // NULL termination

-      EXCEPT

-        Clear;

-        EXIT;

-        END;

-    FINALLY

-      CloseFile (f);

-      END;

-

-    FSource := Filename;

-    Result  := TRUE;

-

-  FINALLY

-    SYSTEM.FileMode := OldFileMode;

-    END;

-END;

-

-

-FUNCTION  TXmlParser.LoadFromBuffer (Buffer : PChar) : BOOLEAN;

-          // Loads Document from another buffer

-          // Returns TRUE if successful

-          // The "Source" property becomes '<MEM>' if successful

-BEGIN

-  Result := FALSE;

-  Clear;

-  FBufferSize := StrLen (Buffer) + 1;

-  TRY

-    GetMem (FBuffer, FBufferSize);

-  EXCEPT

-    Clear;

-    EXIT;

-    END;

-  StrCopy (FBuffer, Buffer);

-  FSource := '<MEM>';

-  Result := TRUE;

-END;

-

-

-PROCEDURE TXmlParser.SetBuffer (Buffer : PChar);      // References another buffer

-BEGIN

-  Clear;

-  FBuffer     := Buffer;

-  FBufferSize := 0;

-  FSource := '<REFERENCE>';

-END;

-

-

-//-----------------------------------------------------------------------------------------------

-// Scanning through the document

-//-----------------------------------------------------------------------------------------------

-

-PROCEDURE TXmlParser.StartScan;

-BEGIN

-  CurPartType := ptNone;

-  CurName     := '';

-  CurContent  := '';

-  CurStart    := NIL;

-  CurFinal    := NIL;

-  CurAttr.Clear;

-  EntityStack.Clear;

-END;

-

-

-FUNCTION  TXmlParser.Scan : BOOLEAN;

-          // Scans the next Part

-          // Returns TRUE if a part could be found, FALSE if there is no part any more

-          //

-          // "IsDone" can be set to FALSE by AnalyzeText in order to go to the next part

-          // if there is no Content due to normalization

-VAR

-  IsDone : BOOLEAN;

-BEGIN

-  REPEAT

-    IsDone := TRUE;

-

-    // --- Start of next Part

-    IF CurStart = NIL

-      THEN CurStart := DocBuffer

-      ELSE CurStart := CurFinal+1;

-    CurFinal := CurStart;

-

-    // --- End of Document of Pop off a new part from the Entity stack?

-    IF CurStart^ = #0 THEN

-      CurStart := EntityStack.Pop;

-

-    // --- No Document or End Of Document: Terminate Scan

-    IF (CurStart = NIL) OR (CurStart^ = #0) THEN BEGIN

-      CurStart := StrEnd (DocBuffer);

-      CurFinal := CurStart-1;

-      EntityStack.Clear;

-      Result   := FALSE;

-      EXIT;

-      END;

-

-    IF (StrLComp (CurStart, '<?xml', 5) = 0) AND

-       ((CurStart+5)^ IN CWhitespace) THEN AnalyzeProlog                                      // XML Declaration, Text Declaration

-    ELSE IF StrLComp (CurStart, '<?',        2) = 0 THEN AnalyzePI (CurStart, CurFinal)       // PI

-    ELSE IF StrLComp (CurStart, '<!--',      4) = 0 THEN AnalyzeComment (CurStart, CurFinal)  // Comment

-    ELSE IF StrLComp (CurStart, '<!DOCTYPE', 9) = 0 THEN AnalyzeDtdc                          // DTDc

-    ELSE IF StrLComp (CurStart, CDStart, Length (CDStart)) = 0 THEN AnalyzeCdata              // CDATA Section

-    ELSE IF StrLComp (CurStart, '<',         1) = 0 THEN AnalyzeTag                           // Start-Tag, End-Tag, Empty-Element-Tag

-    ELSE AnalyzeText (IsDone);                                                                // Text Content

-  UNTIL IsDone;

-  Result := TRUE;

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeProlog;

-          // Analyze XML Prolog or Text Declaration

-VAR

-  F : PChar;

-BEGIN

-  CurAttr.Analyze (CurStart+5, F);

-  IF EntityStack.Count = 0 THEN BEGIN

-    FXmlVersion := CurAttr.Value ('version');

-    FEncoding   := CurAttr.Value ('encoding');

-    FStandalone := CurAttr.Value ('standalone') = 'yes';

-    END;

-  CurFinal := StrPos (F, '?>');

-  IF CurFinal <> NIL

-    THEN INC (CurFinal)

-    ELSE CurFinal := StrEnd (CurStart)-1;

-  FCurEncoding := AnsiUpperCase (CurAttr.Value ('encoding'));

-  IF FCurEncoding = '' THEN

-    FCurEncoding := 'UTF-8';   // Default XML Encoding is UTF-8

-  CurPartType  := ptXmlProlog;

-  CurName      := '';

-  CurContent   := '';

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeComment (Start : PChar; VAR Final : PChar);

-          // Analyze Comments

-BEGIN

-  Final := StrPos (Start+4, '-->');

-  IF Final = NIL

-    THEN Final := StrEnd (Start)-1

-    ELSE INC (Final, 2);

-  CurPartType := ptComment;

-END;

-

-

-PROCEDURE TXmlParser.AnalyzePI (Start : PChar; VAR Final : PChar);

-          // Analyze Processing Instructions (PI)

-          // This is also called for Character

-VAR

-  F : PChar;

-BEGIN

-  CurPartType := ptPI;

-  Final := StrPos (Start+2, '?>');

-  IF Final = NIL

-    THEN Final := StrEnd (Start)-1

-    ELSE INC (Final);

-  ExtractName (Start+2, CWhitespace + ['?', '>'], F);

-  SetStringSF (CurName, Start+2, F);

-  SetStringSF (CurContent, F+1, Final-2);

-  CurAttr.Analyze (F+1, F);

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeDtdc;

-          (* Analyze Document Type Declaration

-                 doctypedecl  ::= '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>'

-                 markupdecl   ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment

-                 PEReference  ::= '%' Name ';'

-

-                 elementdecl  ::= '<!ELEMENT' S Name S contentspec S?                    '>'

-                 AttlistDecl  ::= '<!ATTLIST' S Name AttDef* S?                          '>'

-                 EntityDecl   ::= '<!ENTITY' S Name S EntityDef S?                       '>' |

-                                  '<!ENTITY' S '%' S Name S PEDef S?                     '>'

-                 NotationDecl ::= '<!NOTATION' S Name S (ExternalID |  PublicID) S?      '>'

-                 PI           ::=  '<?' PITarget (S (Char* - (Char* '?>' Char* )))?     '?>'

-                 Comment      ::= '<!--' ((Char - '-') | ('-' (Char - '-')))*          '-->'  *)

-TYPE

-  TPhase = (phName, phDtd, phInternal, phFinishing);

-VAR

-  Phase       : TPhase;

-  F           : PChar;

-  ExternalID  : TExternalID;

-  ExternalDTD : TXmlParser;

-  DER         : TDtdElementRec;

-BEGIN

-  DER.Start := CurStart;

-  EntityStack.Clear;    // Clear stack for Parameter Entities

-  CurPartType := ptDtdc;

-

-  // --- Don't read DTDc twice

-  IF FDtdcFinal <> NIL THEN BEGIN

-    CurFinal := FDtdcFinal;

-    EXIT;

-    END;

-

-  // --- Scan DTDc

-  CurFinal := CurStart + 9;    // First char after '<!DOCTYPE'

-  Phase    := phName;

-  REPEAT

-    CASE CurFinal^ OF

-      '%' : BEGIN

-              PushPE (CurFinal);

-              CONTINUE;

-            END;

-      #0  : IF EntityStack.Count = 0 THEN

-              BREAK

-            ELSE BEGIN

-              CurFinal := EntityStack.Pop;

-              CONTINUE;

-              END;

-      '[' : BEGIN

-              Phase := phInternal;

-              AnalyzeDtdElements (CurFinal+1, CurFinal);

-              CONTINUE;

-            END;

-      ']' : Phase := phFinishing;

-      '>' : BREAK;

-      ELSE  IF NOT (CurFinal^ IN CWhitespace) THEN BEGIN

-              CASE Phase OF

-                phName : IF (CurFinal^ IN CNameStart)  THEN BEGIN

-                           ExtractName (CurFinal, CWhitespace + ['[', '>'], F);

-                           SetStringSF (FRootName, CurFinal, F);

-                           CurFinal := F;

-                           Phase := phDtd;

-                           END;

-                phDtd  : IF (StrLComp (CurFinal, 'SYSTEM', 6) = 0) OR

-                            (StrLComp (CurFinal, 'PUBLIC', 6) = 0) THEN BEGIN

-                           ExternalID  := TExternalID.Create (CurFinal);

-                           ExternalDTD := LoadExternalEntity (ExternalId.SystemId, ExternalID.PublicId, '');

-                           F := StrPos (ExternalDtd.DocBuffer, '<!');

-                           IF F <> NIL THEN

-                             AnalyzeDtdElements (F, F);

-                           ExternalDTD.Free;

-                           CurFinal := ExternalID.Final;

-                           ExternalID.Free;

-                           END;

-                ELSE     BEGIN

-                           DER.ElementType := deError;

-                           DER.Pos         := CurFinal;

-                           DER.Final       := CurFinal;

-                           DtdElementFound (DER);

-                         END;

-                END;

-

-              END;

-      END;

-    INC (CurFinal);

-  UNTIL FALSE;

-

-  CurPartType := ptDtdc;

-  CurName     := '';

-  CurContent  := '';

-

-  // It is an error in the document if "EntityStack" is not empty now

-  IF EntityStack.Count > 0 THEN BEGIN

-    DER.ElementType := deError;

-    DER.Final       := CurFinal;

-    DER.Pos         := CurFinal;

-    DtdElementFound (DER);

-    END;

-

-  EntityStack.Clear;    // Clear stack for General Entities

-  FDtdcFinal := CurFinal;

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeDtdElements (Start : PChar; VAR Final : PChar);

-          // Analyze the "Elements" of a DTD contained in the external or

-          // internal DTD subset.

-VAR

-  DER : TDtdElementRec;

-BEGIN

-  Final := Start;

-  REPEAT

-    CASE Final^ OF

-      '%' : BEGIN

-              PushPE (Final);

-              CONTINUE;

-            END;

-      #0  : IF EntityStack.Count = 0 THEN

-              BREAK

-            ELSE BEGIN

-              CurFinal := EntityStack.Pop;

-              CONTINUE;

-              END;

-      ']',

-      '>' : BREAK;

-      '<' : IF      StrLComp (Final, '<!ELEMENT',   9) = 0 THEN AnalyzeElementDecl  (Final, Final)

-            ELSE IF StrLComp (Final, '<!ATTLIST',   9) = 0 THEN AnalyzeAttListDecl  (Final, Final)

-            ELSE IF StrLComp (Final, '<!ENTITY',    8) = 0 THEN AnalyzeEntityDecl   (Final, Final)

-            ELSE IF StrLComp (Final, '<!NOTATION', 10) = 0 THEN AnalyzeNotationDecl (Final, Final)

-            ELSE IF StrLComp (Final, '<?',          2) = 0 THEN BEGIN   // PI in DTD

-              DER.ElementType := dePI;

-              DER.Start       := Final;

-              AnalyzePI (Final, Final);

-              DER.Target      := PChar (CurName);

-              DER.Content     := PChar (CurContent);

-              DER.AttrList    := CurAttr;

-              DER.Final       := Final;

-              DtdElementFound (DER);

-              END

-            ELSE IF StrLComp (Final, '<!--', 4) = 0 THEN BEGIN   // Comment in DTD

-              DER.ElementType := deComment;

-              DER.Start       := Final;

-              AnalyzeComment  (Final, Final);

-              DER.Final       := Final;

-              DtdElementFound (DER);

-              END

-            ELSE BEGIN

-              DER.ElementType := deError;

-              DER.Start       := Final;

-              DER.Pos         := Final;

-              DER.Final       := Final;

-              DtdElementFound (DER);

-              END;

-

-      END;

-    INC (Final);

-  UNTIL FALSE;

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeTag;

-          // Analyze Tags

-VAR

-  S, F    : PChar;

-  Attr    : TAttr;

-  ElemDef : TElemDef;

-  AttrDef : TAttrDef;

-  I       : INTEGER;

-BEGIN

-  CurPartType := ptStartTag;

-  S := CurStart+1;

-  IF S^ = '/' THEN BEGIN

-    CurPartType := ptEndTag;

-    INC (S);

-    END;

-  ExtractName (S, CWhitespace + ['/'], F);

-  SetStringSF (CurName, S, F);

-  CurAttr.Analyze (F+1, CurFinal);

-  IF CurFinal^ = '/' THEN BEGIN

-    CurPartType := ptEmptyTag;

-    END;

-  CurFinal := StrScanE (CurFinal, '>');

-

-  // --- Set Default Attribute values for nonexistent attributes

-  IF (CurPartType = ptStartTag) OR (CurPartType = ptEmptyTag) THEN BEGIN

-    ElemDef := Elements.Node (CurName);

-    IF ElemDef <> NIL THEN BEGIN

-      FOR I := 0 TO ElemDef.Count-1 DO BEGIN

-        AttrDef := TAttrDef (ElemDef [I]);

-        Attr := TAttr (CurAttr.Node (AttrDef.Name));

-        IF (Attr = NIL) AND (AttrDef.Value <> '') THEN BEGIN

-          Attr           := TAttr.Create (AttrDef.Name, AttrDef.Value);

-          Attr.ValueType := vtDefault;

-          CurAttr.Add (Attr);

-          END;

-        IF Attr <> NIL THEN BEGIN

-          CASE AttrDef.DefaultType OF

-            adDefault  : ;

-            adRequired : ; // -!- It is an error in the document if "Attr.Value" is an empty string

-            adImplied  : Attr.ValueType := vtImplied;

-            adFixed    : BEGIN

-                           Attr.ValueType := vtFixed;

-                           Attr.Value     := AttrDef.Value;

-                         END;

-            END;

-          Attr.AttrType := AttrDef.AttrType;

-          END;

-        END;

-      END;

-

-    // --- Normalize Attribute Values. XmlSpec:

-           // - a character reference is processed by appending the referenced character to the attribute value

-           // - an entity reference is processed by recursively processing the replacement text of the entity

-           // - a whitespace character (#x20, #xD, #xA, #x9) is processed by appending #x20 to the normalized value,

-           //   except that only a single #x20 is appended for a "#xD#xA" sequence that is part of an external

-           //   parsed entity or the literal entity value of an internal parsed entity

-           // - other characters are processed by appending them to the normalized value

-           // If the declared value is not CDATA, then the XML processor must further process the

-           // normalized attribute value by discarding any leading and trailing space (#x20) characters,

-           // and by replacing sequences of space (#x20) characters by a single space (#x20) character.

-           // All attributes for which no declaration has been read should be treated by a

-           // non-validating parser as if declared CDATA.

-           // !!! The XML 1.0 SE specification is somewhat different here

-           //     This code does not conform exactly to this specification

-    FOR I := 0 TO CurAttr.Count-1 DO

-      WITH TAttr (CurAttr [I]) DO BEGIN

-        ReplaceGeneralEntities   (Value);

-        ReplaceCharacterEntities (Value);

-        IF (AttrType <> atCData) AND (AttrType <> atUnknown)

-          THEN Value := TranslateEncoding (TrimWs (ConvertWs (Value, TRUE)))

-          ELSE Value := TranslateEncoding (ConvertWs (Value, FALSE));

-        END;

-    END;

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeCData;

-          // Analyze CDATA Sections

-BEGIN

-  CurPartType := ptCData;

-  CurFinal := StrPos (CurStart, CDEnd);

-  IF CurFinal = NIL THEN BEGIN

-    CurFinal   := StrEnd (CurStart)-1;

-    CurContent := TranslateEncoding (StrPas (CurStart+Length (CDStart)));

-    END

-  ELSE BEGIN

-    SetStringSF (CurContent, CurStart+Length (CDStart), CurFinal-1);

-    INC (CurFinal, Length (CDEnd)-1);

-    CurContent := TranslateEncoding (CurContent);

-    END;

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeText (VAR IsDone : BOOLEAN);

-          (* Analyzes Text Content between Tags. CurFinal will point to the last content character.

-             Content ends at a '<' character or at the end of the document.

-             Entity References and Character Entity references are resolved.

-             If PackSpaces is TRUE, contiguous Whitespace Characters will be compressed to

-             one Space #x20 character, Whitespace at the beginning and end of content will

-             be trimmed off and content which is or becomes empty is not returned to

-             the application (in this case, "IsDone" is set to FALSE which causes the

-             Scan method to proceed directly to the next part. *)

-

-  PROCEDURE ProcessEntity;

-            (* Is called if there is an ampsersand '&' character found in the document.

-               IN  "CurFinal" points to the ampersand

-               OUT "CurFinal" points to the first character after the semi-colon ';' *)

-  VAR

-    P              : PChar;

-    Name           : STRING;

-    EntityDef      : TEntityDef;

-    ExternalEntity : TXmlParser;

-  BEGIN

-    P := StrScan (CurFinal , ';');

-    IF P <> NIL THEN BEGIN

-      SetStringSF (Name, CurFinal+1, P-1);

-

-      // Is it a Character Entity?

-      IF (CurFinal+1)^ = '#' THEN BEGIN

-        IF UpCase ((CurFinal+2)^) = 'X'       // !!! Can't use "CHR" for Unicode characters > 255:

-          THEN CurContent := CurContent + CHR (StrToIntDef ('$'+Copy (Name, 3, MaxInt), 32))

-          ELSE CurContent := CurContent + CHR (StrToIntDef (Copy (Name, 2, MaxInt), 32));

-        CurFinal := P+1;

-        EXIT;

-        END

-

-      // Is it a Predefined Entity?

-      ELSE IF Name = 'lt'   THEN BEGIN CurContent := CurContent + '<';  CurFinal := P+1; EXIT; END

-      ELSE IF Name = 'gt'   THEN BEGIN CurContent := CurContent + '>';  CurFinal := P+1; EXIT; END

-      ELSE IF Name = 'amp'  THEN BEGIN CurContent := CurContent + '&';  CurFinal := P+1; EXIT; END

-      ELSE IF Name = 'apos' THEN BEGIN CurContent := CurContent + ''''; CurFinal := P+1; EXIT; END

-      ELSE IF Name = 'quot' THEN BEGIN CurContent := CurContent + '"';  CurFinal := P+1; EXIT; END;

-

-      // Replace with Entity from DTD

-      EntityDef := TEntityDef (Entities.Node (Name));

-      IF EntityDef <> NIL THEN BEGIN

-        IF EntityDef.Value <> '' THEN BEGIN

-          EntityStack.Push (P+1);

-          CurFinal := PChar (EntityDef.Value);

-          END

-        ELSE BEGIN

-          ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);

-          EntityStack.Push (ExternalEntity, P+1);

-          CurFinal := ExternalEntity.DocBuffer;

-          END;

-        END

-      ELSE BEGIN

-        CurContent := CurContent + Name;

-        CurFinal   := P+1;

-        END;

-      END

-    ELSE BEGIN

-      INC (CurFinal);

-      END;

-  END;

-

-VAR

-  C  : INTEGER;

-BEGIN

-  CurFinal    := CurStart;

-  CurPartType := ptContent;

-  CurContent  := '';

-  C           := 0;

-  REPEAT

-    CASE CurFinal^ OF

-      '&' : BEGIN

-              CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));

-              C := 0;

-              ProcessEntity;

-              CONTINUE;

-            END;

-      #0  : BEGIN

-              IF EntityStack.Count = 0 THEN

-                BREAK

-              ELSE BEGIN

-                CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));

-                C := 0;

-                CurFinal := EntityStack.Pop;

-                CONTINUE;

-                END;

-            END;

-      '<' : BREAK;

-      ELSE INC (C);

-      END;

-    INC (CurFinal);

-  UNTIL FALSE;

-  CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));

-  DEC (CurFinal);

-

-  IF FNormalize THEN BEGIN

-    CurContent := ConvertWs (TrimWs (CurContent), TRUE);

-    IsDone     := CurContent <> '';    // IsDone will only get FALSE if PackSpaces is TRUE

-    END;

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeElementDecl  (Start : PChar; VAR Final : PChar);

-          (* Parse <!ELEMENT declaration starting at "Start"

-             Final must point to the terminating '>' character

-             XmlSpec 3.2:

-                 elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>'

-                 contentspec ::= 'EMPTY' | 'ANY' | Mixed | children

-                 Mixed       ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*'   |

-                                 '(' S? '#PCDATA' S? ')'

-                 children    ::= (choice | seq) ('?' | '*' | '+')?

-                 choice      ::= '(' S? cp ( S? '|' S? cp )* S? ')'

-                 cp          ::= (Name | choice | seq) ('?' | '*' | '+')?

-                 seq         ::= '(' S? cp ( S? ',' S? cp )* S? ')'

-

-             More simply:

-                 contentspec ::= EMPTY

-                                 ANY

-                                 '(#PCDATA)'

-                                 '(#PCDATA | A | B)*'

-                                 '(A, B, C)'

-                                 '(A | B | C)'

-                                 '(A?, B*, C+),

-                                 '(A, (B | C | D)* )'                       *)

-VAR

-  Element : TElemDef;

-  Elem2   : TElemDef;

-  F       : PChar;

-  DER     : TDtdElementRec;

-BEGIN

-  Element   := TElemDef.Create;

-  Final     := Start + 9;

-  DER.Start := Start;

-  REPEAT

-    IF Final^ = '>' THEN BREAK;

-    IF (Final^ IN CNameStart) AND (Element.Name = '') THEN BEGIN

-      ExtractName (Final, CWhitespace, F);

-      SetStringSF (Element.Name, Final, F);

-      Final := F;

-      F := StrScan (Final+1, '>');

-      IF F = NIL THEN BEGIN

-        Element.Definition := STRING (Final);

-        Final := StrEnd (Final);

-        BREAK;

-        END

-      ELSE BEGIN

-        SetStringSF (Element.Definition, Final+1, F-1);

-        Final := F;

-        BREAK;

-        END;

-      END;

-    INC (Final);

-  UNTIL FALSE;

-  Element.Definition := DelChars (Element.Definition, CWhitespace);

-  ReplaceParameterEntities (Element.Definition);

-  IF      Element.Definition = 'EMPTY' THEN Element.ElemType := etEmpty

-  ELSE IF Element.Definition = 'ANY'   THEN Element.ElemType := etAny

-  ELSE IF Copy (Element.Definition, 1, 8) = '(#PCDATA' THEN Element.ElemType := etMixed

-  ELSE IF Copy (Element.Definition, 1, 1) = '('        THEN Element.ElemType := etChildren

-  ELSE Element.ElemType := etAny;

-

-  Elem2 := Elements.Node (Element.Name);

-  IF Elem2 <> NIL THEN

-    Elements.Delete (Elements.IndexOf (Elem2));

-  Elements.Add (Element);

-  Final := StrScanE (Final, '>');

-  DER.ElementType := deElement;

-  DER.ElemDef  := Element;

-  DER.Final    := Final;

-  DtdElementFound (DER);

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeAttListDecl  (Start : PChar; VAR Final : PChar);

-          (* Parse <!ATTLIST declaration starting at "Start"

-             Final must point to the terminating '>' character

-             XmlSpec 3.3:

-                 AttlistDecl    ::= '<!ATTLIST' S Name AttDef* S? '>'

-                 AttDef         ::= S Name S AttType S DefaultDecl

-                 AttType        ::= StringType | TokenizedType | EnumeratedType

-                 StringType     ::= 'CDATA'

-                 TokenizedType  ::= 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'

-                 EnumeratedType ::= NotationType | Enumeration

-                 NotationType   ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'

-                 Enumeration    ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'

-                 DefaultDecl    ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)

-                 AttValue       ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"

-            Examples:

-                 <!ATTLIST address

-                           A1 CDATA "Default"

-                           A2 ID    #REQUIRED

-                           A3 IDREF #IMPLIED

-                           A4 IDREFS #IMPLIED

-                           A5 ENTITY #FIXED "&at;&#252;"

-                           A6 ENTITIES #REQUIRED

-                           A7 NOTATION (WMF | DXF) "WMF"

-                           A8 (A | B | C) #REQUIRED>                *)

-TYPE

-  TPhase = (phElementName, phName, phType, phNotationContent, phDefault);

-VAR

-  Phase       : TPhase;

-  F           : PChar;

-  ElementName : STRING;

-  ElemDef     : TElemDef;

-  AttrDef     : TAttrDef;

-  AttrDef2    : TAttrDef;

-  Strg        : STRING;

-  DER         : TDtdElementRec;

-BEGIN

-  Final     := Start + 9;   // The character after <!ATTLIST

-  Phase     := phElementName;

-  DER.Start := Start;

-  AttrDef   := NIL;

-  ElemDef   := NIL;

-  REPEAT

-    IF NOT (Final^ IN CWhitespace) THEN

-      CASE Final^ OF

-        '%' : BEGIN

-                PushPE (Final);

-                CONTINUE;

-              END;

-        #0  : IF EntityStack.Count = 0 THEN

-                BREAK

-              ELSE BEGIN

-                Final := EntityStack.Pop;

-                CONTINUE;

-                END;

-        '>' : BREAK;

-        ELSE  CASE Phase OF

-                phElementName     : BEGIN

-                                      ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);

-                                      SetStringSF (ElementName, Final, F);

-                                      Final := F;

-                                      ElemDef := Elements.Node (ElementName);

-                                      IF ElemDef = NIL THEN BEGIN

-                                        ElemDef := TElemDef.Create;

-                                        ElemDef.Name       := ElementName;

-                                        ElemDef.Definition := 'ANY';

-                                        ElemDef.ElemType   := etAny;

-                                        Elements.Add (ElemDef);

-                                        END;

-                                      Phase := phName;

-                                    END;

-                phName            : BEGIN

-                                      AttrDef := TAttrDef.Create;

-                                      ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);

-                                      SetStringSF (AttrDef.Name, Final, F);

-                                      Final := F;

-                                      AttrDef2 := TAttrDef (ElemDef.Node (AttrDef.Name));

-                                      IF AttrDef2 <> NIL THEN

-                                        ElemDef.Delete (ElemDef.IndexOf (AttrDef2));

-                                      ElemDef.Add (AttrDef);

-                                      Phase := phType;

-                                    END;

-                phType            : BEGIN

-                                      IF Final^ = '(' THEN BEGIN

-                                        F := StrScan (Final+1, ')');

-                                        IF F <> NIL

-                                          THEN SetStringSF (AttrDef.TypeDef, Final+1, F-1)

-                                          ELSE AttrDef.TypeDef := STRING (Final+1);

-                                        AttrDef.TypeDef := DelChars (AttrDef.TypeDef, CWhitespace);

-                                        AttrDef.AttrType := atEnumeration;

-                                        ReplaceParameterEntities (AttrDef.TypeDef);

-                                        ReplaceCharacterEntities (AttrDef.TypeDef);

-                                        Phase := phDefault;

-                                        END

-                                      ELSE IF StrLComp (Final, 'NOTATION', 8) = 0 THEN BEGIN

-                                        INC (Final, 8);

-                                        AttrDef.AttrType := atNotation;

-                                        Phase := phNotationContent;

-                                        END

-                                      ELSE BEGIN

-                                        ExtractName (Final, CWhitespace+CQuoteChar+['#'], F);

-                                        SetStringSF (AttrDef.TypeDef, Final, F);

-                                        IF      AttrDef.TypeDef = 'CDATA'    THEN AttrDef.AttrType := atCData

-                                        ELSE IF AttrDef.TypeDef = 'ID'       THEN AttrDef.AttrType := atId

-                                        ELSE IF AttrDef.TypeDef = 'IDREF'    THEN AttrDef.AttrType := atIdRef

-                                        ELSE IF AttrDef.TypeDef = 'IDREFS'   THEN AttrDef.AttrType := atIdRefs

-                                        ELSE IF AttrDef.TypeDef = 'ENTITY'   THEN AttrDef.AttrType := atEntity

-                                        ELSE IF AttrDef.TypeDef = 'ENTITIES' THEN AttrDef.AttrType := atEntities

-                                        ELSE IF AttrDef.TypeDef = 'NMTOKEN'  THEN AttrDef.AttrType := atNmToken

-                                        ELSE IF AttrDef.TypeDef = 'NMTOKENS' THEN AttrDef.AttrType := atNmTokens;

-                                        Phase := phDefault;

-                                        END

-                                    END;

-                phNotationContent : BEGIN

-                                      F := StrScan (Final, ')');

-                                      IF F <> NIL THEN

-                                        SetStringSF (AttrDef.Notations, Final+1, F-1)

-                                      ELSE BEGIN

-                                        AttrDef.Notations := STRING (Final+1);

-                                        Final := StrEnd (Final);

-                                        END;

-                                      ReplaceParameterEntities (AttrDef.Notations);

-                                      AttrDef.Notations := DelChars (AttrDef.Notations, CWhitespace);

-                                      Phase := phDefault;

-                                    END;

-                phDefault :         BEGIN

-                                      IF Final^ = '#' THEN BEGIN

-                                        ExtractName (Final, CWhiteSpace + CQuoteChar, F);

-                                        SetStringSF (Strg, Final, F);

-                                        Final := F;

-                                        ReplaceParameterEntities (Strg);

-                                        IF      Strg = '#REQUIRED' THEN BEGIN AttrDef.DefaultType := adRequired; Phase := phName; END

-                                        ELSE IF Strg = '#IMPLIED'  THEN BEGIN AttrDef.DefaultType := adImplied;  Phase := phName; END

-                                        ELSE IF Strg = '#FIXED'    THEN       AttrDef.DefaultType := adFixed;

-                                        END

-                                      ELSE IF (Final^ IN CQuoteChar) THEN BEGIN

-                                        ExtractQuote (Final, AttrDef.Value, Final);

-                                        ReplaceParameterEntities (AttrDef.Value);

-                                        ReplaceCharacterEntities (AttrDef.Value);

-                                        Phase := phName;

-                                        END;

-                                      IF Phase = phName THEN BEGIN

-                                        AttrDef := NIL;

-                                        END;

-                                    END;

-

-                END;

-        END;

-    INC (Final);

-  UNTIL FALSE;

-

-  Final := StrScan (Final, '>');

-

-  DER.ElementType := deAttList;

-  DER.ElemDef  := ElemDef;

-  DER.Final    := Final;

-  DtdElementFound (DER);

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeEntityDecl   (Start : PChar; VAR Final : PChar);

-          (* Parse <!ENTITY declaration starting at "Start"

-             Final must point to the terminating '>' character

-             XmlSpec 4.2:

-                 EntityDecl  ::= '<!ENTITY' S Name S EntityDef S? '>'   |

-                                 '<!ENTITY' S '%' S Name S PEDef S? '>'

-                 EntityDef   ::= EntityValue | (ExternalID NDataDecl?)

-                 PEDef       ::= EntityValue | ExternalID

-                 NDataDecl   ::= S 'NDATA' S Name

-                 EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"'   |

-                                 "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'"

-                 PEReference ::= '%' Name ';'

-

-             Examples

-                 <!ENTITY test1 "Stefan Heymann">                   <!-- Internal, general, parsed              -->

-                 <!ENTITY test2 SYSTEM "ent2.xml">                  <!-- External, general, parsed              -->

-                 <!ENTITY test2 SYSTEM "ent3.gif" NDATA gif>        <!-- External, general, unparsed            -->

-                 <!ENTITY % test3 "<!ELEMENT q ANY>">               <!-- Internal, parameter                    -->

-                 <!ENTITY % test6 SYSTEM "ent6.xml">                <!-- External, parameter                    -->

-                 <!ENTITY test4 "&test1; ist lieb">                 <!-- IGP, Replacement text <> literal value -->

-                 <!ENTITY test5 "<p>Dies ist ein Test-Absatz</p>">  <!-- IGP, See XmlSpec 2.4                   -->

-          *)

-TYPE

-  TPhase = (phName, phContent, phNData, phNotationName, phFinalGT);

-VAR

-  Phase         : TPhase;

-  IsParamEntity : BOOLEAN;

-  F             : PChar;

-  ExternalID    : TExternalID;

-  EntityDef     : TEntityDef;

-  EntityDef2    : TEntityDef;

-  DER           : TDtdElementRec;

-BEGIN

-  Final         := Start + 8;   // First char after <!ENTITY

-  DER.Start     := Start;

-  Phase         := phName;

-  IsParamEntity := FALSE;

-  EntityDef     := TEntityDef.Create;

-  REPEAT

-    IF NOT (Final^ IN CWhitespace) THEN

-      CASE Final^ OF

-        '%' : IsParamEntity := TRUE;

-        '>' : BREAK;

-        ELSE  CASE Phase OF

-                phName         : IF Final^ IN CNameStart THEN BEGIN

-                                   ExtractName (Final, CWhitespace + CQuoteChar, F);

-                                   SetStringSF (EntityDef.Name, Final, F);

-                                   Final := F;

-                                   Phase := phContent;

-                                   END;

-                phContent      : IF Final^ IN CQuoteChar THEN BEGIN

-                                   ExtractQuote (Final, EntityDef.Value, Final);

-                                   Phase := phFinalGT;

-                                   END

-                                 ELSE IF (StrLComp (Final, 'SYSTEM', 6) = 0) OR

-                                         (StrLComp (Final, 'PUBLIC', 6) = 0) THEN BEGIN

-                                   ExternalID := TExternalID.Create (Final);

-                                   EntityDef.SystemId := ExternalID.SystemId;

-                                   EntityDef.PublicId := ExternalID.PublicId;

-                                   Final      := ExternalID.Final;

-                                   Phase      := phNData;

-                                   ExternalID.Free;

-                                   END;

-                phNData        : IF StrLComp (Final, 'NDATA', 5) = 0 THEN BEGIN

-                                   INC (Final, 4);

-                                   Phase := phNotationName;

-                                   END;

-                phNotationName : IF Final^ IN CNameStart THEN BEGIN

-                                   ExtractName (Final, CWhitespace + ['>'], F);

-                                   SetStringSF (EntityDef.NotationName, Final, F);

-                                   Final := F;

-                                   Phase := phFinalGT;

-                                   END;

-                phFinalGT      : ; // -!- There is an error in the document if this branch is called

-                END;

-        END;

-    INC (Final);

-  UNTIL FALSE;

-  IF IsParamEntity THEN BEGIN

-    EntityDef2 := TEntityDef (ParEntities.Node (EntityDef.Name));

-    IF EntityDef2 <> NIL THEN

-      ParEntities.Delete (ParEntities.IndexOf (EntityDef2));

-    ParEntities.Add (EntityDef);

-    ReplaceCharacterEntities (EntityDef.Value);

-    END

-  ELSE BEGIN

-    EntityDef2 := TEntityDef (Entities.Node (EntityDef.Name));

-    IF EntityDef2 <> NIL THEN

-      Entities.Delete (Entities.IndexOf (EntityDef2));

-    Entities.Add (EntityDef);

-    ReplaceParameterEntities (EntityDef.Value);  //  Create replacement texts (see XmlSpec 4.5)

-    ReplaceCharacterEntities (EntityDef.Value);

-    END;

-  Final := StrScanE (Final, '>');

-

-  DER.ElementType := deEntity;

-  DER.EntityDef   := EntityDef;

-  DER.Final       := Final;

-  DtdElementFound (DER);

-END;

-

-

-PROCEDURE TXmlParser.AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);

-          // Parse <!NOTATION declaration starting at "Start"

-          // Final must point to the terminating '>' character

-          // XmlSpec 4.7: NotationDecl ::=  '<!NOTATION' S Name S (ExternalID |  PublicID) S? '>'

-TYPE

-  TPhase = (phName, phExtId, phEnd);

-VAR

-  ExternalID  : TExternalID;

-  Phase       : TPhase;

-  F           : PChar;

-  NotationDef : TNotationDef;

-  DER         : TDtdElementRec;

-BEGIN

-  Final       := Start + 10;   // Character after <!NOTATION

-  DER.Start   := Start;

-  Phase       := phName;

-  NotationDef := TNotationDef.Create;

-  REPEAT

-    IF NOT (Final^ IN CWhitespace) THEN

-      CASE Final^ OF

-        '>',

-        #0   : BREAK;

-        ELSE   CASE Phase OF

-                 phName  : BEGIN

-                             ExtractName (Final, CWhitespace + ['>'], F);

-                             SetStringSF (NotationDef.Name, Final, F);

-                             Final := F;

-                             Phase := phExtId;

-                           END;

-                 phExtId : BEGIN

-                             ExternalID := TExternalID.Create (Final);

-                             NotationDef.Value    := ExternalID.SystemId;

-                             NotationDef.PublicId := ExternalID.PublicId;

-                             Final := ExternalId.Final;

-                             ExternalId.Free;

-                             Phase := phEnd;

-                           END;

-                 phEnd   : ;   // -!- There is an error in the document if this branch is called

-                 END;

-        END;

-    INC (Final);

-  UNTIL FALSE;

-  Notations.Add (NotationDef);

-  Final := StrScanE (Final, '>');

-

-  DER.ElementType := deNotation;

-  DER.NotationDef := NotationDef;

-  DER.Final       := Final;

-  DtdElementFound (DER);

-END;

-

-

-PROCEDURE TXmlParser.PushPE (VAR Start : PChar);

-          (* If there is a parameter entity reference found in the data stream,

-             the current position will be pushed to the entity stack.

-             Start:  IN  Pointer to the '%' character starting the PE reference

-                     OUT Pointer to first character of PE replacement text *)

-VAR

-  P         : PChar;

-  EntityDef : TEntityDef;

-BEGIN

-  P := StrScan (Start, ';');

-  IF P <> NIL THEN BEGIN

-    EntityDef := TEntityDef (ParEntities.Node (StrSFPas (Start+1, P-1)));

-    IF EntityDef <> NIL THEN BEGIN

-      EntityStack.Push (P+1);

-      Start := PChar (EntityDef.Value);

-      END

-    ELSE

-      Start := P+1;

-    END;

-END;

-

-

-PROCEDURE TXmlParser.ReplaceCharacterEntities (VAR Str : STRING);

-          // Replaces all Character Entity References in the String

-VAR

-  Start  : INTEGER;

-  PAmp   : PChar;

-  PSemi  : PChar;

-  PosAmp : INTEGER;

-  Len    : INTEGER;    // Length of Entity Reference

-BEGIN

-  IF Str = '' THEN EXIT;

-  Start := 1;

-  REPEAT

-    PAmp := StrPos (PChar (Str) + Start-1, '&#');

-    IF PAmp = NIL THEN BREAK;

-    PSemi := StrScan (PAmp+2, ';');

-    IF PSemi = NIL THEN BREAK;

-    PosAmp := PAmp - PChar (Str) + 1;

-    Len    := PSemi-PAmp+1;

-    IF CompareText (Str [PosAmp+2], 'x') = 0          // !!! Can't use "CHR" for Unicode characters > 255

-      THEN Str [PosAmp] := CHR (StrToIntDef ('$'+Copy (Str, PosAmp+3, Len-4), 0))

-      ELSE Str [PosAmp] := CHR (StrToIntDef (Copy (Str, PosAmp+2, Len-3), 32));

-    Delete (Str, PosAmp+1, Len-1);  

-    Start := PosAmp + 1;

-  UNTIL FALSE;

-END;

-

-

-PROCEDURE TXmlParser.ReplaceParameterEntities (VAR Str : STRING);

-          // Recursively replaces all Parameter Entity References in the String

-  PROCEDURE ReplaceEntities (VAR Str : STRING);

-  VAR

-    Start   : INTEGER;

-    PAmp    : PChar;

-    PSemi   : PChar;

-    PosAmp  : INTEGER;

-    Len     : INTEGER;

-    Entity  : TEntityDef;

-    Repl    : STRING;        // Replacement

-  BEGIN

-    IF Str = '' THEN EXIT;

-    Start := 1;

-    REPEAT

-      PAmp := StrPos (PChar (Str)+Start-1, '%');

-      IF PAmp = NIL THEN BREAK;

-      PSemi := StrScan (PAmp+2, ';');

-      IF PSemi = NIL THEN BREAK;

-      PosAmp := PAmp - PChar (Str) + 1;

-      Len    := PSemi-PAmp+1;

-      Entity := TEntityDef (ParEntities.Node (Copy (Str, PosAmp+1, Len-2)));

-      IF Entity <> NIL THEN BEGIN

-        Repl := Entity.Value;

-        ReplaceEntities (Repl);    // Recursion

-        END

-      ELSE

-        Repl := Copy (Str, PosAmp, Len);

-      Delete (Str, PosAmp, Len);  

-      Insert (Repl, Str, PosAmp);

-      Start := PosAmp + Length (Repl);

-    UNTIL FALSE;

-  END;

-BEGIN

-  ReplaceEntities (Str);

-END;

-

-

-PROCEDURE TXmlParser.ReplaceGeneralEntities (VAR Str : STRING);

-          // Recursively replaces General Entity References in the String

-  PROCEDURE ReplaceEntities (VAR Str : STRING);

-  VAR

-    Start          : INTEGER;

-    PAmp           : PChar;

-    PSemi          : PChar;

-    PosAmp         : INTEGER;

-    Len            : INTEGER;

-    EntityDef      : TEntityDef;

-    EntName        : STRING;

-    Repl           : STRING;        // Replacement

-    ExternalEntity : TXmlParser;

-  BEGIN

-    IF Str = '' THEN EXIT;

-    Start := 1;

-    REPEAT

-      PAmp := StrPos (PChar (Str)+Start-1, '&');

-      IF PAmp = NIL THEN BREAK;

-      PSemi := StrScan (PAmp+2, ';');

-      IF PSemi = NIL THEN BREAK;

-      PosAmp := PAmp - PChar (Str) + 1;

-      Len    := PSemi-PAmp+1;

-      EntName := Copy (Str, PosAmp+1, Len-2);

-      IF      EntName = 'lt'   THEN Repl := '<'

-      ELSE IF EntName = 'gt'   THEN Repl := '>'

-      ELSE IF EntName = 'amp'  THEN Repl := '&'

-      ELSE IF EntName = 'apos' THEN Repl := ''''

-      ELSE IF EntName = 'quot' THEN Repl := '"'

-      ELSE BEGIN

-        EntityDef := TEntityDef (Entities.Node (EntName));

-        IF EntityDef <> NIL THEN BEGIN

-          IF EntityDef.Value <> '' THEN   // Internal Entity

-            Repl := EntityDef.Value

-          ELSE BEGIN                      // External Entity

-            ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);

-            Repl := StrPas (ExternalEntity.DocBuffer);  // !!! What if it contains a Text Declaration?

-            ExternalEntity.Free;

-            END;

-          ReplaceEntities (Repl);    // Recursion

-          END

-        ELSE

-          Repl := Copy (Str, PosAmp, Len);

-        END;

-      Delete (Str, PosAmp, Len);  

-      Insert (Repl, Str, PosAmp);

-      Start := PosAmp + Length (Repl);

-    UNTIL FALSE;

-  END;

-BEGIN

-  ReplaceEntities (Str);

-END;

-

-

-FUNCTION  TXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;

-          // This will be called whenever there is a Parsed External Entity or

-          // the DTD External Subset to be parsed.

-          // It has to create a TXmlParser instance and load the desired Entity.

-          // This instance of LoadExternalEntity assumes that "SystemId" is a valid

-          // file name (relative to the Document source) and loads this file using

-          // the LoadFromFile method.

-VAR

-  Filename : STRING;

-BEGIN

-  // --- Convert System ID to complete filename

-  Filename := StringReplace (SystemId, '/', '\', [rfReplaceAll]);

-  IF Copy (FSource, 1, 1) <> '<' THEN

-    IF (Copy (Filename, 1, 2) = '\\') OR (Copy (Filename, 2, 1) = ':') THEN

-      // Already has an absolute Path

-    ELSE BEGIN

-      Filename := ExtractFilePath (FSource) + Filename;

-      END;

-

-  // --- Load the File

-  Result := TXmlParser.Create;

-  Result.LoadFromFile (Filename);

-END;

-

-

-FUNCTION  TXmlParser.TranslateEncoding  (CONST Source : STRING) : STRING;

-          // The member variable "CurEncoding" always holds the name of the current

-          // encoding, e.g. 'UTF-8' or 'ISO-8859-1'.

-          // This virtual method "TranslateEncoding" is responsible for translating

-          // the content passed in the "Source" parameter to the Encoding which

-          // is expected by the application.

-          // This instance of "TranlateEncoding" assumes that the Application expects

-          // Windows ANSI (Win1252) strings. It is able to transform UTF-8 or ISO-8859-1

-          // encodings.

-          // If you want your application to understand or create other encodings, you

-          // override this function.

-BEGIN

-  IF CurEncoding = 'UTF-8'

-    THEN Result := Utf8ToAnsi (Source)

-    ELSE Result := Source;

-END;

-

-

-PROCEDURE TXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);

-          // This method is called for every element which is found in the DTD

-          // declaration. The variant record TDtdElementRec is passed which

-          // holds informations about the element.

-          // You can override this function to handle DTD declarations.

-          // Note that when you parse the same Document instance a second time,

-          // the DTD will not get parsed again.

-BEGIN

-END;

-

-

-FUNCTION TXmlParser.GetDocBuffer: PChar;

-         // Returns FBuffer or a pointer to a NUL char if Buffer is empty

-BEGIN

-  IF FBuffer = NIL

-    THEN Result := #0

-    ELSE Result := FBuffer;

-END;

-

-

-(*$IFNDEF HAS_CONTNRS_UNIT

-===============================================================================================

-TObjectList

-===============================================================================================

-*)

-

-DESTRUCTOR TObjectList.Destroy;

-BEGIN

-  Clear;

-  SetCapacity(0);

-  INHERITED Destroy;

-END;

-

-

-PROCEDURE TObjectList.Delete (Index : INTEGER);

-BEGIN

-  IF (Index < 0) OR (Index >= Count) THEN EXIT;

-  TObject (Items [Index]).Free;

-  INHERITED Delete (Index);

-END;

-

-

-PROCEDURE TObjectList.Clear;

-BEGIN

-  WHILE Count > 0 DO

-    Delete (Count-1);

-END;

-

-(*$ENDIF *)

-

-(*

-===============================================================================================

-TNvpNode

---------

-Node base class for the TNvpList

-===============================================================================================

-*)

-

-CONSTRUCTOR TNvpNode.Create (TheName, TheValue : STRING);

-BEGIN

-  INHERITED Create;

-  Name  := TheName;

-  Value := TheValue;

-END;

-

-

-(*

-===============================================================================================

-TNvpList

---------

-A generic List of Name-Value Pairs, based on the TObjectList introduced in Delphi 5

-===============================================================================================

-*)

-

-PROCEDURE TNvpList.Add (Node : TNvpNode);

-VAR

-  I : INTEGER;

-BEGIN

-  FOR I := Count-1 DOWNTO 0 DO

-    IF Node.Name > TNvpNode (Items [I]).Name THEN BEGIN

-      Insert (I+1, Node);

-      EXIT;

-      END;

-  Insert (0, Node);

-END;

-

-

-

-FUNCTION  TNvpList.Node (Name : STRING) : TNvpNode;

-          // Binary search for Node

-VAR

-  L, H : INTEGER;    // Low, High Limit

-  T, C : INTEGER;    // Test Index, Comparison result

-  Last : INTEGER;    // Last Test Index

-BEGIN

-  IF Count=0 THEN BEGIN

-    Result := NIL;

-    EXIT;

-    END;

-

-  L    := 0;

-  H    := Count;

-  Last := -1;

-  REPEAT

-    T := (L+H) DIV 2;

-    IF T=Last THEN BREAK;

-    Result := TNvpNode (Items [T]);

-    C := CompareStr (Result.Name, Name);

-    IF      C = 0 THEN EXIT

-    ELSE IF C < 0 THEN L := T

-    ELSE               H := T;

-    Last := T;

-  UNTIL FALSE;

-  Result := NIL;

-END;

-

-

-FUNCTION  TNvpList.Node (Index : INTEGER) : TNvpNode;

-BEGIN

-  IF (Index < 0) OR (Index >= Count)

-    THEN Result := NIL

-    ELSE Result := TNvpNode (Items [Index]);

-END;

-

-

-FUNCTION  TNvpList.Value (Name : STRING) : STRING;

-VAR

-  Nvp : TNvpNode;

-BEGIN

-  Nvp := TNvpNode (Node (Name));

-  IF Nvp <> NIL

-    THEN Result := Nvp.Value

-    ELSE Result := '';

-END;

-

-

-FUNCTION  TNvpList.Value (Index : INTEGER) : STRING;

-BEGIN

-  IF (Index < 0) OR (Index >= Count)

-    THEN Result := ''

-    ELSE Result := TNvpNode (Items [Index]).Value;

-END;

-

-

-FUNCTION  TNvpList.Name (Index : INTEGER) : STRING;

-BEGIN

-  IF (Index < 0) OR (Index >= Count)

-    THEN Result := ''

-    ELSE Result := TNvpNode (Items [Index]).Name;

-END;

-

-

-(*

-===============================================================================================

-TAttrList

-List of Attributes. The "Analyze" method extracts the Attributes from the given Buffer.

-Is used for extraction of Attributes in Start-Tags, Empty-Element Tags and the "pseudo"

-attributes in XML Prologs, Text Declarations and PIs.

-===============================================================================================

-*)

-

-PROCEDURE TAttrList.Analyze (Start : PChar; VAR Final : PChar);

-          // Analyze the Buffer for Attribute=Name pairs.

-          // Terminates when there is a character which is not IN CNameStart

-          // (e.g. '?>' or '>' or '/>')

-TYPE

-  TPhase = (phName, phEq, phValue);

-VAR

-  Phase : TPhase;

-  F     : PChar;

-  Name  : STRING;

-  Value : STRING;

-  Attr  : TAttr;

-BEGIN

-  Clear;

-  Phase := phName;

-  Final := Start;

-  REPEAT

-    IF (Final^ = #0) OR (Final^ = '>') THEN BREAK;

-    IF NOT (Final^ IN CWhitespace) THEN

-      CASE Phase OF

-        phName  : BEGIN

-                    IF NOT (Final^ IN CNameStart) THEN EXIT;

-                    ExtractName (Final, CWhitespace + ['=', '/'], F);

-                    SetStringSF (Name, Final, F);

-                    Final := F;

-                    Phase := phEq;

-                  END;

-        phEq    : BEGIN

-                    IF Final^ = '=' THEN

-                      Phase := phValue

-                  END;

-        phValue : BEGIN

-                    IF Final^ IN CQuoteChar THEN BEGIN

-                      ExtractQuote (Final, Value, F);

-                      Attr := TAttr.Create;

-                      Attr.Name      := Name;

-                      Attr.Value     := Value;

-                      Attr.ValueType := vtNormal;

-                      Add (Attr);

-                      Final := F;

-                      Phase := phName;

-                      END;

-                  END;

-        END;

-    INC (Final);

-  UNTIL FALSE;

-END;

-

-

-(*

-===============================================================================================

-TElemList

-List of TElemDef nodes.

-===============================================================================================

-*)

-

-FUNCTION  TElemList.Node (Name : STRING) : TElemDef;

-          // Binary search for the Node with the given Name

-VAR

-  L, H : INTEGER;    // Low, High Limit

-  T, C : INTEGER;    // Test Index, Comparison result

-  Last : INTEGER;    // Last Test Index

-BEGIN

-  IF Count=0 THEN BEGIN

-    Result := NIL;

-    EXIT;

-    END;

-

-  L    := 0;

-  H    := Count;

-  Last := -1;

-  REPEAT

-    T := (L+H) DIV 2;

-    IF T=Last THEN BREAK;

-    Result := TElemDef (Items [T]);

-    C := CompareStr (Result.Name, Name);

-    IF C = 0 THEN EXIT

-    ELSE IF C < 0 THEN L := T

-    ELSE               H := T;

-    Last := T;

-  UNTIL FALSE;

-  Result := NIL;

-END;

-

-

-PROCEDURE TElemList.Add (Node : TElemDef);

-VAR

-  I : INTEGER;

-BEGIN

-  FOR I := Count-1 DOWNTO 0 DO

-    IF Node.Name > TElemDef (Items [I]).Name THEN BEGIN

-      Insert (I+1, Node);

-      EXIT;

-      END;

-  Insert (0, Node);

-END;

-

-

-(*

-===============================================================================================

-TScannerXmlParser

-A TXmlParser descendant for the TCustomXmlScanner component

-===============================================================================================

-*)

-

-TYPE

-  TScannerXmlParser = CLASS (TXmlParser)

-                       Scanner : TCustomXmlScanner;

-                       CONSTRUCTOR Create (TheScanner : TCustomXmlScanner);

-                       FUNCTION  LoadExternalEntity (SystemId, PublicId,

-                                                     Notation : STRING) : TXmlParser;  OVERRIDE;

-                       FUNCTION  TranslateEncoding  (CONST Source : STRING) : STRING;  OVERRIDE;

-                       PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec);     OVERRIDE;

-                      END;

-

-CONSTRUCTOR TScannerXmlParser.Create (TheScanner : TCustomXmlScanner);

-BEGIN

-  INHERITED Create;

-  Scanner := TheScanner;

-END;

-

-

-FUNCTION  TScannerXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;

-BEGIN

-  IF Assigned (Scanner.FOnLoadExternal)

-    THEN Scanner.FOnLoadExternal (Scanner, SystemId, PublicId, Notation, Result)

-    ELSE Result :=  INHERITED LoadExternalEntity (SystemId, PublicId, Notation);

-END;

-

-

-FUNCTION  TScannerXmlParser.TranslateEncoding  (CONST Source : STRING) : STRING;

-BEGIN

-  IF Assigned (Scanner.FOnTranslateEncoding)

-    THEN Result := Scanner.FOnTranslateEncoding (Scanner, CurEncoding, Source)

-    ELSE Result := INHERITED TranslateEncoding (Source);

-END;

-

-

-PROCEDURE TScannerXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);

-BEGIN

-  WITH DtdElementRec DO

-    CASE ElementType OF

-      deElement  : Scanner.WhenElement  (ElemDef);

-      deAttList  : Scanner.WhenAttList  (ElemDef);

-      deEntity   : Scanner.WhenEntity   (EntityDef);

-      deNotation : Scanner.WhenNotation (NotationDef);

-      dePI       : Scanner.WhenPI       (STRING (Target), STRING (Content), AttrList);

-      deComment  : Scanner.WhenComment  (StrSFPas (Start, Final));

-      deError    : Scanner.WhenDtdError (Pos);

-      END;

-END;

-

-

-(*

-===============================================================================================

-TCustomXmlScanner

-===============================================================================================

-*)

-

-CONSTRUCTOR TCustomXmlScanner.Create (AOwner: TComponent);

-BEGIN

-  INHERITED;

-  FXmlParser := TScannerXmlParser.Create (Self);

-END;

-

-

-DESTRUCTOR TCustomXmlScanner.Destroy;

-BEGIN

-  FXmlParser.Free;

-  INHERITED;

-END;

-

-

-PROCEDURE TCustomXmlScanner.LoadFromFile (Filename : TFilename);

-          // Load XML Document from file

-BEGIN

-  FXmlParser.LoadFromFile (Filename);

-END;

-

-

-PROCEDURE TCustomXmlScanner.LoadFromBuffer (Buffer : PChar);

-          // Load XML Document from buffer

-BEGIN

-  FXmlParser.LoadFromBuffer (Buffer);

-END;

-

-

-PROCEDURE TCustomXmlScanner.SetBuffer (Buffer : PChar);

-          // Refer to Buffer

-BEGIN

-  FXmlParser.SetBuffer (Buffer);

-END;

-

-

-FUNCTION  TCustomXmlScanner.GetFilename : TFilename;

-BEGIN

-  Result := FXmlParser.Source;

-END;

-

-

-FUNCTION  TCustomXmlScanner.GetNormalize : BOOLEAN;

-BEGIN

-  Result := FXmlParser.Normalize;

-END;

-

-

-PROCEDURE TCustomXmlScanner.SetNormalize (Value : BOOLEAN);

-BEGIN

-  FXmlParser.Normalize := Value;

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN);

-          // Is called when the parser has parsed the <? xml ?> declaration of the prolog

-BEGIN

-  IF Assigned (FOnXmlProlog) THEN FOnXmlProlog (Self, XmlVersion, Encoding, Standalone);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenComment  (Comment : STRING);

-          // Is called when the parser has parsed a <!-- comment -->

-BEGIN

-  IF Assigned (FOnComment) THEN FOnComment (Self, Comment);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenPI (Target, Content: STRING; Attributes : TAttrList);

-          // Is called when the parser has parsed a <?processing instruction ?>

-BEGIN

-  IF Assigned (FOnPI) THEN FOnPI (Self, Target, Content, Attributes);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenDtdRead (RootElementName : STRING);

-          // Is called when the parser has completely parsed the DTD

-BEGIN

-  IF Assigned (FOnDtdRead) THEN FOnDtdRead (Self, RootElementName);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenStartTag (TagName : STRING; Attributes : TAttrList);

-          // Is called when the parser has parsed a start tag like <p>

-BEGIN

-  IF Assigned (FOnStartTag) THEN FOnStartTag (Self, TagName, Attributes);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenEmptyTag (TagName : STRING; Attributes : TAttrList);

-          // Is called when the parser has parsed an Empty Element Tag like <br/>

-BEGIN

-  IF Assigned (FOnEmptyTag) THEN FOnEmptyTag (Self, TagName, Attributes);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenEndTag (TagName : STRING);

-          // Is called when the parser has parsed an End Tag like </p>

-BEGIN

-  IF Assigned (FOnEndTag) THEN FOnEndTag (Self, TagName);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenContent (Content : STRING);

-          // Is called when the parser has parsed an element's text content

-BEGIN

-  IF Assigned (FOnContent) THEN FOnContent (Self, Content);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenCData (Content : STRING);

-          // Is called when the parser has parsed a CDATA section

-BEGIN

-  IF Assigned (FOnCData) THEN FOnCData (Self, Content);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenElement (ElemDef : TElemDef);

-          // Is called when the parser has parsed an <!ELEMENT> definition

-          // inside the DTD

-BEGIN

-  IF Assigned (FOnElement) THEN FOnElement (Self, ElemDef);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenAttList (ElemDef : TElemDef);

-          // Is called when the parser has parsed an <!ATTLIST> definition

-          // inside the DTD

-BEGIN

-  IF Assigned (FOnAttList) THEN FOnAttList (Self, ElemDef);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenEntity   (EntityDef : TEntityDef);

-          // Is called when the parser has parsed an <!ENTITY> definition

-          // inside the DTD

-BEGIN

-  IF Assigned (FOnEntity) THEN FOnEntity (Self, EntityDef);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenNotation (NotationDef : TNotationDef);

-          // Is called when the parser has parsed a <!NOTATION> definition

-          // inside the DTD

-BEGIN

-  IF Assigned (FOnNotation) THEN FOnNotation (Self, NotationDef);

-END;

-

-

-PROCEDURE TCustomXmlScanner.WhenDtdError (ErrorPos : PChar);

-          // Is called when the parser has found an Error in the DTD

-BEGIN

-  IF Assigned (FOnDtdError) THEN FOnDtdError (Self, ErrorPos);

-END;

-

-

-PROCEDURE TCustomXmlScanner.Execute;

-          // Perform scanning

-          // Scanning is done synchronously, i.e. you can expect events to be triggered

-          // in the order of the XML data stream. Execute will finish when the whole XML

-          // document has been scanned or when the StopParser property has been set to TRUE.

-BEGIN

-  FStopParser := FALSE;

-  FXmlParser.StartScan;

-  WHILE FXmlParser.Scan AND (NOT FStopParser) DO

-    CASE FXmlParser.CurPartType OF

-      ptNone      : ;

-      ptXmlProlog : WhenXmlProlog (FXmlParser.XmlVersion, FXmlParser.Encoding, FXmlParser.Standalone);

-      ptComment   : WhenComment   (StrSFPas (FXmlParser.CurStart, FXmlParser.CurFinal));

-      ptPI        : WhenPI        (FXmlParser.CurName, FXmlParser.CurContent, FXmlParser.CurAttr);

-      ptDtdc      : WhenDtdRead   (FXmlParser.RootName);

-      ptStartTag  : WhenStartTag  (FXmlParser.CurName, FXmlParser.CurAttr);

-      ptEmptyTag  : WhenEmptyTag  (FXmlParser.CurName, FXmlParser.CurAttr);

-      ptEndTag    : WhenEndTag    (FXmlParser.CurName);

-      ptContent   : WhenContent   (FXmlParser.CurContent);

-      ptCData     : WhenCData     (FXmlParser.CurContent);

-      END;

-END;

-

-

-END.

+(**
+===============================================================================================
+Name    : LibXmlParser
+===============================================================================================
+Project : All Projects
+===============================================================================================
+Subject : Progressive XML Parser for all types of XML Files
+===============================================================================================
+Author  : Stefan Heymann
+          Eschenweg 3
+          72076 Tübingen
+          GERMANY
+
+E-Mail:   stefan@destructor.de
+URL:      www.destructor.de
+===============================================================================================
+Source, Legals ("Licence")
+--------------------------
+The official site to get this parser is http://www.destructor.de/
+
+Usage and Distribution of this Source Code is ruled by the
+"Destructor.de Source code Licence" (DSL) which comes with this file or
+can be downloaded at http://www.destructor.de/
+
+IN SHORT: Usage and distribution of this source code is free.
+          You use it completely on your own risk.
+
+Postcardware
+------------
+If you like this code, please send a postcard of your city to my above address.
+===============================================================================================
+!!!  All parts of this code which are not finished or not conforming exactly to
+     the XmlSpec are marked with three exclamation marks
+
+-!-  Parts where the parser may be able to detect errors in the document's syntax are
+     marked with the dash-exlamation mark-dash sequence.
+===============================================================================================
+Terminology:
+------------
+- Start:   Start of a buffer part
+- Final:   End (last character) of a buffer part
+- DTD:     Document Type Definition
+- DTDc:    Document Type Declaration
+- XMLSpec: The current W3C XML Recommendation (version 1.0 as of 1998-02-10), Chapter No.
+- Cur*:    Fields concerning the "Current" part passed back by the "Scan" method
+===============================================================================================
+Scanning the XML document
+-------------------------
+- Create TXmlParser Instance                     MyXml := TXmlParser.Create;
+- Load XML Document                              MyXml.LoadFromFile (Filename);
+- Start Scanning                                 MyXml.StartScan;
+- Scan Loop                                      WHILE MyXml.Scan DO
+- Test for Part Type                               CASE MyXml.CurPartType OF
+- Handle Parts                                       ... : ;;;
+- Handle Parts                                       ... : ;;;
+- Handle Parts                                       ... : ;;;
+                                                     END;
+- Destroy                                        MyXml.Free;
+===============================================================================================
+Loading the XML document
+------------------------
+You can load the XML document from a file with the "LoadFromFile" method.
+It is beyond the scope of this parser to perform HTTP or FTP accesses. If you want your
+application to handle such requests (URLs), you can load the XML via HTTP or FTP or whatever
+protocol and hand over the data buffer using the "LoadFromBuffer" or "SetBuffer" method.
+"LoadFromBuffer" loads the internal buffer of TXmlParser with the given null-terminated
+string, thereby creating a copy of that buffer.
+"SetBuffer" just takes the pointer to another buffer, which means that the given
+buffer pointer must be valid while the document is accessed via TXmlParser.
+===============================================================================================
+Encodings:
+----------
+This XML parser kind of "understands" the following encodings:
+- UTF-8
+- ISO-8859-1
+- Windows-1252
+
+Any flavor of multi-byte characters (and this includes UTF-16) is not supported. Sorry.
+
+Every string which has to be passed to the application passes the virtual method
+"TranslateEncoding" which translates the string from the current encoding (stored in
+"CurEncoding") into the encoding the application wishes to receive.
+The "TranslateEncoding" method that is built into TXmlParser assumes that the application
+wants to receive Windows ANSI (Windows-1252, about the same as ISO-8859-1) and is able
+to convert UTF-8 and ISO-8859-1 encodings.
+For other source and target encodings, you will have to override "TranslateEncoding".
+===============================================================================================
+Buffer Handling
+---------------
+- The document must be loaded completely into a piece of RAM
+- All character positions are referenced by PChar pointers
+- The TXmlParser instance can either "own" the buffer itself (then, FBufferSize is > 0)
+  or reference the buffer of another instance or object (then, FBuffersize is 0 and
+  FBuffer is not NIL)
+- The Property DocBuffer passes back a pointer to the first byte of the document. If there
+  is no document stored (FBuffer is NIL), the DocBuffer returns a pointer to a NULL character.
+===============================================================================================
+Whitespace Handling
+-------------------
+The TXmlParser property "PackSpaces" determines how Whitespace is returned in Text Content:
+While PackSpaces is true, all leading and trailing whitespace characters are trimmed of, all
+Whitespace is converted to Space #x20 characters and contiguous Whitespace characters are
+compressed to one.
+If the "Scan" method reports a ptContent part, the application can get the original text
+with all whitespace characters by extracting the characters from "CurStart" to "CurFinal".
+If the application detects an xml:space attribute, it can set "PackSpaces" accordingly or
+use CurStart/CurFinal.
+Please note that TXmlParser does _not_ normalize Line Breaks to single LineFeed characters
+as the XmlSpec requires (XmlSpec 2.11).
+The xml:space attribute is not handled by TXmlParser. This is on behalf of the application.
+===============================================================================================
+Non-XML-Conforming
+------------------
+TXmlParser does not conform 100 % exactly to the XmlSpec:
+- UTF-16 is not supported (XmlSpec 2.2)
+  (Workaround: Convert UTF-16 to UTF-8 and hand the buffer over to TXmlParser)
+- As the parser only works with single byte strings, all Unicode characters > 255
+  can currently not be handled correctly.
+- Line breaks are not normalized to single Linefeed #x0A characters (XmlSpec 2.11)
+  (Workaround: The Application can access the text contents on its own [CurStart, CurFinal],
+  thereby applying every normalization it wishes to)
+- The attribute value normalization does not work exactly as defined in the
+  Second Edition of the XML 1.0 specification.
+- See also the code parts marked with three consecutive exclamation marks. These are
+  parts which are not finished in the current code release.
+
+This list may be incomplete, so it may grow if I get to know any other points.
+As work on the parser proceeds, this list may also shrink.
+===============================================================================================
+Things Todo
+-----------
+- Introduce a new event/callback which is called when there is an unresolvable
+  entity or character reference
+- Support Unicode
+- Use Streams instead of reading the whole XML into memory
+===============================================================================================
+Change History, Version numbers
+-------------------------------
+The Date is given in ISO Year-Month-Day (YYYY-MM-DD) order.
+Versions are counted from 1.0.0 beginning with the version from 2000-03-16.
+Unreleased versions don't get a version number.
+
+Date        Author Version Changes
+-----------------------------------------------------------------------------------------------
+2000-03-16  HeySt  1.0.0   Start
+2000-03-28  HeySt  1.0.1   Initial Publishing of TXmlParser on the destructor.de Web Site
+2000-03-30  HeySt  1.0.2   TXmlParser.AnalyzeCData: Call "TranslateEncoding" for CurContent
+2000-03-31  HeySt  1.0.3   Deleted the StrPosE function (was not needed anyway)
+2000-04-04  HeySt  1.0.4   TDtdElementRec modified: Start/Final for all Elements;
+                           Should be backwards compatible.
+                           AnalyzeDtdc: Set CurPartType to ptDtdc
+2000-04-23  HeySt  1.0.5   New class TObjectList. Eliminated reference to the Delphi 5
+                           "Contnrs" unit so LibXmlParser is Delphi 4 compatible.
+2000-07-03  HeySt  1.0.6   TNvpNode: Added Constructor
+2000-07-11  HeySt  1.0.7   Removed "Windows" from USES clause
+                           Added three-exclamation-mark comments for Utf8ToAnsi/AnsiToUtf8
+                           Added three-exclamation-mark comments for CHR function calls
+2000-07-23  HeySt  1.0.8   TXmlParser.Clear: CurAttr.Clear; EntityStack.Clear;
+                           (This was not a bug; just defensive programming)
+2000-07-29  HeySt  1.0.9   TNvpList: Added methods: Node(Index), Value(Index), Name(Index);
+2000-10-07  HeySt          Introduced Conditional Defines
+                           Uses Contnrs unit and its TObjectList class again for
+                           Delphi 5 and newer versions
+2001-01-30  HeySt          Introduced Version Numbering
+                           Made LoadFromFile and LoadFromBuffer BOOLEAN functions
+                           Introduced FileMode parameter for LoadFromFile
+                           BugFix: TAttrList.Analyze: Must add CWhitespace to ExtractName call
+                           Comments worked over
+2001-02-28  HeySt  1.0.10  Completely worked over and tested the UTF-8 functions
+                           Fixed a bug in TXmlParser.Scan which caused it to start over when it
+                           was called after the end of scanning, resulting in an endless loop
+                           TEntityStack is now a TObjectList instead of TList
+2001-07-03  HeySt  1.0.11  Updated Compiler Version IFDEFs for Kylix
+2001-07-11  HeySt  1.0.12  New TCustomXmlScanner component (taken over from LibXmlComps.pas)
+2001-07-14  HeySt  1.0.13  Bugfix TCustomXmlScanner.FOnTranslateEncoding
+2001-10-22  HeySt          Don't clear CurName anymore when the parser finds a CDATA section.
+2001-12-03  HeySt  1.0.14  TObjectList.Clear: Make call to INHERITED method (fixes a memory leak)
+2001-12-05  HeySt  1.0.15  TObjectList.Clear: removed call to INHERITED method
+                           TObjectList.Destroy: Inserted SetCapacity call.
+                           Reduces need for frequent re-allocation of pointer buffer
+                           Dedicated to my father, Theodor Heymann
+2002-06-26  HeySt  1.0.16  TXmlParser.Scan: Fixed a bug with PIs whose name is beginning
+                           with 'xml'. Thanks to Uwe Kamm for submitting this bug.
+                           The CurEncoding property is now always in uppercase letters (the XML
+                           spec wants it to be treated case independently so when it's uppercase
+                           comparisons are faster)
+2002-03-04  HeySt  1.0.17  Included an IFDEF for Delphi 7 (VER150) and Kylix
+                           There is a new symbol HAS_CONTNRS_UNIT which is used now to
+                           distinguish between IDEs which come with the Contnrs unit and
+                           those that don't.
+*)
+
+UNIT libxmlparser;
+
+{$I jedi-sdl.inc}
+
+INTERFACE
+
+USES
+  SysUtils, Classes,
+  (*$IFDEF HAS_CONTNRS_UNIT *)  // The Contnrs Unit was introduced in Delphi 5
+  Contnrs,
+  (*$ENDIF*)
+  Math;
+
+CONST
+  CVersion = '1.0.17';  // This variable will be updated for every release
+                        // (I hope, I won't forget to do it everytime ...)
+
+TYPE
+  TPartType    = // --- Document Part Types
+                 (ptNone,            // Nothing
+                  ptXmlProlog,       // XML Prolog                  XmlSpec 2.8 / 4.3.1
+                  ptComment,         // Comment                     XmlSpec 2.5
+                  ptPI,              // Processing Instruction      XmlSpec 2.6
+                  ptDtdc,            // Document Type Declaration   XmlSpec 2.8
+                  ptStartTag,        // Start Tag                   XmlSpec 3.1
+                  ptEmptyTag,        // Empty-Element Tag           XmlSpec 3.1
+                  ptEndTag,          // End Tag                     XmlSpec 3.1
+                  ptContent,         // Text Content between Tags
+                  ptCData);          // CDATA Section               XmlSpec 2.7
+
+  TDtdElemType = // --- DTD Elements
+                 (deElement,         // !ELEMENT declaration
+                  deAttList,         // !ATTLIST declaration
+                  deEntity,          // !ENTITY declaration
+                  deNotation,        // !NOTATION declaration
+                  dePI,              // PI in DTD
+                  deComment,         // Comment in DTD
+                  deError);          // Error found in the DTD
+
+TYPE
+  TAttrList    = CLASS;
+  TEntityStack = CLASS;
+  TNvpList     = CLASS;
+  TElemDef     = CLASS;
+  TElemList    = CLASS;
+  TEntityDef   = CLASS;
+  TNotationDef = CLASS;
+
+  TDtdElementRec = RECORD    // --- This Record is returned by the DTD parser callback function
+                     Start, Final : PChar;                             // Start/End of the Element's Declaration
+                     CASE ElementType : TDtdElemType OF                // Type of the Element
+                       deElement,                                      // <!ELEMENT>
+                       deAttList  : (ElemDef      : TElemDef);         // <!ATTLIST>
+                       deEntity   : (EntityDef    : TEntityDef);       // <!ENTITY>
+                       deNotation : (NotationDef  : TNotationDef);     // <!NOTATION>
+                       dePI       : (Target       : PChar;             // <?PI ?>
+                                     Content      : PChar;
+                                     AttrList     : TAttrList);
+                       deError    : (Pos          : PChar);            // Error
+                       // deComment : ((No additional fields here));   // <!-- Comment -->
+                   END;
+
+  TXmlParser = CLASS                             // --- Internal Properties and Methods
+               PROTECTED
+                 FBuffer      : PChar;           // NIL if there is no buffer available
+                 FBufferSize  : INTEGER;         // 0 if the buffer is not owned by the Document instance
+                 FSource      : STRING;          // Name of Source of document. Filename for Documents loaded with LoadFromFile
+
+                 FXmlVersion  : STRING;          // XML version from Document header. Default is '1.0'
+                 FEncoding    : STRING;          // Encoding from Document header. Default is 'UTF-8'
+                 FStandalone  : BOOLEAN;         // Standalone declaration from Document header. Default is 'yes'
+                 FRootName    : STRING;          // Name of the Root Element (= DTD name)
+                 FDtdcFinal   : PChar;           // Pointer to the '>' character terminating the DTD declaration
+
+                 FNormalize   : BOOLEAN;         // If true: Pack Whitespace and don't return empty contents
+                 EntityStack  : TEntityStack;    // Entity Stack for Parameter and General Entities
+                 FCurEncoding : STRING;          // Current Encoding during parsing (always uppercase)
+
+                 PROCEDURE AnalyzeProlog;                                         // Analyze XML Prolog or Text Declaration
+                 PROCEDURE AnalyzeComment (Start : PChar; VAR Final : PChar);     // Analyze Comments
+                 PROCEDURE AnalyzePI      (Start : PChar; VAR Final : PChar);     // Analyze Processing Instructions (PI)
+                 PROCEDURE AnalyzeDtdc;                                           // Analyze Document Type Declaration
+                 PROCEDURE AnalyzeDtdElements (Start : PChar; VAR Final : PChar); // Analyze DTD declarations
+                 PROCEDURE AnalyzeTag;                                            // Analyze Start/End/Empty-Element Tags
+                 PROCEDURE AnalyzeCData;                                          // Analyze CDATA Sections
+                 PROCEDURE AnalyzeText (VAR IsDone : BOOLEAN);                    // Analyze Text Content between Tags
+                 PROCEDURE AnalyzeElementDecl  (Start : PChar; VAR Final : PChar);
+                 PROCEDURE AnalyzeAttListDecl  (Start : PChar; VAR Final : PChar);
+                 PROCEDURE AnalyzeEntityDecl   (Start : PChar; VAR Final : PChar);
+                 PROCEDURE AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);
+
+                 PROCEDURE PushPE (VAR Start : PChar);
+                 PROCEDURE ReplaceCharacterEntities (VAR Str : STRING);
+                 PROCEDURE ReplaceParameterEntities (VAR Str : STRING);
+                 PROCEDURE ReplaceGeneralEntities   (VAR Str : STRING);
+
+                 FUNCTION GetDocBuffer : PChar;  // Returns FBuffer or a pointer to a NUL char if Buffer is empty
+
+               PUBLIC                         // --- Document Properties
+                 PROPERTY XmlVersion : STRING  READ FXmlVersion;                 // XML version from the Document Prolog
+                 PROPERTY Encoding   : STRING  READ FEncoding;                   // Document Encoding from Prolog
+                 PROPERTY Standalone : BOOLEAN READ FStandalone;                 // Standalone Declaration from Prolog
+                 PROPERTY RootName   : STRING  READ FRootName;                   // Name of the Root Element
+                 PROPERTY Normalize  : BOOLEAN READ FNormalize WRITE FNormalize; // True if Content is to be normalized
+                 PROPERTY Source     : STRING  READ FSource;                     // Name of Document Source (Filename)
+                 PROPERTY DocBuffer  : PChar   READ GetDocBuffer;                // Returns document buffer
+               PUBLIC                         // --- DTD Objects
+                 Elements    : TElemList;     // Elements: List of TElemDef (contains Attribute Definitions)
+                 Entities    : TNvpList;      // General Entities: List of TEntityDef
+                 ParEntities : TNvpList;      // Parameter Entities: List of TEntityDef
+                 Notations   : TNvpList;      // Notations: List of TNotationDef
+               PUBLIC
+                 CONSTRUCTOR Create;
+                 DESTRUCTOR Destroy;                                      OVERRIDE;
+
+                 // --- Document Handling
+                 FUNCTION  LoadFromFile   (Filename : STRING;
+                                           FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;
+                                                                          // Loads Document from given file
+                 FUNCTION  LoadFromBuffer (Buffer : PChar) : BOOLEAN;     // Loads Document from another buffer
+                 PROCEDURE SetBuffer      (Buffer : PChar);               // References another buffer
+                 PROCEDURE Clear;                                         // Clear Document
+
+               PUBLIC
+                 // --- Scanning through the document
+                 CurPartType : TPartType;                         // Current Type
+                 CurName     : STRING;                            // Current Name
+                 CurContent  : STRING;                            // Current Normalized Content
+                 CurStart    : PChar;                             // Current First character
+                 CurFinal    : PChar;                             // Current Last character
+                 CurAttr     : TAttrList;                         // Current Attribute List
+                 PROPERTY CurEncoding : STRING READ FCurEncoding; // Current Encoding
+                 PROCEDURE StartScan;
+                 FUNCTION  Scan : BOOLEAN;
+
+                 // --- Events / Callbacks
+                 FUNCTION  LoadExternalEntity (SystemId, PublicId,
+                                               Notation : STRING) : TXmlParser;     VIRTUAL;
+                 FUNCTION  TranslateEncoding  (CONST Source : STRING) : STRING;     VIRTUAL;
+                 PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec);        VIRTUAL;
+               END;
+
+  TValueType   = // --- Attribute Value Type
+                 (vtNormal,       // Normal specified Attribute
+                  vtImplied,      // #IMPLIED attribute value
+                  vtFixed,        // #FIXED attribute value
+                  vtDefault);     // Attribute value from default value in !ATTLIST declaration
+
+  TAttrDefault = // --- Attribute Default Type
+                 (adDefault,      // Normal default value
+                  adRequired,     // #REQUIRED attribute
+                  adImplied,      // #IMPLIED attribute
+                  adFixed);       // #FIXED attribute
+
+  TAttrType    = // --- Type of attribute
+                 (atUnknown,      // Unknown type
+                  atCData,        // Character data only
+                  atID,           // ID
+                  atIdRef,        // ID Reference
+                  atIdRefs,       // Several ID References, separated by Whitespace
+                  atEntity,       // Name of an unparsed Entity
+                  atEntities,     // Several unparsed Entity names, separated by Whitespace
+                  atNmToken,      // Name Token
+                  atNmTokens,     // Several Name Tokens, separated by Whitespace
+                  atNotation,     // A selection of Notation names (Unparsed Entity)
+                  atEnumeration); // Enumeration
+
+  TElemType    = // --- Element content type
+                 (etEmpty,        // Element is always empty
+                  etAny,          // Element can have any mixture of PCDATA and any elements
+                  etChildren,     // Element must contain only elements
+                  etMixed);       // Mixed PCDATA and elements
+
+  (*$IFDEF HAS_CONTNRS_UNIT *)
+  TObjectList = Contnrs.TObjectList;    // Re-Export this identifier
+  (*$ELSE *)
+  TObjectList = CLASS (TList)
+                  DESTRUCTOR Destroy; OVERRIDE;
+                  PROCEDURE Delete (Index : INTEGER);
+                  PROCEDURE Clear; OVERRIDE;
+                END;
+  (*$ENDIF *)
+
+  TNvpNode  = CLASS                     // Name-Value Pair Node
+                 Name  : STRING;
+                 Value : STRING;
+                 CONSTRUCTOR Create (TheName : STRING = ''; TheValue : STRING = '');
+              END;
+
+  TNvpList  = CLASS (TObjectList)       // Name-Value Pair List
+                PROCEDURE Add   (Node  : TNvpNode);
+                FUNCTION  Node  (Name  : STRING)  : TNvpNode;  OVERLOAD;
+                FUNCTION  Node  (Index : INTEGER) : TNvpNode;  OVERLOAD;
+                FUNCTION  Value (Name  : STRING)  : STRING;    OVERLOAD;
+                FUNCTION  Value (Index : INTEGER) : STRING;    OVERLOAD;
+                FUNCTION  Name  (Index : INTEGER) : STRING;
+              END;
+
+  TAttr     = CLASS (TNvpNode)          // Attribute of a Start-Tag or Empty-Element-Tag
+                 ValueType : TValueType;
+                 AttrType  : TAttrType;
+               END;
+
+  TAttrList = CLASS (TNvpList)          // List of Attributes
+                PROCEDURE Analyze (Start : PChar; VAR Final : PChar);
+              END;
+
+  TEntityStack = CLASS (TObjectList)    // Stack where current position is stored before parsing entities
+                 PROTECTED
+                   Owner : TXmlParser;
+                 PUBLIC
+                   CONSTRUCTOR Create (TheOwner : TXmlParser);
+                   PROCEDURE Push (LastPos : PChar);                      OVERLOAD;
+                   PROCEDURE Push (Instance : TObject; LastPos : PChar);  OVERLOAD;
+                   FUNCTION  Pop : PChar;         // Returns next char or NIL if EOF is reached. Frees Instance.
+                 END;
+
+  TAttrDef    = CLASS (TNvpNode)        // Represents a <!ATTLIST Definition. "Value" is the default value
+                  TypeDef     : STRING;           // Type definition from the DTD
+                  Notations   : STRING;           // Notation List, separated by pipe symbols '|'
+                  AttrType    : TAttrType;        // Attribute Type
+                  DefaultType : TAttrDefault;     // Default Type
+                END;
+
+  TElemDef    = CLASS (TNvpList)       // Represents a <!ELEMENT Definition. Is a list of TAttrDef-Nodes
+                  Name       : STRING;            // Element name
+                  ElemType   : TElemType;         // Element type
+                  Definition : STRING;            // Element definition from DTD
+                END;
+
+  TElemList   = CLASS (TObjectList)    // List of TElemDef nodes
+                  FUNCTION  Node (Name : STRING) : TElemDef;
+                  PROCEDURE Add (Node : TElemDef);
+                END;
+
+  TEntityDef  = CLASS (TNvpNode)       // Represents a <!ENTITY Definition.
+                  SystemId     : STRING;
+                  PublicId     : STRING;
+                  NotationName : STRING;
+                END;
+
+  TNotationDef = CLASS (TNvpNode)      // Represents a <!NOTATION Definition. Value is the System ID
+                   PublicId : STRING;
+                 END;
+
+  TCharset = SET OF CHAR;
+
+
+CONST
+  CWhitespace   = [#32, #9, #13, #10];                // Whitespace characters (XmlSpec 2.3)
+  CLetter       = [#$41..#$5A, #$61..#$7A, #$C0..#$D6, #$D8..#$F6, #$F8..#$FF];
+  CDigit        = [#$30..#$39];
+  CNameChar     = CLetter + CDigit + ['.', '-', '_', ':', #$B7];
+  CNameStart    = CLetter + ['_', ':'];
+  CQuoteChar    = ['"', ''''];
+  CPubidChar    = [#32, ^M, ^J, #9, 'a'..'z', 'A'..'Z', '0'..'9',
+                   '-', '''', '(', ')', '+', ',', '.', '/', ':',
+                   '=', '?', ';', '!', '*', '#', '@', '$', '_', '%'];
+
+  CDStart       = '<![CDATA[';
+  CDEnd         = ']]>';
+
+  // --- Name Constants for the above enumeration types
+  CPartType_Name : ARRAY [TPartType] OF STRING =
+                   ('', 'XML Prolog', 'Comment', 'PI',
+                    'DTD Declaration', 'Start Tag', 'Empty Tag', 'End Tag',
+                    'Text', 'CDATA');
+  CValueType_Name   : ARRAY [TValueType]    OF STRING = ('Normal', 'Implied', 'Fixed', 'Default');
+  CAttrDefault_Name : ARRAY [TAttrDefault]  OF STRING = ('Default', 'Required', 'Implied', 'Fixed');
+  CElemType_Name    : ARRAY [TElemType]     OF STRING = ('Empty', 'Any', 'Childs only', 'Mixed');
+  CAttrType_Name    : ARRAY [TAttrType]     OF STRING = ('Unknown', 'CDATA',
+                                                         'ID', 'IDREF', 'IDREFS',
+                                                         'ENTITY', 'ENTITIES',
+                                                         'NMTOKEN', 'NMTOKENS',
+                                                         'Notation', 'Enumeration');
+
+FUNCTION  ConvertWs   (Source: STRING; PackWs: BOOLEAN) : STRING;          // Convert WS to spaces #x20
+PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar);  // SetString by Start/Final of buffer
+FUNCTION  StrSFPas    (Start, Finish : PChar) : STRING;                    // Convert buffer part to Pascal string
+FUNCTION  TrimWs      (Source : STRING) : STRING;                          // Trim Whitespace
+
+FUNCTION  AnsiToUtf8  (Source : ANSISTRING) : STRING;                            // Convert Win-1252 to UTF-8
+FUNCTION  Utf8ToAnsi  (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING;  // Convert UTF-8 to Win-1252
+
+
+(*
+===============================================================================================
+TCustomXmlScanner event based component wrapper for TXmlParser
+===============================================================================================
+*)
+
+TYPE
+  TCustomXmlScanner = CLASS;
+  TXmlPrologEvent   = PROCEDURE (Sender : TObject; XmlVersion, Encoding: STRING; Standalone : BOOLEAN) OF OBJECT;
+  TCommentEvent     = PROCEDURE (Sender : TObject; Comment : STRING)                                   OF OBJECT;
+  TPIEvent          = PROCEDURE (Sender : TObject; Target, Content: STRING; Attributes : TAttrList)    OF OBJECT;
+  TDtdEvent         = PROCEDURE (Sender : TObject; RootElementName : STRING)                           OF OBJECT;
+  TStartTagEvent    = PROCEDURE (Sender : TObject; TagName : STRING; Attributes : TAttrList)           OF OBJECT;
+  TEndTagEvent      = PROCEDURE (Sender : TObject; TagName : STRING)                                   OF OBJECT;
+  TContentEvent     = PROCEDURE (Sender : TObject; Content : STRING)                                   OF OBJECT;
+  TElementEvent     = PROCEDURE (Sender : TObject; ElemDef : TElemDef)                                 OF OBJECT;
+  TEntityEvent      = PROCEDURE (Sender : TObject; EntityDef : TEntityDef)                             OF OBJECT;
+  TNotationEvent    = PROCEDURE (Sender : TObject; NotationDef : TNotationDef)                         OF OBJECT;
+  TErrorEvent       = PROCEDURE (Sender : TObject; ErrorPos : PChar)                                   OF OBJECT;
+  TExternalEvent    = PROCEDURE (Sender : TObject; SystemId, PublicId, NotationId : STRING;
+                                 VAR Result : TXmlParser)                                              OF OBJECT;
+  TEncodingEvent    = FUNCTION  (Sender : TObject; CurrentEncoding, Source : STRING) : STRING          OF OBJECT;
+
+
+  TCustomXmlScanner = CLASS (TComponent)
+    PROTECTED
+      FXmlParser           : TXmlParser;
+      FOnXmlProlog         : TXmlPrologEvent;
+      FOnComment           : TCommentEvent;
+      FOnPI                : TPIEvent;
+      FOnDtdRead           : TDtdEvent;
+      FOnStartTag          : TStartTagEvent;
+      FOnEmptyTag          : TStartTagEvent;
+      FOnEndTag            : TEndTagEvent;
+      FOnContent           : TContentEvent;
+      FOnCData             : TContentEvent;
+      FOnElement           : TElementEvent;
+      FOnAttList           : TElementEvent;
+      FOnEntity            : TEntityEvent;
+      FOnNotation          : TNotationEvent;
+      FOnDtdError          : TErrorEvent;
+      FOnLoadExternal      : TExternalEvent;
+      FOnTranslateEncoding : TEncodingEvent;
+      FStopParser          : BOOLEAN;
+      FUNCTION  GetNormalize : BOOLEAN;
+      PROCEDURE SetNormalize (Value : BOOLEAN);
+
+      PROCEDURE WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN); VIRTUAL;
+      PROCEDURE WhenComment  (Comment : STRING);                                   VIRTUAL;
+      PROCEDURE WhenPI       (Target, Content: STRING; Attributes : TAttrList);    VIRTUAL;
+      PROCEDURE WhenDtdRead  (RootElementName : STRING);                           VIRTUAL;
+      PROCEDURE WhenStartTag (TagName : STRING; Attributes : TAttrList);           VIRTUAL;
+      PROCEDURE WhenEmptyTag (TagName : STRING; Attributes : TAttrList);           VIRTUAL;
+      PROCEDURE WhenEndTag   (TagName : STRING);                                   VIRTUAL;
+      PROCEDURE WhenContent  (Content : STRING);                                   VIRTUAL;
+      PROCEDURE WhenCData    (Content : STRING);                                   VIRTUAL;
+      PROCEDURE WhenElement  (ElemDef : TElemDef);                                 VIRTUAL;
+      PROCEDURE WhenAttList  (ElemDef : TElemDef);                                 VIRTUAL;
+      PROCEDURE WhenEntity   (EntityDef : TEntityDef);                             VIRTUAL;
+      PROCEDURE WhenNotation (NotationDef : TNotationDef);                         VIRTUAL;
+      PROCEDURE WhenDtdError (ErrorPos : PChar);                                   VIRTUAL;
+
+    PUBLIC
+      CONSTRUCTOR Create (AOwner: TComponent); OVERRIDE;
+      DESTRUCTOR Destroy;                      OVERRIDE;
+
+      PROCEDURE LoadFromFile   (Filename : TFilename);   // Load XML Document from file
+      PROCEDURE LoadFromBuffer (Buffer : PChar);         // Load XML Document from buffer
+      PROCEDURE SetBuffer      (Buffer : PChar);         // Refer to Buffer
+      FUNCTION  GetFilename : TFilename;
+
+      PROCEDURE Execute;                                 // Perform scanning
+
+    PROTECTED
+      PROPERTY XmlParser           : TXmlParser        READ FXmlParser;
+      PROPERTY StopParser          : BOOLEAN           READ FStopParser          WRITE FStopParser;
+      PROPERTY Filename            : TFilename         READ GetFilename          WRITE LoadFromFile;
+      PROPERTY Normalize           : BOOLEAN           READ GetNormalize         WRITE SetNormalize;
+      PROPERTY OnXmlProlog         : TXmlPrologEvent   READ FOnXmlProlog         WRITE FOnXmlProlog;
+      PROPERTY OnComment           : TCommentEvent     READ FOnComment           WRITE FOnComment;
+      PROPERTY OnPI                : TPIEvent          READ FOnPI                WRITE FOnPI;
+      PROPERTY OnDtdRead           : TDtdEvent         READ FOnDtdRead           WRITE FOnDtdRead;
+      PROPERTY OnStartTag          : TStartTagEvent    READ FOnStartTag          WRITE FOnStartTag;
+      PROPERTY OnEmptyTag          : TStartTagEvent    READ FOnEmptyTag          WRITE FOnEmptyTag;
+      PROPERTY OnEndTag            : TEndTagEvent      READ FOnEndTag            WRITE FOnEndTag;
+      PROPERTY OnContent           : TContentEvent     READ FOnContent           WRITE FOnContent;
+      PROPERTY OnCData             : TContentEvent     READ FOnCData             WRITE FOnCData;
+      PROPERTY OnElement           : TElementEvent     READ FOnElement           WRITE FOnElement;
+      PROPERTY OnAttList           : TElementEvent     READ FOnAttList           WRITE FOnAttList;
+      PROPERTY OnEntity            : TEntityEvent      READ FOnEntity            WRITE FOnEntity;
+      PROPERTY OnNotation          : TNotationEvent    READ FOnNotation          WRITE FOnNotation;
+      PROPERTY OnDtdError          : TErrorEvent       READ FOnDtdError          WRITE FOnDtdError;
+      PROPERTY OnLoadExternal      : TExternalEvent    READ FOnLoadExternal      WRITE FOnLoadExternal;
+      PROPERTY OnTranslateEncoding : TEncodingEvent    READ FOnTranslateEncoding WRITE FOnTranslateEncoding;
+    END;
+
+(*
+===============================================================================================
+IMPLEMENTATION
+===============================================================================================
+*)
+
+IMPLEMENTATION
+
+
+(*
+===============================================================================================
+Unicode and UTF-8 stuff
+===============================================================================================
+*)
+
+CONST
+  // --- Character Translation Table for Unicode <-> Win-1252
+  WIN1252_UNICODE : ARRAY [$00..$FF] OF WORD = (
+                    $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009,
+                    $000A, $000B, $000C, $000D, $000E, $000F, $0010, $0011, $0012, $0013,
+                    $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D,
+                    $001E, $001F, $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027,
+                    $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F, $0030, $0031,
+                    $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B,
+                    $003C, $003D, $003E, $003F, $0040, $0041, $0042, $0043, $0044, $0045,
+                    $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
+                    $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059,
+                    $005A, $005B, $005C, $005D, $005E, $005F, $0060, $0061, $0062, $0063,
+                    $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D,
+                    $006E, $006F, $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077,
+                    $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
+
+                    $20AC, $0081, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030,
+                    $0160, $2039, $0152, $008D, $017D, $008F, $0090, $2018, $2019, $201C,
+                    $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $009D,
+                    $017E, $0178, $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+                    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, $00B0, $00B1,
+                    $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB,
+                    $00BC, $00BD, $00BE, $00BF, $00C0, $00C1, $00C2, $00C3, $00C4, $00C5,
+                    $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+                    $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9,
+                    $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, $00E0, $00E1, $00E2, $00E3,
+                    $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED,
+                    $00EE, $00EF, $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+                    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF);
+
+(* UTF-8  (somewhat simplified)
+   -----
+   Character Range    Byte sequence
+   ---------------    --------------------------     (x=Bits from original character)
+   $0000..$007F       0xxxxxxx
+   $0080..$07FF       110xxxxx 10xxxxxx
+   $8000..$FFFF       1110xxxx 10xxxxxx 10xxxxxx
+
+   Example
+   --------
+   Transforming the Unicode character U+00E4 LATIN SMALL LETTER A WITH DIAERESIS  ("ä"):
+
+         ISO-8859-1,           Decimal  228
+         Win1252,              Hex      $E4
+         ANSI                  Bin      1110 0100
+                                        abcd efgh
+
+         UTF-8                 Binary   1100xxab 10cdefgh
+                               Binary   11000011 10100100
+                               Hex      $C3      $A4
+                               Decimal  195      164
+                               ANSI     Ã        ¤         *)
+
+
+FUNCTION  AnsiToUtf8 (Source : ANSISTRING) : STRING;
+          (* Converts the given Windows ANSI (Win1252) String to UTF-8. *)
+VAR
+  I   : INTEGER;  // Loop counter
+  U   : WORD;     // Current Unicode value
+  Len : INTEGER;  // Current real length of "Result" string
+BEGIN
+  SetLength (Result, Length (Source) * 3);   // Worst case
+  Len := 0;
+  FOR I := 1 TO Length (Source) DO BEGIN
+    U := WIN1252_UNICODE [ORD (Source [I])];
+    CASE U OF
+      $0000..$007F : BEGIN
+                       INC (Len);
+                       Result [Len] := CHR (U);
+                     END;
+      $0080..$07FF : BEGIN
+                       INC (Len);
+                       Result [Len] := CHR ($C0 OR (U SHR 6));
+                       INC (Len);
+                       Result [Len] := CHR ($80 OR (U AND $3F));
+                     END;
+      $0800..$FFFF : BEGIN
+                       INC (Len);
+                       Result [Len] := CHR ($E0 OR (U SHR 12));
+                       INC (Len);
+                       Result [Len] := CHR ($80 OR ((U SHR 6) AND $3F));
+                       INC (Len);
+                       Result [Len] := CHR ($80 OR (U AND $3F));
+                     END;
+      END;
+    END;
+  SetLength (Result, Len);
+END;
+
+
+FUNCTION  Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING;
+          (* Converts the given UTF-8 String to Windows ANSI (Win-1252).
+             If a character can not be converted, the "UnknownChar" is inserted. *)
+VAR
+  SourceLen : INTEGER;  // Length of Source string
+  I, K      : INTEGER;
+  A         : BYTE;     // Current ANSI character value
+  U         : WORD;
+  Ch        : CHAR;     // Dest char
+  Len       : INTEGER;  // Current real length of "Result" string
+BEGIN
+  SourceLen := Length (Source);
+  SetLength (Result, SourceLen);   // Enough room to live
+  Len := 0;
+  I   := 1;
+  WHILE I <= SourceLen DO BEGIN
+    A := ORD (Source [I]);
+    IF A < $80 THEN BEGIN                                               // Range $0000..$007F
+      INC (Len);
+      Result [Len] := Source [I];
+      INC (I);
+      END
+    ELSE BEGIN                                                          // Determine U, Inc I
+      IF (A AND $E0 = $C0) AND (I < SourceLen) THEN BEGIN               // Range $0080..$07FF
+        U := (WORD (A AND $1F) SHL 6) OR (ORD (Source [I+1]) AND $3F);
+        INC (I, 2);
+        END
+      ELSE IF (A AND $F0 = $E0) AND (I < SourceLen-1) THEN BEGIN        // Range $0800..$FFFF
+        U := (WORD (A AND $0F) SHL 12) OR
+             (WORD (ORD (Source [I+1]) AND $3F) SHL 6) OR
+             (      ORD (Source [I+2]) AND $3F);
+        INC (I, 3);
+        END
+      ELSE BEGIN                                                        // Unknown/unsupported
+        INC (I);
+        FOR K := 7 DOWNTO 0 DO
+          IF A AND (1 SHL K) = 0 THEN BEGIN
+            INC (I, (A SHR (K+1))-1);
+            BREAK;
+            END;
+        U := WIN1252_UNICODE [ORD (UnknownChar)];
+        END;
+      Ch := UnknownChar;                                                // Retrieve ANSI char
+      FOR A := $00 TO $FF DO
+        IF WIN1252_UNICODE [A] = U THEN BEGIN
+          Ch := CHR (A);
+          BREAK;
+          END;
+      INC (Len);
+      Result [Len] := Ch;
+      END;
+    END;
+  SetLength (Result, Len);
+END;
+
+
+(*
+===============================================================================================
+"Special" Helper Functions
+
+Don't ask me why. But including these functions makes the parser *DRAMATICALLY* faster
+on my K6-233 machine. You can test it yourself just by commenting them out.
+They do exactly the same as the Assembler routines defined in SysUtils.
+(This is where you can see how great the Delphi compiler really is. The compiled code is
+faster than hand-coded assembler!)
+===============================================================================================
+--> Just move this line below the StrScan function -->  *)
+
+
+FUNCTION StrPos (CONST Str, SearchStr : PChar) : PChar;
+         // Same functionality as SysUtils.StrPos
+VAR
+  First : CHAR;
+  Len   : INTEGER;
+BEGIN
+  First  := SearchStr^;
+  Len    := StrLen (SearchStr);
+  Result := Str;
+  REPEAT
+    IF Result^ = First THEN
+      IF StrLComp (Result, SearchStr, Len) = 0 THEN BREAK;
+    IF Result^ = #0 THEN BEGIN
+      Result := NIL;
+      BREAK;
+      END;
+    INC (Result);
+  UNTIL FALSE;
+END;
+
+
+FUNCTION StrScan (CONST Start : PChar; CONST Ch : CHAR) : PChar;
+         // Same functionality as SysUtils.StrScan
+BEGIN
+  Result := Start;
+  WHILE Result^ <> Ch DO BEGIN
+    IF Result^ = #0 THEN BEGIN
+      Result := NIL;
+      EXIT;
+      END;
+    INC (Result);
+    END;
+END;
+
+
+(*
+===============================================================================================
+Helper Functions
+===============================================================================================
+*)
+
+FUNCTION  DelChars (Source : STRING; CharsToDelete : TCharset) : STRING;
+          // Delete all "CharsToDelete" from the string
+VAR
+  I : INTEGER;
+BEGIN
+  Result := Source;
+  FOR I := Length (Result) DOWNTO 1 DO
+    IF Result [I] IN CharsToDelete THEN
+      Delete (Result, I, 1);
+END;
+
+
+FUNCTION  TrimWs (Source : STRING) : STRING;
+          // Trimms off Whitespace characters from both ends of the string
+VAR
+  I : INTEGER;
+BEGIN
+  // --- Trim Left
+  I := 1;
+  WHILE (I <= Length (Source)) AND (Source [I] IN CWhitespace) DO
+    INC (I);
+  Result := Copy (Source, I, MaxInt);
+
+  // --- Trim Right
+  I := Length (Result);
+  WHILE (I > 1) AND (Result [I] IN CWhitespace) DO
+    DEC (I);
+  Delete (Result, I+1, Length (Result)-I);
+END;
+
+
+FUNCTION  ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING;
+          // Converts all Whitespace characters to the Space #x20 character
+          // If "PackWs" is true, contiguous Whitespace characters are packed to one
+VAR
+  I : INTEGER;
+BEGIN
+  Result := Source;
+  FOR I := Length (Result) DOWNTO 1 DO
+    IF (Result [I] IN CWhitespace) THEN
+      IF PackWs AND (I > 1) AND (Result [I-1] IN CWhitespace)
+        THEN Delete (Result, I, 1)
+        ELSE Result [I] := #32;
+END;
+
+
+PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar);
+BEGIN
+  SetString (S, BufferStart, BufferFinal-BufferStart+1);
+END;
+
+
+FUNCTION  StrLPas  (Start : PChar; Len : INTEGER) : STRING;
+BEGIN
+  SetString (Result, Start, Len);
+END;
+
+
+FUNCTION  StrSFPas (Start, Finish : PChar) : STRING;
+BEGIN
+  SetString (Result, Start, Finish-Start+1);
+END;
+
+
+FUNCTION  StrScanE (CONST Source : PChar; CONST CharToScanFor : CHAR) : PChar;
+          // If "CharToScanFor" is not found, StrScanE returns the last char of the
+          // buffer instead of NIL
+BEGIN
+  Result := StrScan (Source, CharToScanFor);
+  IF Result = NIL THEN
+    Result := StrEnd (Source)-1;
+END;
+
+
+PROCEDURE ExtractName (Start : PChar; Terminators : TCharset; VAR Final : PChar);
+          (* Extracts the complete Name beginning at "Start".
+             It is assumed that the name is contained in Markup, so the '>' character is
+             always a Termination.
+             Start:       IN  Pointer to first char of name. Is always considered to be valid
+             Terminators: IN  Characters which terminate the name
+             Final:       OUT Pointer to last char of name *)
+BEGIN
+  Final := Start+1;
+  Include (Terminators, #0);
+  Include (Terminators, '>');
+  WHILE NOT (Final^ IN Terminators) DO
+    INC (Final);
+  DEC (Final);
+END;
+
+
+PROCEDURE ExtractQuote (Start : PChar; VAR Content : STRING; VAR Final : PChar);
+          (* Extract a string which is contained in single or double Quotes.
+             Start:    IN   Pointer to opening quote
+             Content:  OUT  The quoted string
+             Final:    OUT  Pointer to closing quote *)
+BEGIN
+  Final := StrScan (Start+1, Start^);
+  IF Final = NIL THEN BEGIN
+    Final := StrEnd (Start+1)-1;
+    SetString (Content, Start+1, Final-Start);
+    END
+  ELSE
+    SetString (Content, Start+1, Final-1-Start);
+END;
+
+
+(*
+===============================================================================================
+TEntityStackNode
+This Node is pushed to the "Entity Stack" whenever the parser parses entity replacement text.
+The "Instance" field holds the Instance pointer of an External Entity buffer. When it is
+popped, the Instance is freed.
+The "Encoding" field holds the name of the Encoding. External Parsed Entities may have
+another encoding as the document entity (XmlSpec 4.3.3). So when there is an "<?xml" PI
+found in the stream (= Text Declaration at the beginning of external parsed entities), the
+Encoding found there is used for the External Entity (is assigned to TXmlParser.CurEncoding)
+Default Encoding is for the Document Entity is UTF-8. It is assumed that External Entities
+have the same Encoding as the Document Entity, unless they carry a Text Declaration.
+===============================================================================================
+*)
+
+TYPE
+  TEntityStackNode = CLASS
+                       Instance : TObject;
+                       Encoding : STRING;
+                       LastPos  : PChar;
+                     END;
+
+(*
+===============================================================================================
+TEntityStack
+For nesting of Entities.
+When there is an entity reference found in the data stream, the corresponding entity
+definition is searched and the current position is pushed to this stack.
+From then on, the program scans the entitiy replacement text as if it were normal content.
+When the parser reaches the end of an entity, the current position is popped off the
+stack again.
+===============================================================================================
+*)
+
+CONSTRUCTOR TEntityStack.Create (TheOwner : TXmlParser);
+BEGIN
+  INHERITED Create;
+  Owner := TheOwner;
+END;
+
+
+PROCEDURE TEntityStack.Push (LastPos : PChar);
+BEGIN
+  Push (NIL, LastPos);
+END;
+
+
+PROCEDURE TEntityStack.Push (Instance : TObject; LastPos : PChar);
+VAR
+  ESN : TEntityStackNode;
+BEGIN
+  ESN := TEntityStackNode.Create;
+  ESN.Instance := Instance;
+  ESN.Encoding := Owner.FCurEncoding;  // Save current Encoding
+  ESN.LastPos  := LastPos;
+  Add (ESN);
+END;
+
+
+FUNCTION  TEntityStack.Pop : PChar;
+VAR
+  ESN : TEntityStackNode;
+BEGIN
+  IF Count > 0 THEN BEGIN
+    ESN := TEntityStackNode (Items [Count-1]);
+    Result := ESN.LastPos;
+    IF ESN.Instance <> NIL THEN
+      ESN.Instance.Free;
+    IF ESN.Encoding <> '' THEN
+      Owner.FCurEncoding := ESN.Encoding;   // Restore current Encoding
+    Delete (Count-1);
+    END
+  ELSE
+    Result := NIL;
+END;
+
+
+(*
+===============================================================================================
+TExternalID
+-----------
+XmlSpec 4.2.2:  ExternalID ::= 'SYSTEM' S SystemLiteral |
+                               'PUBLIC' S PubidLiteral S SystemLiteral
+XmlSpec 4.7:    PublicID   ::= 'PUBLIC' S PubidLiteral
+SystemLiteral and PubidLiteral are quoted
+===============================================================================================
+*)
+
+TYPE
+  TExternalID = CLASS
+                  PublicId : STRING;
+                  SystemId : STRING;
+                  Final    : PChar;
+                  CONSTRUCTOR Create (Start : PChar);
+                END;
+
+CONSTRUCTOR TExternalID.Create (Start : PChar);
+BEGIN
+  INHERITED Create;
+  Final := Start;
+  IF StrLComp (Start, 'SYSTEM', 6) = 0 THEN BEGIN
+    WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);
+    IF NOT (Final^ IN CQuoteChar) THEN EXIT;
+    ExtractQuote (Final, SystemID, Final);
+    END
+  ELSE IF StrLComp (Start, 'PUBLIC', 6) = 0 THEN BEGIN
+    WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);
+    IF NOT (Final^ IN CQuoteChar) THEN EXIT;
+    ExtractQuote (Final, PublicID, Final);
+    INC (Final);
+    WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);
+    IF NOT (Final^ IN CQuoteChar) THEN EXIT;
+    ExtractQuote (Final, SystemID, Final);
+    END;
+END;
+
+
+(*
+===============================================================================================
+TXmlParser
+===============================================================================================
+*)
+
+CONSTRUCTOR TXmlParser.Create;
+BEGIN
+  INHERITED Create;
+  FBuffer     := NIL;
+  FBufferSize := 0;
+  Elements    := TElemList.Create;
+  Entities    := TNvpList.Create;
+  ParEntities := TNvpList.Create;
+  Notations   := TNvpList.Create;
+  CurAttr     := TAttrList.Create;
+  EntityStack := TEntityStack.Create (Self);
+  Clear;
+END;
+
+
+DESTRUCTOR TXmlParser.Destroy;
+BEGIN
+  Clear;
+  Elements.Free;
+  Entities.Free;
+  ParEntities.Free;
+  Notations.Free;
+  CurAttr.Free;
+  EntityStack.Free;
+  INHERITED Destroy;
+END;
+
+
+PROCEDURE TXmlParser.Clear;
+          // Free Buffer and clear all object attributes
+BEGIN
+  IF (FBufferSize > 0) AND (FBuffer <> NIL) THEN
+    FreeMem (FBuffer);
+  FBuffer     := NIL;
+  FBufferSize := 0;
+  FSource     := '';
+  FXmlVersion := '';
+  FEncoding   := '';
+  FStandalone := FALSE;
+  FRootName   := '';
+  FDtdcFinal  := NIL;
+  FNormalize  := TRUE;
+  Elements.Clear;
+  Entities.Clear;
+  ParEntities.Clear;
+  Notations.Clear;
+  CurAttr.Clear;
+  EntityStack.Clear;
+END;
+
+
+FUNCTION  TXmlParser.LoadFromFile (Filename : STRING; FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;
+          // Loads Document from given file
+          // Returns TRUE if successful
+VAR
+  f           : FILE;
+  ReadIn      : INTEGER;
+  OldFileMode : INTEGER;
+BEGIN
+  Result := FALSE;
+  Clear;
+
+  // --- Open File
+  OldFileMode := SYSTEM.FileMode;
+  TRY
+    SYSTEM.FileMode := FileMode;
+    TRY
+      AssignFile (f, Filename);
+      Reset (f, 1);
+    EXCEPT
+      EXIT;
+      END;
+
+    TRY
+      // --- Allocate Memory
+      TRY
+        FBufferSize := Filesize (f) + 1;
+        GetMem (FBuffer, FBufferSize);
+      EXCEPT
+        Clear;
+        EXIT;
+        END;
+
+      // --- Read File
+      TRY
+        BlockRead (f, FBuffer^, FBufferSize, ReadIn);
+        (FBuffer+ReadIn)^ := #0;  // NULL termination
+      EXCEPT
+        Clear;
+        EXIT;
+        END;
+    FINALLY
+      CloseFile (f);
+      END;
+
+    FSource := Filename;
+    Result  := TRUE;
+
+  FINALLY
+    SYSTEM.FileMode := OldFileMode;
+    END;
+END;
+
+
+FUNCTION  TXmlParser.LoadFromBuffer (Buffer : PChar) : BOOLEAN;
+          // Loads Document from another buffer
+          // Returns TRUE if successful
+          // The "Source" property becomes '<MEM>' if successful
+BEGIN
+  Result := FALSE;
+  Clear;
+  FBufferSize := StrLen (Buffer) + 1;
+  TRY
+    GetMem (FBuffer, FBufferSize);
+  EXCEPT
+    Clear;
+    EXIT;
+    END;
+  StrCopy (FBuffer, Buffer);
+  FSource := '<MEM>';
+  Result := TRUE;
+END;
+
+
+PROCEDURE TXmlParser.SetBuffer (Buffer : PChar);      // References another buffer
+BEGIN
+  Clear;
+  FBuffer     := Buffer;
+  FBufferSize := 0;
+  FSource := '<REFERENCE>';
+END;
+
+
+//-----------------------------------------------------------------------------------------------
+// Scanning through the document
+//-----------------------------------------------------------------------------------------------
+
+PROCEDURE TXmlParser.StartScan;
+BEGIN
+  CurPartType := ptNone;
+  CurName     := '';
+  CurContent  := '';
+  CurStart    := NIL;
+  CurFinal    := NIL;
+  CurAttr.Clear;
+  EntityStack.Clear;
+END;
+
+
+FUNCTION  TXmlParser.Scan : BOOLEAN;
+          // Scans the next Part
+          // Returns TRUE if a part could be found, FALSE if there is no part any more
+          //
+          // "IsDone" can be set to FALSE by AnalyzeText in order to go to the next part
+          // if there is no Content due to normalization
+VAR
+  IsDone : BOOLEAN;
+BEGIN
+  REPEAT
+    IsDone := TRUE;
+
+    // --- Start of next Part
+    IF CurStart = NIL
+      THEN CurStart := DocBuffer
+      ELSE CurStart := CurFinal+1;
+    CurFinal := CurStart;
+
+    // --- End of Document of Pop off a new part from the Entity stack?
+    IF CurStart^ = #0 THEN
+      CurStart := EntityStack.Pop;
+
+    // --- No Document or End Of Document: Terminate Scan
+    IF (CurStart = NIL) OR (CurStart^ = #0) THEN BEGIN
+      CurStart := StrEnd (DocBuffer);
+      CurFinal := CurStart-1;
+      EntityStack.Clear;
+      Result   := FALSE;
+      EXIT;
+      END;
+
+    IF (StrLComp (CurStart, '<?xml', 5) = 0) AND
+       ((CurStart+5)^ IN CWhitespace) THEN AnalyzeProlog                                      // XML Declaration, Text Declaration
+    ELSE IF StrLComp (CurStart, '<?',        2) = 0 THEN AnalyzePI (CurStart, CurFinal)       // PI
+    ELSE IF StrLComp (CurStart, '<!--',      4) = 0 THEN AnalyzeComment (CurStart, CurFinal)  // Comment
+    ELSE IF StrLComp (CurStart, '<!DOCTYPE', 9) = 0 THEN AnalyzeDtdc                          // DTDc
+    ELSE IF StrLComp (CurStart, CDStart, Length (CDStart)) = 0 THEN AnalyzeCdata              // CDATA Section
+    ELSE IF StrLComp (CurStart, '<',         1) = 0 THEN AnalyzeTag                           // Start-Tag, End-Tag, Empty-Element-Tag
+    ELSE AnalyzeText (IsDone);                                                                // Text Content
+  UNTIL IsDone;
+  Result := TRUE;
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeProlog;
+          // Analyze XML Prolog or Text Declaration
+VAR
+  F : PChar;
+BEGIN
+  CurAttr.Analyze (CurStart+5, F);
+  IF EntityStack.Count = 0 THEN BEGIN
+    FXmlVersion := CurAttr.Value ('version');
+    FEncoding   := CurAttr.Value ('encoding');
+    FStandalone := CurAttr.Value ('standalone') = 'yes';
+    END;
+  CurFinal := StrPos (F, '?>');
+  IF CurFinal <> NIL
+    THEN INC (CurFinal)
+    ELSE CurFinal := StrEnd (CurStart)-1;
+  FCurEncoding := AnsiUpperCase (CurAttr.Value ('encoding'));
+  IF FCurEncoding = '' THEN
+    FCurEncoding := 'UTF-8';   // Default XML Encoding is UTF-8
+  CurPartType  := ptXmlProlog;
+  CurName      := '';
+  CurContent   := '';
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeComment (Start : PChar; VAR Final : PChar);
+          // Analyze Comments
+BEGIN
+  Final := StrPos (Start+4, '-->');
+  IF Final = NIL
+    THEN Final := StrEnd (Start)-1
+    ELSE INC (Final, 2);
+  CurPartType := ptComment;
+END;
+
+
+PROCEDURE TXmlParser.AnalyzePI (Start : PChar; VAR Final : PChar);
+          // Analyze Processing Instructions (PI)
+          // This is also called for Character
+VAR
+  F : PChar;
+BEGIN
+  CurPartType := ptPI;
+  Final := StrPos (Start+2, '?>');
+  IF Final = NIL
+    THEN Final := StrEnd (Start)-1
+    ELSE INC (Final);
+  ExtractName (Start+2, CWhitespace + ['?', '>'], F);
+  SetStringSF (CurName, Start+2, F);
+  SetStringSF (CurContent, F+1, Final-2);
+  CurAttr.Analyze (F+1, F);
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeDtdc;
+          (* Analyze Document Type Declaration
+                 doctypedecl  ::= '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>'
+                 markupdecl   ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment
+                 PEReference  ::= '%' Name ';'
+
+                 elementdecl  ::= '<!ELEMENT' S Name S contentspec S?                    '>'
+                 AttlistDecl  ::= '<!ATTLIST' S Name AttDef* S?                          '>'
+                 EntityDecl   ::= '<!ENTITY' S Name S EntityDef S?                       '>' |
+                                  '<!ENTITY' S '%' S Name S PEDef S?                     '>'
+                 NotationDecl ::= '<!NOTATION' S Name S (ExternalID |  PublicID) S?      '>'
+                 PI           ::=  '<?' PITarget (S (Char* - (Char* '?>' Char* )))?     '?>'
+                 Comment      ::= '<!--' ((Char - '-') | ('-' (Char - '-')))*          '-->'  *)
+TYPE
+  TPhase = (phName, phDtd, phInternal, phFinishing);
+VAR
+  Phase       : TPhase;
+  F           : PChar;
+  ExternalID  : TExternalID;
+  ExternalDTD : TXmlParser;
+  DER         : TDtdElementRec;
+BEGIN
+  DER.Start := CurStart;
+  EntityStack.Clear;    // Clear stack for Parameter Entities
+  CurPartType := ptDtdc;
+
+  // --- Don't read DTDc twice
+  IF FDtdcFinal <> NIL THEN BEGIN
+    CurFinal := FDtdcFinal;
+    EXIT;
+    END;
+
+  // --- Scan DTDc
+  CurFinal := CurStart + 9;    // First char after '<!DOCTYPE'
+  Phase    := phName;
+  REPEAT
+    CASE CurFinal^ OF
+      '%' : BEGIN
+              PushPE (CurFinal);
+              CONTINUE;
+            END;
+      #0  : IF EntityStack.Count = 0 THEN
+              BREAK
+            ELSE BEGIN
+              CurFinal := EntityStack.Pop;
+              CONTINUE;
+              END;
+      '[' : BEGIN
+              Phase := phInternal;
+              AnalyzeDtdElements (CurFinal+1, CurFinal);
+              CONTINUE;
+            END;
+      ']' : Phase := phFinishing;
+      '>' : BREAK;
+      ELSE  IF NOT (CurFinal^ IN CWhitespace) THEN BEGIN
+              CASE Phase OF
+                phName : IF (CurFinal^ IN CNameStart)  THEN BEGIN
+                           ExtractName (CurFinal, CWhitespace + ['[', '>'], F);
+                           SetStringSF (FRootName, CurFinal, F);
+                           CurFinal := F;
+                           Phase := phDtd;
+                           END;
+                phDtd  : IF (StrLComp (CurFinal, 'SYSTEM', 6) = 0) OR
+                            (StrLComp (CurFinal, 'PUBLIC', 6) = 0) THEN BEGIN
+                           ExternalID  := TExternalID.Create (CurFinal);
+                           ExternalDTD := LoadExternalEntity (ExternalId.SystemId, ExternalID.PublicId, '');
+                           F := StrPos (ExternalDtd.DocBuffer, '<!');
+                           IF F <> NIL THEN
+                             AnalyzeDtdElements (F, F);
+                           ExternalDTD.Free;
+                           CurFinal := ExternalID.Final;
+                           ExternalID.Free;
+                           END;
+                ELSE     BEGIN
+                           DER.ElementType := deError;
+                           DER.Pos         := CurFinal;
+                           DER.Final       := CurFinal;
+                           DtdElementFound (DER);
+                         END;
+                END;
+
+              END;
+      END;
+    INC (CurFinal);
+  UNTIL FALSE;
+
+  CurPartType := ptDtdc;
+  CurName     := '';
+  CurContent  := '';
+
+  // It is an error in the document if "EntityStack" is not empty now
+  IF EntityStack.Count > 0 THEN BEGIN
+    DER.ElementType := deError;
+    DER.Final       := CurFinal;
+    DER.Pos         := CurFinal;
+    DtdElementFound (DER);
+    END;
+
+  EntityStack.Clear;    // Clear stack for General Entities
+  FDtdcFinal := CurFinal;
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeDtdElements (Start : PChar; VAR Final : PChar);
+          // Analyze the "Elements" of a DTD contained in the external or
+          // internal DTD subset.
+VAR
+  DER : TDtdElementRec;
+BEGIN
+  Final := Start;
+  REPEAT
+    CASE Final^ OF
+      '%' : BEGIN
+              PushPE (Final);
+              CONTINUE;
+            END;
+      #0  : IF EntityStack.Count = 0 THEN
+              BREAK
+            ELSE BEGIN
+              CurFinal := EntityStack.Pop;
+              CONTINUE;
+              END;
+      ']',
+      '>' : BREAK;
+      '<' : IF      StrLComp (Final, '<!ELEMENT',   9) = 0 THEN AnalyzeElementDecl  (Final, Final)
+            ELSE IF StrLComp (Final, '<!ATTLIST',   9) = 0 THEN AnalyzeAttListDecl  (Final, Final)
+            ELSE IF StrLComp (Final, '<!ENTITY',    8) = 0 THEN AnalyzeEntityDecl   (Final, Final)
+            ELSE IF StrLComp (Final, '<!NOTATION', 10) = 0 THEN AnalyzeNotationDecl (Final, Final)
+            ELSE IF StrLComp (Final, '<?',          2) = 0 THEN BEGIN   // PI in DTD
+              DER.ElementType := dePI;
+              DER.Start       := Final;
+              AnalyzePI (Final, Final);
+              DER.Target      := PChar (CurName);
+              DER.Content     := PChar (CurContent);
+              DER.AttrList    := CurAttr;
+              DER.Final       := Final;
+              DtdElementFound (DER);
+              END
+            ELSE IF StrLComp (Final, '<!--', 4) = 0 THEN BEGIN   // Comment in DTD
+              DER.ElementType := deComment;
+              DER.Start       := Final;
+              AnalyzeComment  (Final, Final);
+              DER.Final       := Final;
+              DtdElementFound (DER);
+              END
+            ELSE BEGIN
+              DER.ElementType := deError;
+              DER.Start       := Final;
+              DER.Pos         := Final;
+              DER.Final       := Final;
+              DtdElementFound (DER);
+              END;
+
+      END;
+    INC (Final);
+  UNTIL FALSE;
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeTag;
+          // Analyze Tags
+VAR
+  S, F    : PChar;
+  Attr    : TAttr;
+  ElemDef : TElemDef;
+  AttrDef : TAttrDef;
+  I       : INTEGER;
+BEGIN
+  CurPartType := ptStartTag;
+  S := CurStart+1;
+  IF S^ = '/' THEN BEGIN
+    CurPartType := ptEndTag;
+    INC (S);
+    END;
+  ExtractName (S, CWhitespace + ['/'], F);
+  SetStringSF (CurName, S, F);
+  CurAttr.Analyze (F+1, CurFinal);
+  IF CurFinal^ = '/' THEN BEGIN
+    CurPartType := ptEmptyTag;
+    END;
+  CurFinal := StrScanE (CurFinal, '>');
+
+  // --- Set Default Attribute values for nonexistent attributes
+  IF (CurPartType = ptStartTag) OR (CurPartType = ptEmptyTag) THEN BEGIN
+    ElemDef := Elements.Node (CurName);
+    IF ElemDef <> NIL THEN BEGIN
+      FOR I := 0 TO ElemDef.Count-1 DO BEGIN
+        AttrDef := TAttrDef (ElemDef [I]);
+        Attr := TAttr (CurAttr.Node (AttrDef.Name));
+        IF (Attr = NIL) AND (AttrDef.Value <> '') THEN BEGIN
+          Attr           := TAttr.Create (AttrDef.Name, AttrDef.Value);
+          Attr.ValueType := vtDefault;
+          CurAttr.Add (Attr);
+          END;
+        IF Attr <> NIL THEN BEGIN
+          CASE AttrDef.DefaultType OF
+            adDefault  : ;
+            adRequired : ; // -!- It is an error in the document if "Attr.Value" is an empty string
+            adImplied  : Attr.ValueType := vtImplied;
+            adFixed    : BEGIN
+                           Attr.ValueType := vtFixed;
+                           Attr.Value     := AttrDef.Value;
+                         END;
+            END;
+          Attr.AttrType := AttrDef.AttrType;
+          END;
+        END;
+      END;
+
+    // --- Normalize Attribute Values. XmlSpec:
+           // - a character reference is processed by appending the referenced character to the attribute value
+           // - an entity reference is processed by recursively processing the replacement text of the entity
+           // - a whitespace character (#x20, #xD, #xA, #x9) is processed by appending #x20 to the normalized value,
+           //   except that only a single #x20 is appended for a "#xD#xA" sequence that is part of an external
+           //   parsed entity or the literal entity value of an internal parsed entity
+           // - other characters are processed by appending them to the normalized value
+           // If the declared value is not CDATA, then the XML processor must further process the
+           // normalized attribute value by discarding any leading and trailing space (#x20) characters,
+           // and by replacing sequences of space (#x20) characters by a single space (#x20) character.
+           // All attributes for which no declaration has been read should be treated by a
+           // non-validating parser as if declared CDATA.
+           // !!! The XML 1.0 SE specification is somewhat different here
+           //     This code does not conform exactly to this specification
+    FOR I := 0 TO CurAttr.Count-1 DO
+      WITH TAttr (CurAttr [I]) DO BEGIN
+        ReplaceGeneralEntities   (Value);
+        ReplaceCharacterEntities (Value);
+        IF (AttrType <> atCData) AND (AttrType <> atUnknown)
+          THEN Value := TranslateEncoding (TrimWs (ConvertWs (Value, TRUE)))
+          ELSE Value := TranslateEncoding (ConvertWs (Value, FALSE));
+        END;
+    END;
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeCData;
+          // Analyze CDATA Sections
+BEGIN
+  CurPartType := ptCData;
+  CurFinal := StrPos (CurStart, CDEnd);
+  IF CurFinal = NIL THEN BEGIN
+    CurFinal   := StrEnd (CurStart)-1;
+    CurContent := TranslateEncoding (StrPas (CurStart+Length (CDStart)));
+    END
+  ELSE BEGIN
+    SetStringSF (CurContent, CurStart+Length (CDStart), CurFinal-1);
+    INC (CurFinal, Length (CDEnd)-1);
+    CurContent := TranslateEncoding (CurContent);
+    END;
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeText (VAR IsDone : BOOLEAN);
+          (* Analyzes Text Content between Tags. CurFinal will point to the last content character.
+             Content ends at a '<' character or at the end of the document.
+             Entity References and Character Entity references are resolved.
+             If PackSpaces is TRUE, contiguous Whitespace Characters will be compressed to
+             one Space #x20 character, Whitespace at the beginning and end of content will
+             be trimmed off and content which is or becomes empty is not returned to
+             the application (in this case, "IsDone" is set to FALSE which causes the
+             Scan method to proceed directly to the next part. *)
+
+  PROCEDURE ProcessEntity;
+            (* Is called if there is an ampsersand '&' character found in the document.
+               IN  "CurFinal" points to the ampersand
+               OUT "CurFinal" points to the first character after the semi-colon ';' *)
+  VAR
+    P              : PChar;
+    Name           : STRING;
+    EntityDef      : TEntityDef;
+    ExternalEntity : TXmlParser;
+  BEGIN
+    P := StrScan (CurFinal , ';');
+    IF P <> NIL THEN BEGIN
+      SetStringSF (Name, CurFinal+1, P-1);
+
+      // Is it a Character Entity?
+      IF (CurFinal+1)^ = '#' THEN BEGIN
+        IF UpCase ((CurFinal+2)^) = 'X'       // !!! Can't use "CHR" for Unicode characters > 255:
+          THEN CurContent := CurContent + CHR (StrToIntDef ('$'+Copy (Name, 3, MaxInt), 32))
+          ELSE CurContent := CurContent + CHR (StrToIntDef (Copy (Name, 2, MaxInt), 32));
+        CurFinal := P+1;
+        EXIT;
+        END
+
+      // Is it a Predefined Entity?
+      ELSE IF Name = 'lt'   THEN BEGIN CurContent := CurContent + '<';  CurFinal := P+1; EXIT; END
+      ELSE IF Name = 'gt'   THEN BEGIN CurContent := CurContent + '>';  CurFinal := P+1; EXIT; END
+      ELSE IF Name = 'amp'  THEN BEGIN CurContent := CurContent + '&';  CurFinal := P+1; EXIT; END
+      ELSE IF Name = 'apos' THEN BEGIN CurContent := CurContent + ''''; CurFinal := P+1; EXIT; END
+      ELSE IF Name = 'quot' THEN BEGIN CurContent := CurContent + '"';  CurFinal := P+1; EXIT; END;
+
+      // Replace with Entity from DTD
+      EntityDef := TEntityDef (Entities.Node (Name));
+      IF EntityDef <> NIL THEN BEGIN
+        IF EntityDef.Value <> '' THEN BEGIN
+          EntityStack.Push (P+1);
+          CurFinal := PChar (EntityDef.Value);
+          END
+        ELSE BEGIN
+          ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);
+          EntityStack.Push (ExternalEntity, P+1);
+          CurFinal := ExternalEntity.DocBuffer;
+          END;
+        END
+      ELSE BEGIN
+        CurContent := CurContent + Name;
+        CurFinal   := P+1;
+        END;
+      END
+    ELSE BEGIN
+      INC (CurFinal);
+      END;
+  END;
+
+VAR
+  C  : INTEGER;
+BEGIN
+  CurFinal    := CurStart;
+  CurPartType := ptContent;
+  CurContent  := '';
+  C           := 0;
+  REPEAT
+    CASE CurFinal^ OF
+      '&' : BEGIN
+              CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));
+              C := 0;
+              ProcessEntity;
+              CONTINUE;
+            END;
+      #0  : BEGIN
+              IF EntityStack.Count = 0 THEN
+                BREAK
+              ELSE BEGIN
+                CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));
+                C := 0;
+                CurFinal := EntityStack.Pop;
+                CONTINUE;
+                END;
+            END;
+      '<' : BREAK;
+      ELSE INC (C);
+      END;
+    INC (CurFinal);
+  UNTIL FALSE;
+  CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));
+  DEC (CurFinal);
+
+  IF FNormalize THEN BEGIN
+    CurContent := ConvertWs (TrimWs (CurContent), TRUE);
+    IsDone     := CurContent <> '';    // IsDone will only get FALSE if PackSpaces is TRUE
+    END;
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeElementDecl  (Start : PChar; VAR Final : PChar);
+          (* Parse <!ELEMENT declaration starting at "Start"
+             Final must point to the terminating '>' character
+             XmlSpec 3.2:
+                 elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>'
+                 contentspec ::= 'EMPTY' | 'ANY' | Mixed | children
+                 Mixed       ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*'   |
+                                 '(' S? '#PCDATA' S? ')'
+                 children    ::= (choice | seq) ('?' | '*' | '+')?
+                 choice      ::= '(' S? cp ( S? '|' S? cp )* S? ')'
+                 cp          ::= (Name | choice | seq) ('?' | '*' | '+')?
+                 seq         ::= '(' S? cp ( S? ',' S? cp )* S? ')'
+
+             More simply:
+                 contentspec ::= EMPTY
+                                 ANY
+                                 '(#PCDATA)'
+                                 '(#PCDATA | A | B)*'
+                                 '(A, B, C)'
+                                 '(A | B | C)'
+                                 '(A?, B*, C+),
+                                 '(A, (B | C | D)* )'                       *)
+VAR
+  Element : TElemDef;
+  Elem2   : TElemDef;
+  F       : PChar;
+  DER     : TDtdElementRec;
+BEGIN
+  Element   := TElemDef.Create;
+  Final     := Start + 9;
+  DER.Start := Start;
+  REPEAT
+    IF Final^ = '>' THEN BREAK;
+    IF (Final^ IN CNameStart) AND (Element.Name = '') THEN BEGIN
+      ExtractName (Final, CWhitespace, F);
+      SetStringSF (Element.Name, Final, F);
+      Final := F;
+      F := StrScan (Final+1, '>');
+      IF F = NIL THEN BEGIN
+        Element.Definition := STRING (Final);
+        Final := StrEnd (Final);
+        BREAK;
+        END
+      ELSE BEGIN
+        SetStringSF (Element.Definition, Final+1, F-1);
+        Final := F;
+        BREAK;
+        END;
+      END;
+    INC (Final);
+  UNTIL FALSE;
+  Element.Definition := DelChars (Element.Definition, CWhitespace);
+  ReplaceParameterEntities (Element.Definition);
+  IF      Element.Definition = 'EMPTY' THEN Element.ElemType := etEmpty
+  ELSE IF Element.Definition = 'ANY'   THEN Element.ElemType := etAny
+  ELSE IF Copy (Element.Definition, 1, 8) = '(#PCDATA' THEN Element.ElemType := etMixed
+  ELSE IF Copy (Element.Definition, 1, 1) = '('        THEN Element.ElemType := etChildren
+  ELSE Element.ElemType := etAny;
+
+  Elem2 := Elements.Node (Element.Name);
+  IF Elem2 <> NIL THEN
+    Elements.Delete (Elements.IndexOf (Elem2));
+  Elements.Add (Element);
+  Final := StrScanE (Final, '>');
+  DER.ElementType := deElement;
+  DER.ElemDef  := Element;
+  DER.Final    := Final;
+  DtdElementFound (DER);
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeAttListDecl  (Start : PChar; VAR Final : PChar);
+          (* Parse <!ATTLIST declaration starting at "Start"
+             Final must point to the terminating '>' character
+             XmlSpec 3.3:
+                 AttlistDecl    ::= '<!ATTLIST' S Name AttDef* S? '>'
+                 AttDef         ::= S Name S AttType S DefaultDecl
+                 AttType        ::= StringType | TokenizedType | EnumeratedType
+                 StringType     ::= 'CDATA'
+                 TokenizedType  ::= 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'
+                 EnumeratedType ::= NotationType | Enumeration
+                 NotationType   ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'
+                 Enumeration    ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'
+                 DefaultDecl    ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)
+                 AttValue       ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"
+            Examples:
+                 <!ATTLIST address
+                           A1 CDATA "Default"
+                           A2 ID    #REQUIRED
+                           A3 IDREF #IMPLIED
+                           A4 IDREFS #IMPLIED
+                           A5 ENTITY #FIXED "&at;&#252;"
+                           A6 ENTITIES #REQUIRED
+                           A7 NOTATION (WMF | DXF) "WMF"
+                           A8 (A | B | C) #REQUIRED>                *)
+TYPE
+  TPhase = (phElementName, phName, phType, phNotationContent, phDefault);
+VAR
+  Phase       : TPhase;
+  F           : PChar;
+  ElementName : STRING;
+  ElemDef     : TElemDef;
+  AttrDef     : TAttrDef;
+  AttrDef2    : TAttrDef;
+  Strg        : STRING;
+  DER         : TDtdElementRec;
+BEGIN
+  Final     := Start + 9;   // The character after <!ATTLIST
+  Phase     := phElementName;
+  DER.Start := Start;
+  AttrDef   := NIL;
+  ElemDef   := NIL;
+  REPEAT
+    IF NOT (Final^ IN CWhitespace) THEN
+      CASE Final^ OF
+        '%' : BEGIN
+                PushPE (Final);
+                CONTINUE;
+              END;
+        #0  : IF EntityStack.Count = 0 THEN
+                BREAK
+              ELSE BEGIN
+                Final := EntityStack.Pop;
+                CONTINUE;
+                END;
+        '>' : BREAK;
+        ELSE  CASE Phase OF
+                phElementName     : BEGIN
+                                      ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);
+                                      SetStringSF (ElementName, Final, F);
+                                      Final := F;
+                                      ElemDef := Elements.Node (ElementName);
+                                      IF ElemDef = NIL THEN BEGIN
+                                        ElemDef := TElemDef.Create;
+                                        ElemDef.Name       := ElementName;
+                                        ElemDef.Definition := 'ANY';
+                                        ElemDef.ElemType   := etAny;
+                                        Elements.Add (ElemDef);
+                                        END;
+                                      Phase := phName;
+                                    END;
+                phName            : BEGIN
+                                      AttrDef := TAttrDef.Create;
+                                      ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);
+                                      SetStringSF (AttrDef.Name, Final, F);
+                                      Final := F;
+                                      AttrDef2 := TAttrDef (ElemDef.Node (AttrDef.Name));
+                                      IF AttrDef2 <> NIL THEN
+                                        ElemDef.Delete (ElemDef.IndexOf (AttrDef2));
+                                      ElemDef.Add (AttrDef);
+                                      Phase := phType;
+                                    END;
+                phType            : BEGIN
+                                      IF Final^ = '(' THEN BEGIN
+                                        F := StrScan (Final+1, ')');
+                                        IF F <> NIL
+                                          THEN SetStringSF (AttrDef.TypeDef, Final+1, F-1)
+                                          ELSE AttrDef.TypeDef := STRING (Final+1);
+                                        AttrDef.TypeDef := DelChars (AttrDef.TypeDef, CWhitespace);
+                                        AttrDef.AttrType := atEnumeration;
+                                        ReplaceParameterEntities (AttrDef.TypeDef);
+                                        ReplaceCharacterEntities (AttrDef.TypeDef);
+                                        Phase := phDefault;
+                                        END
+                                      ELSE IF StrLComp (Final, 'NOTATION', 8) = 0 THEN BEGIN
+                                        INC (Final, 8);
+                                        AttrDef.AttrType := atNotation;
+                                        Phase := phNotationContent;
+                                        END
+                                      ELSE BEGIN
+                                        ExtractName (Final, CWhitespace+CQuoteChar+['#'], F);
+                                        SetStringSF (AttrDef.TypeDef, Final, F);
+                                        IF      AttrDef.TypeDef = 'CDATA'    THEN AttrDef.AttrType := atCData
+                                        ELSE IF AttrDef.TypeDef = 'ID'       THEN AttrDef.AttrType := atId
+                                        ELSE IF AttrDef.TypeDef = 'IDREF'    THEN AttrDef.AttrType := atIdRef
+                                        ELSE IF AttrDef.TypeDef = 'IDREFS'   THEN AttrDef.AttrType := atIdRefs
+                                        ELSE IF AttrDef.TypeDef = 'ENTITY'   THEN AttrDef.AttrType := atEntity
+                                        ELSE IF AttrDef.TypeDef = 'ENTITIES' THEN AttrDef.AttrType := atEntities
+                                        ELSE IF AttrDef.TypeDef = 'NMTOKEN'  THEN AttrDef.AttrType := atNmToken
+                                        ELSE IF AttrDef.TypeDef = 'NMTOKENS' THEN AttrDef.AttrType := atNmTokens;
+                                        Phase := phDefault;
+                                        END
+                                    END;
+                phNotationContent : BEGIN
+                                      F := StrScan (Final, ')');
+                                      IF F <> NIL THEN
+                                        SetStringSF (AttrDef.Notations, Final+1, F-1)
+                                      ELSE BEGIN
+                                        AttrDef.Notations := STRING (Final+1);
+                                        Final := StrEnd (Final);
+                                        END;
+                                      ReplaceParameterEntities (AttrDef.Notations);
+                                      AttrDef.Notations := DelChars (AttrDef.Notations, CWhitespace);
+                                      Phase := phDefault;
+                                    END;
+                phDefault :         BEGIN
+                                      IF Final^ = '#' THEN BEGIN
+                                        ExtractName (Final, CWhiteSpace + CQuoteChar, F);
+                                        SetStringSF (Strg, Final, F);
+                                        Final := F;
+                                        ReplaceParameterEntities (Strg);
+                                        IF      Strg = '#REQUIRED' THEN BEGIN AttrDef.DefaultType := adRequired; Phase := phName; END
+                                        ELSE IF Strg = '#IMPLIED'  THEN BEGIN AttrDef.DefaultType := adImplied;  Phase := phName; END
+                                        ELSE IF Strg = '#FIXED'    THEN       AttrDef.DefaultType := adFixed;
+                                        END
+                                      ELSE IF (Final^ IN CQuoteChar) THEN BEGIN
+                                        ExtractQuote (Final, AttrDef.Value, Final);
+                                        ReplaceParameterEntities (AttrDef.Value);
+                                        ReplaceCharacterEntities (AttrDef.Value);
+                                        Phase := phName;
+                                        END;
+                                      IF Phase = phName THEN BEGIN
+                                        AttrDef := NIL;
+                                        END;
+                                    END;
+
+                END;
+        END;
+    INC (Final);
+  UNTIL FALSE;
+
+  Final := StrScan (Final, '>');
+
+  DER.ElementType := deAttList;
+  DER.ElemDef  := ElemDef;
+  DER.Final    := Final;
+  DtdElementFound (DER);
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeEntityDecl   (Start : PChar; VAR Final : PChar);
+          (* Parse <!ENTITY declaration starting at "Start"
+             Final must point to the terminating '>' character
+             XmlSpec 4.2:
+                 EntityDecl  ::= '<!ENTITY' S Name S EntityDef S? '>'   |
+                                 '<!ENTITY' S '%' S Name S PEDef S? '>'
+                 EntityDef   ::= EntityValue | (ExternalID NDataDecl?)
+                 PEDef       ::= EntityValue | ExternalID
+                 NDataDecl   ::= S 'NDATA' S Name
+                 EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"'   |
+                                 "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'"
+                 PEReference ::= '%' Name ';'
+
+             Examples
+                 <!ENTITY test1 "Stefan Heymann">                   <!-- Internal, general, parsed              -->
+                 <!ENTITY test2 SYSTEM "ent2.xml">                  <!-- External, general, parsed              -->
+                 <!ENTITY test2 SYSTEM "ent3.gif" NDATA gif>        <!-- External, general, unparsed            -->
+                 <!ENTITY % test3 "<!ELEMENT q ANY>">               <!-- Internal, parameter                    -->
+                 <!ENTITY % test6 SYSTEM "ent6.xml">                <!-- External, parameter                    -->
+                 <!ENTITY test4 "&test1; ist lieb">                 <!-- IGP, Replacement text <> literal value -->
+                 <!ENTITY test5 "<p>Dies ist ein Test-Absatz</p>">  <!-- IGP, See XmlSpec 2.4                   -->
+          *)
+TYPE
+  TPhase = (phName, phContent, phNData, phNotationName, phFinalGT);
+VAR
+  Phase         : TPhase;
+  IsParamEntity : BOOLEAN;
+  F             : PChar;
+  ExternalID    : TExternalID;
+  EntityDef     : TEntityDef;
+  EntityDef2    : TEntityDef;
+  DER           : TDtdElementRec;
+BEGIN
+  Final         := Start + 8;   // First char after <!ENTITY
+  DER.Start     := Start;
+  Phase         := phName;
+  IsParamEntity := FALSE;
+  EntityDef     := TEntityDef.Create;
+  REPEAT
+    IF NOT (Final^ IN CWhitespace) THEN
+      CASE Final^ OF
+        '%' : IsParamEntity := TRUE;
+        '>' : BREAK;
+        ELSE  CASE Phase OF
+                phName         : IF Final^ IN CNameStart THEN BEGIN
+                                   ExtractName (Final, CWhitespace + CQuoteChar, F);
+                                   SetStringSF (EntityDef.Name, Final, F);
+                                   Final := F;
+                                   Phase := phContent;
+                                   END;
+                phContent      : IF Final^ IN CQuoteChar THEN BEGIN
+                                   ExtractQuote (Final, EntityDef.Value, Final);
+                                   Phase := phFinalGT;
+                                   END
+                                 ELSE IF (StrLComp (Final, 'SYSTEM', 6) = 0) OR
+                                         (StrLComp (Final, 'PUBLIC', 6) = 0) THEN BEGIN
+                                   ExternalID := TExternalID.Create (Final);
+                                   EntityDef.SystemId := ExternalID.SystemId;
+                                   EntityDef.PublicId := ExternalID.PublicId;
+                                   Final      := ExternalID.Final;
+                                   Phase      := phNData;
+                                   ExternalID.Free;
+                                   END;
+                phNData        : IF StrLComp (Final, 'NDATA', 5) = 0 THEN BEGIN
+                                   INC (Final, 4);
+                                   Phase := phNotationName;
+                                   END;
+                phNotationName : IF Final^ IN CNameStart THEN BEGIN
+                                   ExtractName (Final, CWhitespace + ['>'], F);
+                                   SetStringSF (EntityDef.NotationName, Final, F);
+                                   Final := F;
+                                   Phase := phFinalGT;
+                                   END;
+                phFinalGT      : ; // -!- There is an error in the document if this branch is called
+                END;
+        END;
+    INC (Final);
+  UNTIL FALSE;
+  IF IsParamEntity THEN BEGIN
+    EntityDef2 := TEntityDef (ParEntities.Node (EntityDef.Name));
+    IF EntityDef2 <> NIL THEN
+      ParEntities.Delete (ParEntities.IndexOf (EntityDef2));
+    ParEntities.Add (EntityDef);
+    ReplaceCharacterEntities (EntityDef.Value);
+    END
+  ELSE BEGIN
+    EntityDef2 := TEntityDef (Entities.Node (EntityDef.Name));
+    IF EntityDef2 <> NIL THEN
+      Entities.Delete (Entities.IndexOf (EntityDef2));
+    Entities.Add (EntityDef);
+    ReplaceParameterEntities (EntityDef.Value);  //  Create replacement texts (see XmlSpec 4.5)
+    ReplaceCharacterEntities (EntityDef.Value);
+    END;
+  Final := StrScanE (Final, '>');
+
+  DER.ElementType := deEntity;
+  DER.EntityDef   := EntityDef;
+  DER.Final       := Final;
+  DtdElementFound (DER);
+END;
+
+
+PROCEDURE TXmlParser.AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);
+          // Parse <!NOTATION declaration starting at "Start"
+          // Final must point to the terminating '>' character
+          // XmlSpec 4.7: NotationDecl ::=  '<!NOTATION' S Name S (ExternalID |  PublicID) S? '>'
+TYPE
+  TPhase = (phName, phExtId, phEnd);
+VAR
+  ExternalID  : TExternalID;
+  Phase       : TPhase;
+  F           : PChar;
+  NotationDef : TNotationDef;
+  DER         : TDtdElementRec;
+BEGIN
+  Final       := Start + 10;   // Character after <!NOTATION
+  DER.Start   := Start;
+  Phase       := phName;
+  NotationDef := TNotationDef.Create;
+  REPEAT
+    IF NOT (Final^ IN CWhitespace) THEN
+      CASE Final^ OF
+        '>',
+        #0   : BREAK;
+        ELSE   CASE Phase OF
+                 phName  : BEGIN
+                             ExtractName (Final, CWhitespace + ['>'], F);
+                             SetStringSF (NotationDef.Name, Final, F);
+                             Final := F;
+                             Phase := phExtId;
+                           END;
+                 phExtId : BEGIN
+                             ExternalID := TExternalID.Create (Final);
+                             NotationDef.Value    := ExternalID.SystemId;
+                             NotationDef.PublicId := ExternalID.PublicId;
+                             Final := ExternalId.Final;
+                             ExternalId.Free;
+                             Phase := phEnd;
+                           END;
+                 phEnd   : ;   // -!- There is an error in the document if this branch is called
+                 END;
+        END;
+    INC (Final);
+  UNTIL FALSE;
+  Notations.Add (NotationDef);
+  Final := StrScanE (Final, '>');
+
+  DER.ElementType := deNotation;
+  DER.NotationDef := NotationDef;
+  DER.Final       := Final;
+  DtdElementFound (DER);
+END;
+
+
+PROCEDURE TXmlParser.PushPE (VAR Start : PChar);
+          (* If there is a parameter entity reference found in the data stream,
+             the current position will be pushed to the entity stack.
+             Start:  IN  Pointer to the '%' character starting the PE reference
+                     OUT Pointer to first character of PE replacement text *)
+VAR
+  P         : PChar;
+  EntityDef : TEntityDef;
+BEGIN
+  P := StrScan (Start, ';');
+  IF P <> NIL THEN BEGIN
+    EntityDef := TEntityDef (ParEntities.Node (StrSFPas (Start+1, P-1)));
+    IF EntityDef <> NIL THEN BEGIN
+      EntityStack.Push (P+1);
+      Start := PChar (EntityDef.Value);
+      END
+    ELSE
+      Start := P+1;
+    END;
+END;
+
+
+PROCEDURE TXmlParser.ReplaceCharacterEntities (VAR Str : STRING);
+          // Replaces all Character Entity References in the String
+VAR
+  Start  : INTEGER;
+  PAmp   : PChar;
+  PSemi  : PChar;
+  PosAmp : INTEGER;
+  Len    : INTEGER;    // Length of Entity Reference
+BEGIN
+  IF Str = '' THEN EXIT;
+  Start := 1;
+  REPEAT
+    PAmp := StrPos (PChar (Str) + Start-1, '&#');
+    IF PAmp = NIL THEN BREAK;
+    PSemi := StrScan (PAmp+2, ';');
+    IF PSemi = NIL THEN BREAK;
+    PosAmp := PAmp - PChar (Str) + 1;
+    Len    := PSemi-PAmp+1;
+    IF CompareText (Str [PosAmp+2], 'x') = 0          // !!! Can't use "CHR" for Unicode characters > 255
+      THEN Str [PosAmp] := CHR (StrToIntDef ('$'+Copy (Str, PosAmp+3, Len-4), 0))
+      ELSE Str [PosAmp] := CHR (StrToIntDef (Copy (Str, PosAmp+2, Len-3), 32));
+    Delete (Str, PosAmp+1, Len-1);  
+    Start := PosAmp + 1;
+  UNTIL FALSE;
+END;
+
+
+PROCEDURE TXmlParser.ReplaceParameterEntities (VAR Str : STRING);
+          // Recursively replaces all Parameter Entity References in the String
+  PROCEDURE ReplaceEntities (VAR Str : STRING);
+  VAR
+    Start   : INTEGER;
+    PAmp    : PChar;
+    PSemi   : PChar;
+    PosAmp  : INTEGER;
+    Len     : INTEGER;
+    Entity  : TEntityDef;
+    Repl    : STRING;        // Replacement
+  BEGIN
+    IF Str = '' THEN EXIT;
+    Start := 1;
+    REPEAT
+      PAmp := StrPos (PChar (Str)+Start-1, '%');
+      IF PAmp = NIL THEN BREAK;
+      PSemi := StrScan (PAmp+2, ';');
+      IF PSemi = NIL THEN BREAK;
+      PosAmp := PAmp - PChar (Str) + 1;
+      Len    := PSemi-PAmp+1;
+      Entity := TEntityDef (ParEntities.Node (Copy (Str, PosAmp+1, Len-2)));
+      IF Entity <> NIL THEN BEGIN
+        Repl := Entity.Value;
+        ReplaceEntities (Repl);    // Recursion
+        END
+      ELSE
+        Repl := Copy (Str, PosAmp, Len);
+      Delete (Str, PosAmp, Len);  
+      Insert (Repl, Str, PosAmp);
+      Start := PosAmp + Length (Repl);
+    UNTIL FALSE;
+  END;
+BEGIN
+  ReplaceEntities (Str);
+END;
+
+
+PROCEDURE TXmlParser.ReplaceGeneralEntities (VAR Str : STRING);
+          // Recursively replaces General Entity References in the String
+  PROCEDURE ReplaceEntities (VAR Str : STRING);
+  VAR
+    Start          : INTEGER;
+    PAmp           : PChar;
+    PSemi          : PChar;
+    PosAmp         : INTEGER;
+    Len            : INTEGER;
+    EntityDef      : TEntityDef;
+    EntName        : STRING;
+    Repl           : STRING;        // Replacement
+    ExternalEntity : TXmlParser;
+  BEGIN
+    IF Str = '' THEN EXIT;
+    Start := 1;
+    REPEAT
+      PAmp := StrPos (PChar (Str)+Start-1, '&');
+      IF PAmp = NIL THEN BREAK;
+      PSemi := StrScan (PAmp+2, ';');
+      IF PSemi = NIL THEN BREAK;
+      PosAmp := PAmp - PChar (Str) + 1;
+      Len    := PSemi-PAmp+1;
+      EntName := Copy (Str, PosAmp+1, Len-2);
+      IF      EntName = 'lt'   THEN Repl := '<'
+      ELSE IF EntName = 'gt'   THEN Repl := '>'
+      ELSE IF EntName = 'amp'  THEN Repl := '&'
+      ELSE IF EntName = 'apos' THEN Repl := ''''
+      ELSE IF EntName = 'quot' THEN Repl := '"'
+      ELSE BEGIN
+        EntityDef := TEntityDef (Entities.Node (EntName));
+        IF EntityDef <> NIL THEN BEGIN
+          IF EntityDef.Value <> '' THEN   // Internal Entity
+            Repl := EntityDef.Value
+          ELSE BEGIN                      // External Entity
+            ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);
+            Repl := StrPas (ExternalEntity.DocBuffer);  // !!! What if it contains a Text Declaration?
+            ExternalEntity.Free;
+            END;
+          ReplaceEntities (Repl);    // Recursion
+          END
+        ELSE
+          Repl := Copy (Str, PosAmp, Len);
+        END;
+      Delete (Str, PosAmp, Len);  
+      Insert (Repl, Str, PosAmp);
+      Start := PosAmp + Length (Repl);
+    UNTIL FALSE;
+  END;
+BEGIN
+  ReplaceEntities (Str);
+END;
+
+
+FUNCTION  TXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;
+          // This will be called whenever there is a Parsed External Entity or
+          // the DTD External Subset to be parsed.
+          // It has to create a TXmlParser instance and load the desired Entity.
+          // This instance of LoadExternalEntity assumes that "SystemId" is a valid
+          // file name (relative to the Document source) and loads this file using
+          // the LoadFromFile method.
+VAR
+  Filename : STRING;
+BEGIN
+  // --- Convert System ID to complete filename
+  Filename := StringReplace (SystemId, '/', '\', [rfReplaceAll]);
+  IF Copy (FSource, 1, 1) <> '<' THEN
+    IF (Copy (Filename, 1, 2) = '\\') OR (Copy (Filename, 2, 1) = ':') THEN
+      // Already has an absolute Path
+    ELSE BEGIN
+      Filename := ExtractFilePath (FSource) + Filename;
+      END;
+
+  // --- Load the File
+  Result := TXmlParser.Create;
+  Result.LoadFromFile (Filename);
+END;
+
+
+FUNCTION  TXmlParser.TranslateEncoding  (CONST Source : STRING) : STRING;
+          // The member variable "CurEncoding" always holds the name of the current
+          // encoding, e.g. 'UTF-8' or 'ISO-8859-1'.
+          // This virtual method "TranslateEncoding" is responsible for translating
+          // the content passed in the "Source" parameter to the Encoding which
+          // is expected by the application.
+          // This instance of "TranlateEncoding" assumes that the Application expects
+          // Windows ANSI (Win1252) strings. It is able to transform UTF-8 or ISO-8859-1
+          // encodings.
+          // If you want your application to understand or create other encodings, you
+          // override this function.
+BEGIN
+  IF CurEncoding = 'UTF-8'
+    THEN Result := Utf8ToAnsi (Source)
+    ELSE Result := Source;
+END;
+
+
+PROCEDURE TXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);
+          // This method is called for every element which is found in the DTD
+          // declaration. The variant record TDtdElementRec is passed which
+          // holds informations about the element.
+          // You can override this function to handle DTD declarations.
+          // Note that when you parse the same Document instance a second time,
+          // the DTD will not get parsed again.
+BEGIN
+END;
+
+
+FUNCTION TXmlParser.GetDocBuffer: PChar;
+         // Returns FBuffer or a pointer to a NUL char if Buffer is empty
+BEGIN
+  IF FBuffer = NIL
+    THEN Result := #0
+    ELSE Result := FBuffer;
+END;
+
+
+(*$IFNDEF HAS_CONTNRS_UNIT
+===============================================================================================
+TObjectList
+===============================================================================================
+*)
+
+DESTRUCTOR TObjectList.Destroy;
+BEGIN
+  Clear;
+  SetCapacity(0);
+  INHERITED Destroy;
+END;
+
+
+PROCEDURE TObjectList.Delete (Index : INTEGER);
+BEGIN
+  IF (Index < 0) OR (Index >= Count) THEN EXIT;
+  TObject (Items [Index]).Free;
+  INHERITED Delete (Index);
+END;
+
+
+PROCEDURE TObjectList.Clear;
+BEGIN
+  WHILE Count > 0 DO
+    Delete (Count-1);
+END;
+
+(*$ENDIF *)
+
+(*
+===============================================================================================
+TNvpNode
+--------
+Node base class for the TNvpList
+===============================================================================================
+*)
+
+CONSTRUCTOR TNvpNode.Create (TheName, TheValue : STRING);
+BEGIN
+  INHERITED Create;
+  Name  := TheName;
+  Value := TheValue;
+END;
+
+
+(*
+===============================================================================================
+TNvpList
+--------
+A generic List of Name-Value Pairs, based on the TObjectList introduced in Delphi 5
+===============================================================================================
+*)
+
+PROCEDURE TNvpList.Add (Node : TNvpNode);
+VAR
+  I : INTEGER;
+BEGIN
+  FOR I := Count-1 DOWNTO 0 DO
+    IF Node.Name > TNvpNode (Items [I]).Name THEN BEGIN
+      Insert (I+1, Node);
+      EXIT;
+      END;
+  Insert (0, Node);
+END;
+
+
+
+FUNCTION  TNvpList.Node (Name : STRING) : TNvpNode;
+          // Binary search for Node
+VAR
+  L, H : INTEGER;    // Low, High Limit
+  T, C : INTEGER;    // Test Index, Comparison result
+  Last : INTEGER;    // Last Test Index
+BEGIN
+  IF Count=0 THEN BEGIN
+    Result := NIL;
+    EXIT;
+    END;
+
+  L    := 0;
+  H    := Count;
+  Last := -1;
+  REPEAT
+    T := (L+H) DIV 2;
+    IF T=Last THEN BREAK;
+    Result := TNvpNode (Items [T]);
+    C := CompareStr (Result.Name, Name);
+    IF      C = 0 THEN EXIT
+    ELSE IF C < 0 THEN L := T
+    ELSE               H := T;
+    Last := T;
+  UNTIL FALSE;
+  Result := NIL;
+END;
+
+
+FUNCTION  TNvpList.Node (Index : INTEGER) : TNvpNode;
+BEGIN
+  IF (Index < 0) OR (Index >= Count)
+    THEN Result := NIL
+    ELSE Result := TNvpNode (Items [Index]);
+END;
+
+
+FUNCTION  TNvpList.Value (Name : STRING) : STRING;
+VAR
+  Nvp : TNvpNode;
+BEGIN
+  Nvp := TNvpNode (Node (Name));
+  IF Nvp <> NIL
+    THEN Result := Nvp.Value
+    ELSE Result := '';
+END;
+
+
+FUNCTION  TNvpList.Value (Index : INTEGER) : STRING;
+BEGIN
+  IF (Index < 0) OR (Index >= Count)
+    THEN Result := ''
+    ELSE Result := TNvpNode (Items [Index]).Value;
+END;
+
+
+FUNCTION  TNvpList.Name (Index : INTEGER) : STRING;
+BEGIN
+  IF (Index < 0) OR (Index >= Count)
+    THEN Result := ''
+    ELSE Result := TNvpNode (Items [Index]).Name;
+END;
+
+
+(*
+===============================================================================================
+TAttrList
+List of Attributes. The "Analyze" method extracts the Attributes from the given Buffer.
+Is used for extraction of Attributes in Start-Tags, Empty-Element Tags and the "pseudo"
+attributes in XML Prologs, Text Declarations and PIs.
+===============================================================================================
+*)
+
+PROCEDURE TAttrList.Analyze (Start : PChar; VAR Final : PChar);
+          // Analyze the Buffer for Attribute=Name pairs.
+          // Terminates when there is a character which is not IN CNameStart
+          // (e.g. '?>' or '>' or '/>')
+TYPE
+  TPhase = (phName, phEq, phValue);
+VAR
+  Phase : TPhase;
+  F     : PChar;
+  Name  : STRING;
+  Value : STRING;
+  Attr  : TAttr;
+BEGIN
+  Clear;
+  Phase := phName;
+  Final := Start;
+  REPEAT
+    IF (Final^ = #0) OR (Final^ = '>') THEN BREAK;
+    IF NOT (Final^ IN CWhitespace) THEN
+      CASE Phase OF
+        phName  : BEGIN
+                    IF NOT (Final^ IN CNameStart) THEN EXIT;
+                    ExtractName (Final, CWhitespace + ['=', '/'], F);
+                    SetStringSF (Name, Final, F);
+                    Final := F;
+                    Phase := phEq;
+                  END;
+        phEq    : BEGIN
+                    IF Final^ = '=' THEN
+                      Phase := phValue
+                  END;
+        phValue : BEGIN
+                    IF Final^ IN CQuoteChar THEN BEGIN
+                      ExtractQuote (Final, Value, F);
+                      Attr := TAttr.Create;
+                      Attr.Name      := Name;
+                      Attr.Value     := Value;
+                      Attr.ValueType := vtNormal;
+                      Add (Attr);
+                      Final := F;
+                      Phase := phName;
+                      END;
+                  END;
+        END;
+    INC (Final);
+  UNTIL FALSE;
+END;
+
+
+(*
+===============================================================================================
+TElemList
+List of TElemDef nodes.
+===============================================================================================
+*)
+
+FUNCTION  TElemList.Node (Name : STRING) : TElemDef;
+          // Binary search for the Node with the given Name
+VAR
+  L, H : INTEGER;    // Low, High Limit
+  T, C : INTEGER;    // Test Index, Comparison result
+  Last : INTEGER;    // Last Test Index
+BEGIN
+  IF Count=0 THEN BEGIN
+    Result := NIL;
+    EXIT;
+    END;
+
+  L    := 0;
+  H    := Count;
+  Last := -1;
+  REPEAT
+    T := (L+H) DIV 2;
+    IF T=Last THEN BREAK;
+    Result := TElemDef (Items [T]);
+    C := CompareStr (Result.Name, Name);
+    IF C = 0 THEN EXIT
+    ELSE IF C < 0 THEN L := T
+    ELSE               H := T;
+    Last := T;
+  UNTIL FALSE;
+  Result := NIL;
+END;
+
+
+PROCEDURE TElemList.Add (Node : TElemDef);
+VAR
+  I : INTEGER;
+BEGIN
+  FOR I := Count-1 DOWNTO 0 DO
+    IF Node.Name > TElemDef (Items [I]).Name THEN BEGIN
+      Insert (I+1, Node);
+      EXIT;
+      END;
+  Insert (0, Node);
+END;
+
+
+(*
+===============================================================================================
+TScannerXmlParser
+A TXmlParser descendant for the TCustomXmlScanner component
+===============================================================================================
+*)
+
+TYPE
+  TScannerXmlParser = CLASS (TXmlParser)
+                       Scanner : TCustomXmlScanner;
+                       CONSTRUCTOR Create (TheScanner : TCustomXmlScanner);
+                       FUNCTION  LoadExternalEntity (SystemId, PublicId,
+                                                     Notation : STRING) : TXmlParser;  OVERRIDE;
+                       FUNCTION  TranslateEncoding  (CONST Source : STRING) : STRING;  OVERRIDE;
+                       PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec);     OVERRIDE;
+                      END;
+
+CONSTRUCTOR TScannerXmlParser.Create (TheScanner : TCustomXmlScanner);
+BEGIN
+  INHERITED Create;
+  Scanner := TheScanner;
+END;
+
+
+FUNCTION  TScannerXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;
+BEGIN
+  IF Assigned (Scanner.FOnLoadExternal)
+    THEN Scanner.FOnLoadExternal (Scanner, SystemId, PublicId, Notation, Result)
+    ELSE Result :=  INHERITED LoadExternalEntity (SystemId, PublicId, Notation);
+END;
+
+
+FUNCTION  TScannerXmlParser.TranslateEncoding  (CONST Source : STRING) : STRING;
+BEGIN
+  IF Assigned (Scanner.FOnTranslateEncoding)
+    THEN Result := Scanner.FOnTranslateEncoding (Scanner, CurEncoding, Source)
+    ELSE Result := INHERITED TranslateEncoding (Source);
+END;
+
+
+PROCEDURE TScannerXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);
+BEGIN
+  WITH DtdElementRec DO
+    CASE ElementType OF
+      deElement  : Scanner.WhenElement  (ElemDef);
+      deAttList  : Scanner.WhenAttList  (ElemDef);
+      deEntity   : Scanner.WhenEntity   (EntityDef);
+      deNotation : Scanner.WhenNotation (NotationDef);
+      dePI       : Scanner.WhenPI       (STRING (Target), STRING (Content), AttrList);
+      deComment  : Scanner.WhenComment  (StrSFPas (Start, Final));
+      deError    : Scanner.WhenDtdError (Pos);
+      END;
+END;
+
+
+(*
+===============================================================================================
+TCustomXmlScanner
+===============================================================================================
+*)
+
+CONSTRUCTOR TCustomXmlScanner.Create (AOwner: TComponent);
+BEGIN
+  INHERITED;
+  FXmlParser := TScannerXmlParser.Create (Self);
+END;
+
+
+DESTRUCTOR TCustomXmlScanner.Destroy;
+BEGIN
+  FXmlParser.Free;
+  INHERITED;
+END;
+
+
+PROCEDURE TCustomXmlScanner.LoadFromFile (Filename : TFilename);
+          // Load XML Document from file
+BEGIN
+  FXmlParser.LoadFromFile (Filename);
+END;
+
+
+PROCEDURE TCustomXmlScanner.LoadFromBuffer (Buffer : PChar);
+          // Load XML Document from buffer
+BEGIN
+  FXmlParser.LoadFromBuffer (Buffer);
+END;
+
+
+PROCEDURE TCustomXmlScanner.SetBuffer (Buffer : PChar);
+          // Refer to Buffer
+BEGIN
+  FXmlParser.SetBuffer (Buffer);
+END;
+
+
+FUNCTION  TCustomXmlScanner.GetFilename : TFilename;
+BEGIN
+  Result := FXmlParser.Source;
+END;
+
+
+FUNCTION  TCustomXmlScanner.GetNormalize : BOOLEAN;
+BEGIN
+  Result := FXmlParser.Normalize;
+END;
+
+
+PROCEDURE TCustomXmlScanner.SetNormalize (Value : BOOLEAN);
+BEGIN
+  FXmlParser.Normalize := Value;
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN);
+          // Is called when the parser has parsed the <? xml ?> declaration of the prolog
+BEGIN
+  IF Assigned (FOnXmlProlog) THEN FOnXmlProlog (Self, XmlVersion, Encoding, Standalone);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenComment  (Comment : STRING);
+          // Is called when the parser has parsed a <!-- comment -->
+BEGIN
+  IF Assigned (FOnComment) THEN FOnComment (Self, Comment);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenPI (Target, Content: STRING; Attributes : TAttrList);
+          // Is called when the parser has parsed a <?processing instruction ?>
+BEGIN
+  IF Assigned (FOnPI) THEN FOnPI (Self, Target, Content, Attributes);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenDtdRead (RootElementName : STRING);
+          // Is called when the parser has completely parsed the DTD
+BEGIN
+  IF Assigned (FOnDtdRead) THEN FOnDtdRead (Self, RootElementName);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenStartTag (TagName : STRING; Attributes : TAttrList);
+          // Is called when the parser has parsed a start tag like <p>
+BEGIN
+  IF Assigned (FOnStartTag) THEN FOnStartTag (Self, TagName, Attributes);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenEmptyTag (TagName : STRING; Attributes : TAttrList);
+          // Is called when the parser has parsed an Empty Element Tag like <br/>
+BEGIN
+  IF Assigned (FOnEmptyTag) THEN FOnEmptyTag (Self, TagName, Attributes);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenEndTag (TagName : STRING);
+          // Is called when the parser has parsed an End Tag like </p>
+BEGIN
+  IF Assigned (FOnEndTag) THEN FOnEndTag (Self, TagName);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenContent (Content : STRING);
+          // Is called when the parser has parsed an element's text content
+BEGIN
+  IF Assigned (FOnContent) THEN FOnContent (Self, Content);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenCData (Content : STRING);
+          // Is called when the parser has parsed a CDATA section
+BEGIN
+  IF Assigned (FOnCData) THEN FOnCData (Self, Content);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenElement (ElemDef : TElemDef);
+          // Is called when the parser has parsed an <!ELEMENT> definition
+          // inside the DTD
+BEGIN
+  IF Assigned (FOnElement) THEN FOnElement (Self, ElemDef);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenAttList (ElemDef : TElemDef);
+          // Is called when the parser has parsed an <!ATTLIST> definition
+          // inside the DTD
+BEGIN
+  IF Assigned (FOnAttList) THEN FOnAttList (Self, ElemDef);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenEntity   (EntityDef : TEntityDef);
+          // Is called when the parser has parsed an <!ENTITY> definition
+          // inside the DTD
+BEGIN
+  IF Assigned (FOnEntity) THEN FOnEntity (Self, EntityDef);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenNotation (NotationDef : TNotationDef);
+          // Is called when the parser has parsed a <!NOTATION> definition
+          // inside the DTD
+BEGIN
+  IF Assigned (FOnNotation) THEN FOnNotation (Self, NotationDef);
+END;
+
+
+PROCEDURE TCustomXmlScanner.WhenDtdError (ErrorPos : PChar);
+          // Is called when the parser has found an Error in the DTD
+BEGIN
+  IF Assigned (FOnDtdError) THEN FOnDtdError (Self, ErrorPos);
+END;
+
+
+PROCEDURE TCustomXmlScanner.Execute;
+          // Perform scanning
+          // Scanning is done synchronously, i.e. you can expect events to be triggered
+          // in the order of the XML data stream. Execute will finish when the whole XML
+          // document has been scanned or when the StopParser property has been set to TRUE.
+BEGIN
+  FStopParser := FALSE;
+  FXmlParser.StartScan;
+  WHILE FXmlParser.Scan AND (NOT FStopParser) DO
+    CASE FXmlParser.CurPartType OF
+      ptNone      : ;
+      ptXmlProlog : WhenXmlProlog (FXmlParser.XmlVersion, FXmlParser.Encoding, FXmlParser.Standalone);
+      ptComment   : WhenComment   (StrSFPas (FXmlParser.CurStart, FXmlParser.CurFinal));
+      ptPI        : WhenPI        (FXmlParser.CurName, FXmlParser.CurContent, FXmlParser.CurAttr);
+      ptDtdc      : WhenDtdRead   (FXmlParser.RootName);
+      ptStartTag  : WhenStartTag  (FXmlParser.CurName, FXmlParser.CurAttr);
+      ptEmptyTag  : WhenEmptyTag  (FXmlParser.CurName, FXmlParser.CurAttr);
+      ptEndTag    : WhenEndTag    (FXmlParser.CurName);
+      ptContent   : WhenContent   (FXmlParser.CurContent);
+      ptCData     : WhenCData     (FXmlParser.CurContent);
+      END;
+END;
+
+
+END.
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas
index 461fa261..ad9b24e6 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas
@@ -1,189 +1,189 @@
-unit logger;

-{

-  $Id: logger.pas,v 1.2 2006/11/26 16:58:04 savage Exp $

-

-}

-{******************************************************************************}

-{                                                                              }

-{                Error Logging Unit                                            }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Portions created by Dominique Louis are                                      }

-{ Copyright (C) 2000 - 2001 Dominique Louis.                                   }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{                                                                              }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{   Logging functions...                                                       }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   SDL.dll on Windows platforms                                               }

-{   libSDL-1.1.so.0 on Linux platform                                          }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{               2001 - DL : Initial creation                                   }

-{         25/10/2001 - DRE : Added $M+ directive to allow published            }

-{                                in classes. Added a compile directive         }

-{                                around fmShareExclusive as this does not      }

-{                                exist in Free Pascal                          }

-{                                                                              }

-{******************************************************************************}

-{

-  $Log: logger.pas,v $

-  Revision 1.2  2006/11/26 16:58:04  savage

-  Modifed to create separate log files. Therefore each instance running from the same directory will have their own individual log file, prepended with a number.

-

-  Revision 1.1  2004/02/05 00:08:20  savage

-  Module 1.0 release

-

-  

-}

-

-{$I jedi-sdl.inc}

-

-{$WEAKPACKAGEUNIT OFF}

-

-interface

-

-uses

-  Classes,

-  SysUtils;

-

-type

-  TLogger = class

-  private

-    FFileHandle : TextFile;

-    FApplicationName : string;

-    FApplicationPath : string;

-  protected

-

-  public

-    constructor Create;

-    destructor Destroy; override;

-    function GetApplicationName: string;

-    function GetApplicationPath: string;

-    procedure LogError( ErrorMessage : string; Location : string );

-    procedure LogWarning( WarningMessage : string; Location : string );

-    procedure LogStatus( StatusMessage : string; Location : string );

-  published

-    property ApplicationName : string read GetApplicationName;

-    property ApplicationPath : string read GetApplicationPath;

-  end;

-

-var

-  Log : TLogger;

-

-implementation

-

-{ TLogger }

-constructor TLogger.Create;

-var

-  FileName : string;

-  FileNo : integer;

-begin

-  FApplicationName := ExtractFileName( ParamStr(0) );

-  FApplicationPath := ExtractFilePath( ParamStr(0) );

-  FileName := FApplicationPath + ChangeFileExt( FApplicationName, '.log' );

-  FileNo := 0;

-  while FileExists( FileName ) do

-  begin

-    inc( FileNo );

-    FileName := FApplicationPath + IntToStr( FileNo ) + ChangeFileExt( FApplicationName, '.log' )

-  end;

-  AssignFile( FFileHandle, FileName );

-  ReWrite( FFileHandle );

-  (*inherited Create( FApplicationPath + ChangeFileExt( FApplicationName, '.log' ),

-                    fmCreate {$IFNDEF FPC}or fmShareExclusive{$ENDIF} );*)

-end;

-

-destructor TLogger.Destroy;

-begin

-  CloseFile( FFileHandle );

-  inherited;

-end;

-

-function TLogger.GetApplicationName: string;

-begin

-  result := FApplicationName;

-end;

-

-function TLogger.GetApplicationPath: string;

-begin

-  result := FApplicationPath;

-end;

-

-procedure TLogger.LogError(ErrorMessage, Location: string);

-var

-  S : string;

-begin

-  S := '*** ERROR *** : @ ' + TimeToStr(Time) + ' MSG : ' + ErrorMessage + ' IN : ' + Location + #13#10;

-  WriteLn( FFileHandle,  S );

-  Flush( FFileHandle );

-end;

-

-procedure TLogger.LogStatus(StatusMessage, Location: string);

-var

-  S : string;

-begin

-  S := 'STATUS INFO : @ ' + TimeToStr(Time) + ' MSG : ' + StatusMessage + ' IN : ' + Location + #13#10;

-  WriteLn( FFileHandle,  S );

-  Flush( FFileHandle );

-end;

-

-procedure TLogger.LogWarning(WarningMessage, Location: string);

-var

-  S : string;

-begin

-  S := '=== WARNING === : @ ' + TimeToStr(Time) + ' MSG : ' + WarningMessage + ' IN : ' + Location + #13#10;

-  WriteLn( FFileHandle,  S );

-  Flush( FFileHandle );

-end;

-

-initialization

-begin

-  Log := TLogger.Create;

-  Log.LogStatus( 'Starting Application', 'Initialization' );

-end;

-

-finalization

-begin

-  Log.LogStatus( 'Terminating Application', 'Finalization' );

-  Log.Free;

-  Log := nil;

-end;

-

-end.

+unit logger;
+{
+  $Id: logger.pas,v 1.2 2006/11/26 16:58:04 savage Exp $
+
+}
+{******************************************************************************}
+{                                                                              }
+{                Error Logging Unit                                            }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Portions created by Dominique Louis are                                      }
+{ Copyright (C) 2000 - 2001 Dominique Louis.                                   }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{                                                                              }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{   Logging functions...                                                       }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   SDL.dll on Windows platforms                                               }
+{   libSDL-1.1.so.0 on Linux platform                                          }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{               2001 - DL : Initial creation                                   }
+{         25/10/2001 - DRE : Added $M+ directive to allow published            }
+{                                in classes. Added a compile directive         }
+{                                around fmShareExclusive as this does not      }
+{                                exist in Free Pascal                          }
+{                                                                              }
+{******************************************************************************}
+{
+  $Log: logger.pas,v $
+  Revision 1.2  2006/11/26 16:58:04  savage
+  Modifed to create separate log files. Therefore each instance running from the same directory will have their own individual log file, prepended with a number.
+
+  Revision 1.1  2004/02/05 00:08:20  savage
+  Module 1.0 release
+
+  
+}
+
+{$I jedi-sdl.inc}
+
+{$WEAKPACKAGEUNIT OFF}
+
+interface
+
+uses
+  Classes,
+  SysUtils;
+
+type
+  TLogger = class
+  private
+    FFileHandle : TextFile;
+    FApplicationName : string;
+    FApplicationPath : string;
+  protected
+
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function GetApplicationName: string;
+    function GetApplicationPath: string;
+    procedure LogError( ErrorMessage : string; Location : string );
+    procedure LogWarning( WarningMessage : string; Location : string );
+    procedure LogStatus( StatusMessage : string; Location : string );
+  published
+    property ApplicationName : string read GetApplicationName;
+    property ApplicationPath : string read GetApplicationPath;
+  end;
+
+var
+  Log : TLogger;
+
+implementation
+
+{ TLogger }
+constructor TLogger.Create;
+var
+  FileName : string;
+  FileNo : integer;
+begin
+  FApplicationName := ExtractFileName( ParamStr(0) );
+  FApplicationPath := ExtractFilePath( ParamStr(0) );
+  FileName := FApplicationPath + ChangeFileExt( FApplicationName, '.log' );
+  FileNo := 0;
+  while FileExists( FileName ) do
+  begin
+    inc( FileNo );
+    FileName := FApplicationPath + IntToStr( FileNo ) + ChangeFileExt( FApplicationName, '.log' )
+  end;
+  AssignFile( FFileHandle, FileName );
+  ReWrite( FFileHandle );
+  (*inherited Create( FApplicationPath + ChangeFileExt( FApplicationName, '.log' ),
+                    fmCreate {$IFNDEF FPC}or fmShareExclusive{$ENDIF} );*)
+end;
+
+destructor TLogger.Destroy;
+begin
+  CloseFile( FFileHandle );
+  inherited;
+end;
+
+function TLogger.GetApplicationName: string;
+begin
+  result := FApplicationName;
+end;
+
+function TLogger.GetApplicationPath: string;
+begin
+  result := FApplicationPath;
+end;
+
+procedure TLogger.LogError(ErrorMessage, Location: string);
+var
+  S : string;
+begin
+  S := '*** ERROR *** : @ ' + TimeToStr(Time) + ' MSG : ' + ErrorMessage + ' IN : ' + Location + #13#10;
+  WriteLn( FFileHandle,  S );
+  Flush( FFileHandle );
+end;
+
+procedure TLogger.LogStatus(StatusMessage, Location: string);
+var
+  S : string;
+begin
+  S := 'STATUS INFO : @ ' + TimeToStr(Time) + ' MSG : ' + StatusMessage + ' IN : ' + Location + #13#10;
+  WriteLn( FFileHandle,  S );
+  Flush( FFileHandle );
+end;
+
+procedure TLogger.LogWarning(WarningMessage, Location: string);
+var
+  S : string;
+begin
+  S := '=== WARNING === : @ ' + TimeToStr(Time) + ' MSG : ' + WarningMessage + ' IN : ' + Location + #13#10;
+  WriteLn( FFileHandle,  S );
+  Flush( FFileHandle );
+end;
+
+initialization
+begin
+  Log := TLogger.Create;
+  Log.LogStatus( 'Starting Application', 'Initialization' );
+end;
+
+finalization
+begin
+  Log.LogStatus( 'Terminating Application', 'Finalization' );
+  Log.Free;
+  Log := nil;
+end;
+
+end.
  
\ No newline at end of file
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas
index 146e4b30..56863ea5 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas
@@ -1,319 +1,319 @@
-unit moduleloader;

-{

-  $Id: moduleloader.pas,v 1.4 2004/02/20 17:19:10 savage Exp $

-  

-}

-{******************************************************************}

-{                                                                  }

-{       Project JEDI                                               }

-{       OS independent Dynamic Loading Helpers                     }

-{                                                                  }

-{ The initial developer of the this code is                        }

-{ Robert Marquardt <robert_marquardt@gmx.de)                       }

-{                                                                  }

-{ Copyright (C) 2000, 2001 Robert Marquardt.                       }

-{                                                                  }

-{ Obtained through:                                                }

-{ Joint Endeavour of Delphi Innovators (Project JEDI)              }

-{                                                                  }

-{ You may retrieve the latest version of this file at the Project  }

-{ JEDI home page, located at http://delphi-jedi.org                }

-{                                                                  }

-{ 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/NPL/NPL-1_1Final.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.                        }

-{                                                                  }

-{******************************************************************}

-{

-  $Log: moduleloader.pas,v $

-  Revision 1.4  2004/02/20 17:19:10  savage

-  Added Calling convention to Win32 functions just in case.

-

-  Revision 1.3  2004/02/14 22:36:29  savage

-  Fixed inconsistencies of using LoadLibrary and LoadModule.

-  Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.

-

-  Revision 1.2  2004/02/14 00:23:39  savage

-  As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.

-

-  Revision 1.1  2004/02/14 00:04:50  savage

-  dllfuncs conflicts with FreePascal so it has been renamed back to the moduleloader.pas

-

-  Revision 1.1  2004/02/05 00:08:19  savage

-  Module 1.0 release

-

-  

-}

-

-interface

-

-{$i jedi-sdl.inc}

-{$WEAKPACKAGEUNIT ON}

-

-// each OS gets its own IFDEFed complete code block to make reading easier

-

-{$IFDEF WIN32}

-uses

-  Windows;

-

-type

-  // Handle to a loaded DLL

-  TModuleHandle = HINST;

-

-const

-  // Value designating an unassigned TModuleHandle od a failed loading

-  INVALID_MODULEHANDLE_VALUE = TModuleHandle(0);

-

-function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean; stdcall;

-function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean; stdcall;

-procedure UnloadModule(var Module: TModuleHandle); stdcall;

-function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer; stdcall;

-function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer; stdcall;

-function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall;

-function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall;

-

-implementation

-

-// load the DLL file FileName

-// the rules for FileName are those of LoadLibrary

-// Returns: True = success, False = failure to load

-// Assigns: the handle of the loaded DLL to Module

-// Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE

-// on entry the function will do nothing but returning success.

-

-function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;

-begin

-  if Module = INVALID_MODULEHANDLE_VALUE then

-    Module := LoadLibrary( FileName );

-  Result := Module <> INVALID_MODULEHANDLE_VALUE;

-end;

-

-// load the DLL file FileName

-// LoadLibraryEx is used to get better control of the loading

-// for the allowed values for flags see LoadLibraryEx documentation.

-

-function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;

-begin

-  if Module = INVALID_MODULEHANDLE_VALUE then

-    Module := LoadLibraryEx( FileName, 0, Flags);

-  Result := Module <> INVALID_MODULEHANDLE_VALUE;

-end;

-

-// unload a DLL loaded with LoadModule or LoadModuleEx

-// The procedure will not try to unload a handle with

-// value INVALID_MODULEHANDLE_VALUE and assigns this value

-// to Module after unload.

-

-procedure UnloadModule(var Module: TModuleHandle);

-begin

-  if Module <> INVALID_MODULEHANDLE_VALUE then

-    FreeLibrary(Module);

-  Module := INVALID_MODULEHANDLE_VALUE;

-end;

-

-// returns the pointer to the symbol named SymbolName

-// if it is exported from the DLL Module

-// nil is returned if the symbol is not available

-

-function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;

-begin

-  Result := nil;

-  if Module <> INVALID_MODULEHANDLE_VALUE then

-    Result := GetProcAddress(Module, SymbolName );

-end;

-

-// returns the pointer to the symbol named SymbolName

-// if it is exported from the DLL Module

-// nil is returned if the symbol is not available.

-// as an extra the boolean variable Accu is updated

-// by anding in the success of the function.

-// This is very handy for rendering a global result

-// when accessing a long list of symbols.

-

-function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;

-begin

-  Result := nil;

-  if Module <> INVALID_MODULEHANDLE_VALUE then

-    Result := GetProcAddress(Module, SymbolName );

-  Accu := Accu and (Result <> nil);

-end;

-

-// get the value of variables exported from a DLL Module

-// Delphi cannot access variables in a DLL directly, so

-// this function allows to copy the data from the DLL.

-// Beware! You are accessing the DLL memory image directly.

-// Be sure to access a variable not a function and be sure

-// to read the correct amount of data.

-

-function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;

-var

-  Sym: Pointer;

-begin

-  Result := True;

-  Sym := GetModuleSymbolEx(Module, SymbolName, Result);

-  if Result then

-    Move(Sym^, Buffer, Size);

-end;

-

-// set the value of variables exported from a DLL Module

-// Delphi cannot access variables in a DLL directly, so

-// this function allows to copy the data to the DLL!

-// BEWARE! You are accessing the DLL memory image directly.

-// Be sure to access a variable not a function and be sure

-// to write the correct amount of data.

-// The changes are not persistent. They get lost when the

-// DLL is unloaded.

-

-function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;

-var

-  Sym: Pointer;

-begin

-  Result := True;

-  Sym := GetModuleSymbolEx(Module, SymbolName, Result);

-  if Result then

-    Move(Buffer, Sym^, Size);

-end;

-

-{$ENDIF}

-

-{$IFDEF Unix}

-uses

-{$ifdef Linux}

-  Types,

-  Libc;

-{$else}

-  dl,

-  Types,

-  Baseunix,

-  Unix;

-{$endif}

-type

-  // Handle to a loaded .so

-  TModuleHandle = Pointer;

-

-const

-  // Value designating an unassigned TModuleHandle od a failed loading

-  INVALID_MODULEHANDLE_VALUE = TModuleHandle(nil);

-

-function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;

-function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;

-procedure UnloadModule(var Module: TModuleHandle);

-function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;

-function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;

-function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;

-function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;

-

-implementation

-

-// load the .so file FileName

-// the rules for FileName are those of dlopen()

-// Returns: True = success, False = failure to load

-// Assigns: the handle of the loaded .so to Module

-// Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE

-// on entry the function will do nothing but returning success.

-

-function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;

-begin

-  if Module = INVALID_MODULEHANDLE_VALUE then

-    Module := dlopen( FileName, RTLD_NOW);

-  Result := Module <> INVALID_MODULEHANDLE_VALUE;

-end;

-

-// load the .so file FileName

-// dlopen() with flags is used to get better control of the loading

-// for the allowed values for flags see "man dlopen".

-

-function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;

-begin

-  if Module = INVALID_MODULEHANDLE_VALUE then

-    Module := dlopen( FileName, Flags);

-  Result := Module <> INVALID_MODULEHANDLE_VALUE;

-end;

-

-// unload a .so loaded with LoadModule or LoadModuleEx

-// The procedure will not try to unload a handle with

-// value INVALID_MODULEHANDLE_VALUE and assigns this value

-// to Module after unload.

-

-procedure UnloadModule(var Module: TModuleHandle);

-begin

-  if Module <> INVALID_MODULEHANDLE_VALUE then

-    dlclose(Module);

-  Module := INVALID_MODULEHANDLE_VALUE;

-end;

-

-// returns the pointer to the symbol named SymbolName

-// if it is exported from the .so Module

-// nil is returned if the symbol is not available

-

-function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;

-begin

-  Result := nil;

-  if Module <> INVALID_MODULEHANDLE_VALUE then

-    Result := dlsym(Module, SymbolName );

-end;

-

-// returns the pointer to the symbol named SymbolName

-// if it is exported from the .so Module

-// nil is returned if the symbol is not available.

-// as an extra the boolean variable Accu is updated

-// by anding in the success of the function.

-// This is very handy for rendering a global result

-// when accessing a long list of symbols.

-

-function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;

-begin

-  Result := nil;

-  if Module <> INVALID_MODULEHANDLE_VALUE then

-    Result := dlsym(Module, SymbolName );

-  Accu := Accu and (Result <> nil);

-end;

-

-// get the value of variables exported from a .so Module

-// Delphi cannot access variables in a .so directly, so

-// this function allows to copy the data from the .so.

-// Beware! You are accessing the .so memory image directly.

-// Be sure to access a variable not a function and be sure

-// to read the correct amount of data.

-

-function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;

-var

-  Sym: Pointer;

-begin

-  Result := True;

-  Sym := GetModuleSymbolEx(Module, SymbolName, Result);

-  if Result then

-    Move(Sym^, Buffer, Size);

-end;

-

-// set the value of variables exported from a .so Module

-// Delphi cannot access variables in a .so directly, so

-// this function allows to copy the data to the .so!

-// BEWARE! You are accessing the .so memory image directly.

-// Be sure to access a variable not a function and be sure

-// to write the correct amount of data.

-// The changes are not persistent. They get lost when the

-// .so is unloaded.

-

-function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;

-var

-  Sym: Pointer;

-begin

-  Result := True;

-  Sym := GetModuleSymbolEx(Module, SymbolName, Result);

-  if Result then

-    Move(Buffer, Sym^, Size);

-end;

-{$ENDIF}

-

-{$IFDEF __MACH__} // Mach definitions go here

-{$ENDIF}

-

-end.

+unit moduleloader;
+{
+  $Id: moduleloader.pas,v 1.4 2004/02/20 17:19:10 savage Exp $
+  
+}
+{******************************************************************}
+{                                                                  }
+{       Project JEDI                                               }
+{       OS independent Dynamic Loading Helpers                     }
+{                                                                  }
+{ The initial developer of the this code is                        }
+{ Robert Marquardt <robert_marquardt@gmx.de)                       }
+{                                                                  }
+{ Copyright (C) 2000, 2001 Robert Marquardt.                       }
+{                                                                  }
+{ Obtained through:                                                }
+{ Joint Endeavour of Delphi Innovators (Project JEDI)              }
+{                                                                  }
+{ You may retrieve the latest version of this file at the Project  }
+{ JEDI home page, located at http://delphi-jedi.org                }
+{                                                                  }
+{ 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/NPL/NPL-1_1Final.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.                        }
+{                                                                  }
+{******************************************************************}
+{
+  $Log: moduleloader.pas,v $
+  Revision 1.4  2004/02/20 17:19:10  savage
+  Added Calling convention to Win32 functions just in case.
+
+  Revision 1.3  2004/02/14 22:36:29  savage
+  Fixed inconsistencies of using LoadLibrary and LoadModule.
+  Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.
+
+  Revision 1.2  2004/02/14 00:23:39  savage
+  As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
+
+  Revision 1.1  2004/02/14 00:04:50  savage
+  dllfuncs conflicts with FreePascal so it has been renamed back to the moduleloader.pas
+
+  Revision 1.1  2004/02/05 00:08:19  savage
+  Module 1.0 release
+
+  
+}
+
+interface
+
+{$i jedi-sdl.inc}
+{$WEAKPACKAGEUNIT ON}
+
+// each OS gets its own IFDEFed complete code block to make reading easier
+
+{$IFDEF WIN32}
+uses
+  Windows;
+
+type
+  // Handle to a loaded DLL
+  TModuleHandle = HINST;
+
+const
+  // Value designating an unassigned TModuleHandle od a failed loading
+  INVALID_MODULEHANDLE_VALUE = TModuleHandle(0);
+
+function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean; stdcall;
+function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean; stdcall;
+procedure UnloadModule(var Module: TModuleHandle); stdcall;
+function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer; stdcall;
+function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer; stdcall;
+function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall;
+function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall;
+
+implementation
+
+// load the DLL file FileName
+// the rules for FileName are those of LoadLibrary
+// Returns: True = success, False = failure to load
+// Assigns: the handle of the loaded DLL to Module
+// Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE
+// on entry the function will do nothing but returning success.
+
+function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;
+begin
+  if Module = INVALID_MODULEHANDLE_VALUE then
+    Module := LoadLibrary( FileName );
+  Result := Module <> INVALID_MODULEHANDLE_VALUE;
+end;
+
+// load the DLL file FileName
+// LoadLibraryEx is used to get better control of the loading
+// for the allowed values for flags see LoadLibraryEx documentation.
+
+function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;
+begin
+  if Module = INVALID_MODULEHANDLE_VALUE then
+    Module := LoadLibraryEx( FileName, 0, Flags);
+  Result := Module <> INVALID_MODULEHANDLE_VALUE;
+end;
+
+// unload a DLL loaded with LoadModule or LoadModuleEx
+// The procedure will not try to unload a handle with
+// value INVALID_MODULEHANDLE_VALUE and assigns this value
+// to Module after unload.
+
+procedure UnloadModule(var Module: TModuleHandle);
+begin
+  if Module <> INVALID_MODULEHANDLE_VALUE then
+    FreeLibrary(Module);
+  Module := INVALID_MODULEHANDLE_VALUE;
+end;
+
+// returns the pointer to the symbol named SymbolName
+// if it is exported from the DLL Module
+// nil is returned if the symbol is not available
+
+function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;
+begin
+  Result := nil;
+  if Module <> INVALID_MODULEHANDLE_VALUE then
+    Result := GetProcAddress(Module, SymbolName );
+end;
+
+// returns the pointer to the symbol named SymbolName
+// if it is exported from the DLL Module
+// nil is returned if the symbol is not available.
+// as an extra the boolean variable Accu is updated
+// by anding in the success of the function.
+// This is very handy for rendering a global result
+// when accessing a long list of symbols.
+
+function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;
+begin
+  Result := nil;
+  if Module <> INVALID_MODULEHANDLE_VALUE then
+    Result := GetProcAddress(Module, SymbolName );
+  Accu := Accu and (Result <> nil);
+end;
+
+// get the value of variables exported from a DLL Module
+// Delphi cannot access variables in a DLL directly, so
+// this function allows to copy the data from the DLL.
+// Beware! You are accessing the DLL memory image directly.
+// Be sure to access a variable not a function and be sure
+// to read the correct amount of data.
+
+function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
+var
+  Sym: Pointer;
+begin
+  Result := True;
+  Sym := GetModuleSymbolEx(Module, SymbolName, Result);
+  if Result then
+    Move(Sym^, Buffer, Size);
+end;
+
+// set the value of variables exported from a DLL Module
+// Delphi cannot access variables in a DLL directly, so
+// this function allows to copy the data to the DLL!
+// BEWARE! You are accessing the DLL memory image directly.
+// Be sure to access a variable not a function and be sure
+// to write the correct amount of data.
+// The changes are not persistent. They get lost when the
+// DLL is unloaded.
+
+function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
+var
+  Sym: Pointer;
+begin
+  Result := True;
+  Sym := GetModuleSymbolEx(Module, SymbolName, Result);
+  if Result then
+    Move(Buffer, Sym^, Size);
+end;
+
+{$ENDIF}
+
+{$IFDEF Unix}
+uses
+{$ifdef Linux}
+  Types,
+  Libc;
+{$else}
+  dl,
+  Types,
+  Baseunix,
+  Unix;
+{$endif}
+type
+  // Handle to a loaded .so
+  TModuleHandle = Pointer;
+
+const
+  // Value designating an unassigned TModuleHandle od a failed loading
+  INVALID_MODULEHANDLE_VALUE = TModuleHandle(nil);
+
+function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;
+function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;
+procedure UnloadModule(var Module: TModuleHandle);
+function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;
+function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;
+function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
+function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
+
+implementation
+
+// load the .so file FileName
+// the rules for FileName are those of dlopen()
+// Returns: True = success, False = failure to load
+// Assigns: the handle of the loaded .so to Module
+// Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE
+// on entry the function will do nothing but returning success.
+
+function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;
+begin
+  if Module = INVALID_MODULEHANDLE_VALUE then
+    Module := dlopen( FileName, RTLD_NOW);
+  Result := Module <> INVALID_MODULEHANDLE_VALUE;
+end;
+
+// load the .so file FileName
+// dlopen() with flags is used to get better control of the loading
+// for the allowed values for flags see "man dlopen".
+
+function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;
+begin
+  if Module = INVALID_MODULEHANDLE_VALUE then
+    Module := dlopen( FileName, Flags);
+  Result := Module <> INVALID_MODULEHANDLE_VALUE;
+end;
+
+// unload a .so loaded with LoadModule or LoadModuleEx
+// The procedure will not try to unload a handle with
+// value INVALID_MODULEHANDLE_VALUE and assigns this value
+// to Module after unload.
+
+procedure UnloadModule(var Module: TModuleHandle);
+begin
+  if Module <> INVALID_MODULEHANDLE_VALUE then
+    dlclose(Module);
+  Module := INVALID_MODULEHANDLE_VALUE;
+end;
+
+// returns the pointer to the symbol named SymbolName
+// if it is exported from the .so Module
+// nil is returned if the symbol is not available
+
+function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;
+begin
+  Result := nil;
+  if Module <> INVALID_MODULEHANDLE_VALUE then
+    Result := dlsym(Module, SymbolName );
+end;
+
+// returns the pointer to the symbol named SymbolName
+// if it is exported from the .so Module
+// nil is returned if the symbol is not available.
+// as an extra the boolean variable Accu is updated
+// by anding in the success of the function.
+// This is very handy for rendering a global result
+// when accessing a long list of symbols.
+
+function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;
+begin
+  Result := nil;
+  if Module <> INVALID_MODULEHANDLE_VALUE then
+    Result := dlsym(Module, SymbolName );
+  Accu := Accu and (Result <> nil);
+end;
+
+// get the value of variables exported from a .so Module
+// Delphi cannot access variables in a .so directly, so
+// this function allows to copy the data from the .so.
+// Beware! You are accessing the .so memory image directly.
+// Be sure to access a variable not a function and be sure
+// to read the correct amount of data.
+
+function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
+var
+  Sym: Pointer;
+begin
+  Result := True;
+  Sym := GetModuleSymbolEx(Module, SymbolName, Result);
+  if Result then
+    Move(Sym^, Buffer, Size);
+end;
+
+// set the value of variables exported from a .so Module
+// Delphi cannot access variables in a .so directly, so
+// this function allows to copy the data to the .so!
+// BEWARE! You are accessing the .so memory image directly.
+// Be sure to access a variable not a function and be sure
+// to write the correct amount of data.
+// The changes are not persistent. They get lost when the
+// .so is unloaded.
+
+function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
+var
+  Sym: Pointer;
+begin
+  Result := True;
+  Sym := GetModuleSymbolEx(Module, SymbolName, Result);
+  if Result then
+    Move(Buffer, Sym^, Size);
+end;
+{$ENDIF}
+
+{$IFDEF __MACH__} // Mach definitions go here
+{$ENDIF}
+
+end.
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas
index 2d28a222..4a5d55f0 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas
@@ -1,229 +1,229 @@
-unit registryuserpreferences;

-{

-  $Id: registryuserpreferences.pas,v 1.1 2004/09/30 22:35:47 savage Exp $

-  

-}

-{******************************************************************************}

-{                                                                              }

-{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }

-{             Wrapper class for Windows Register and INI Files                 }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Dominqiue Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Portions created by Dominqiue Louis are                                      }

-{ Copyright (C) 2000 - 2001 Dominqiue Louis.                                   }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{                                                                              }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }

-{   They are available from...                                                 }

-{   http://www.libsdl.org .                                                    }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{   September   23 2004 - DL : Initial Creation                                }

-{

-  $Log: registryuserpreferences.pas,v $

-  Revision 1.1  2004/09/30 22:35:47  savage

-  Changes, enhancements and additions as required to get SoAoS working.

-

-

-}

-{******************************************************************************}

-

-interface

-

-uses

-  {$IFDEF REG}

-  Registry,

-  {$ELSE}

-  IniFiles,

-  {$ENDIF}

-  Classes,

-  userpreferences;

-

-type

-  TRegistryUserPreferences = class( TUserPreferences )

-  private

-

-  protected

-    function GetSection( const Index : Integer ) : string; virtual; abstract;

-    function GetIdentifier( const Index : Integer ) : string; virtual; abstract;

-    function GetDefaultBoolean( const Index : Integer ) : Boolean; override;

-    function GetBoolean( const Index : Integer ) : Boolean; override;

-    procedure SetBoolean( const Index : Integer; const Value : Boolean ); override;

-    function GetDefaultDateTime( const Index : Integer ) : TDateTime; override;

-    function GetDateTime( const Index : Integer ) : TDateTime; override;

-    procedure SetDateTime( const Index : Integer; const Value : TDateTime ); override;

-    function GetDefaultInteger( const Index : Integer ) : Integer; override;

-    function GetInteger( const Index : Integer ) : Integer; override;

-    procedure SetInteger( const Index : Integer; const Value : Integer ); override;

-    function GetDefaultFloat( const Index : Integer ) : single; override;

-    function GetFloat( const Index : Integer ) : single; override;

-    procedure SetFloat( const Index : Integer; const Value : single ); override;

-    function GetDefaultString( const Index : Integer ) : string; override;

-    function GetString( const Index : Integer ) : string; override;

-    procedure SetString( const Index : Integer; const Value : string ); override;

-  public

-    Registry : {$IFDEF REG}TRegIniFile{$ELSE}TIniFile{$ENDIF};

-    constructor Create( const FileName : string = '' ); reintroduce;

-    destructor Destroy; override;

-    procedure Update; override;

-  end;

-

-implementation

-

-uses

-  SysUtils;

-

-{ TRegistryUserPreferences }

-constructor TRegistryUserPreferences.Create( const FileName : string );

-var

-  defFileName : string;

-begin

-  inherited Create;

-

-  if FileName <> '' then

-    defFileName := FileName

-  else

-    defFileName := ChangeFileExt( ParamStr( 0 ), '.ini' );

-

-  Registry := {$IFDEF REG}TRegIniFile{$ELSE}TIniFile{$ENDIF}.Create( defFileName );

-end;

-

-destructor TRegistryUserPreferences.Destroy;

-begin

-  Update;

-  Registry.Free;

-  Registry := nil;

-  inherited;

-end;

-

-function TRegistryUserPreferences.GetBoolean( const Index : Integer ) : Boolean;

-begin

-  Result := Registry.ReadBool( GetSection( Index ), GetIdentifier( Index ), GetDefaultBoolean( Index ) );

-end;

-

-function TRegistryUserPreferences.GetDateTime( const Index : Integer ): TDateTime;

-begin

-  Result := Registry.ReadDateTime( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ), GetDefaultDateTime( Index ){$ENDIF} );

-end;

-

-function TRegistryUserPreferences.GetDefaultBoolean( const Index : Integer ) : Boolean;

-begin

-  result := false;

-end;

-

-function TRegistryUserPreferences.GetDefaultDateTime( const Index: Integer ) : TDateTime;

-begin

-  result := Now;

-end;

-

-function TRegistryUserPreferences.GetDefaultFloat( const Index: Integer ) : single;

-begin

-  result := 0.0;

-end;

-

-function TRegistryUserPreferences.GetDefaultInteger(const Index : Integer ) : Integer;

-begin

-  result := 0;

-end;

-

-function TRegistryUserPreferences.GetDefaultString( const Index : Integer ) : string;

-begin

-  result := '';

-end;

-

-function TRegistryUserPreferences.GetFloat( const Index : Integer ): single;

-begin

-  Result := Registry.ReadFloat( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ), GetDefaultFloat( Index ){$ENDIF} );

-end;

-

-function TRegistryUserPreferences.GetInteger( const Index : Integer ) : Integer;

-begin

-  Result := Registry.ReadInteger( GetSection( Index ), GetIdentifier( Index ), GetDefaultInteger( Index )  );

-end;

-

-function TRegistryUserPreferences.GetString( const Index : Integer ): string;

-begin

-  Result := Registry.ReadString( GetSection( Index ), GetIdentifier( Index ), GetDefaultString( Index ) );

-end;

-

-procedure TRegistryUserPreferences.SetBoolean( const Index : Integer; const Value : Boolean );

-begin

-  Registry.WriteBool( GetSection( Index ), GetIdentifier( Index ), Value );

-  inherited;

-end;

-

-procedure TRegistryUserPreferences.SetDateTime( const Index: Integer; const Value: TDateTime );

-begin

-  Registry.WriteDateTime( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ){$ENDIF}, Value );

-  inherited;

-end;

-

-procedure TRegistryUserPreferences.SetFloat(const Index: Integer; const Value: single);

-begin

-  Registry.WriteFloat( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ){$ENDIF}, Value );

-  inherited;

-end;

-

-procedure TRegistryUserPreferences.SetInteger( const Index, Value : Integer );

-begin

-  Registry.WriteInteger( GetSection( Index ), GetIdentifier( Index ), Value );

-  inherited;

-end;

-

-procedure TRegistryUserPreferences.SetString( const Index : Integer; const Value : string );

-begin

-  Registry.WriteString( GetSection( Index ), GetIdentifier( Index ), Value );

-  inherited;

-end;

-

-procedure TRegistryUserPreferences.Update;

-begin

-  {$IFDEF REG}

-  Registry.CloseKey;

-  {$ELSE}

-  Registry.UpdateFile;

-  {$ENDIF}

-end;

-

-end.

+unit registryuserpreferences;
+{
+  $Id: registryuserpreferences.pas,v 1.1 2004/09/30 22:35:47 savage Exp $
+  
+}
+{******************************************************************************}
+{                                                                              }
+{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }
+{             Wrapper class for Windows Register and INI Files                 }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Dominqiue Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Portions created by Dominqiue Louis are                                      }
+{ Copyright (C) 2000 - 2001 Dominqiue Louis.                                   }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{                                                                              }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }
+{   They are available from...                                                 }
+{   http://www.libsdl.org .                                                    }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{   September   23 2004 - DL : Initial Creation                                }
+{
+  $Log: registryuserpreferences.pas,v $
+  Revision 1.1  2004/09/30 22:35:47  savage
+  Changes, enhancements and additions as required to get SoAoS working.
+
+
+}
+{******************************************************************************}
+
+interface
+
+uses
+  {$IFDEF REG}
+  Registry,
+  {$ELSE}
+  IniFiles,
+  {$ENDIF}
+  Classes,
+  userpreferences;
+
+type
+  TRegistryUserPreferences = class( TUserPreferences )
+  private
+
+  protected
+    function GetSection( const Index : Integer ) : string; virtual; abstract;
+    function GetIdentifier( const Index : Integer ) : string; virtual; abstract;
+    function GetDefaultBoolean( const Index : Integer ) : Boolean; override;
+    function GetBoolean( const Index : Integer ) : Boolean; override;
+    procedure SetBoolean( const Index : Integer; const Value : Boolean ); override;
+    function GetDefaultDateTime( const Index : Integer ) : TDateTime; override;
+    function GetDateTime( const Index : Integer ) : TDateTime; override;
+    procedure SetDateTime( const Index : Integer; const Value : TDateTime ); override;
+    function GetDefaultInteger( const Index : Integer ) : Integer; override;
+    function GetInteger( const Index : Integer ) : Integer; override;
+    procedure SetInteger( const Index : Integer; const Value : Integer ); override;
+    function GetDefaultFloat( const Index : Integer ) : single; override;
+    function GetFloat( const Index : Integer ) : single; override;
+    procedure SetFloat( const Index : Integer; const Value : single ); override;
+    function GetDefaultString( const Index : Integer ) : string; override;
+    function GetString( const Index : Integer ) : string; override;
+    procedure SetString( const Index : Integer; const Value : string ); override;
+  public
+    Registry : {$IFDEF REG}TRegIniFile{$ELSE}TIniFile{$ENDIF};
+    constructor Create( const FileName : string = '' ); reintroduce;
+    destructor Destroy; override;
+    procedure Update; override;
+  end;
+
+implementation
+
+uses
+  SysUtils;
+
+{ TRegistryUserPreferences }
+constructor TRegistryUserPreferences.Create( const FileName : string );
+var
+  defFileName : string;
+begin
+  inherited Create;
+
+  if FileName <> '' then
+    defFileName := FileName
+  else
+    defFileName := ChangeFileExt( ParamStr( 0 ), '.ini' );
+
+  Registry := {$IFDEF REG}TRegIniFile{$ELSE}TIniFile{$ENDIF}.Create( defFileName );
+end;
+
+destructor TRegistryUserPreferences.Destroy;
+begin
+  Update;
+  Registry.Free;
+  Registry := nil;
+  inherited;
+end;
+
+function TRegistryUserPreferences.GetBoolean( const Index : Integer ) : Boolean;
+begin
+  Result := Registry.ReadBool( GetSection( Index ), GetIdentifier( Index ), GetDefaultBoolean( Index ) );
+end;
+
+function TRegistryUserPreferences.GetDateTime( const Index : Integer ): TDateTime;
+begin
+  Result := Registry.ReadDateTime( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ), GetDefaultDateTime( Index ){$ENDIF} );
+end;
+
+function TRegistryUserPreferences.GetDefaultBoolean( const Index : Integer ) : Boolean;
+begin
+  result := false;
+end;
+
+function TRegistryUserPreferences.GetDefaultDateTime( const Index: Integer ) : TDateTime;
+begin
+  result := Now;
+end;
+
+function TRegistryUserPreferences.GetDefaultFloat( const Index: Integer ) : single;
+begin
+  result := 0.0;
+end;
+
+function TRegistryUserPreferences.GetDefaultInteger(const Index : Integer ) : Integer;
+begin
+  result := 0;
+end;
+
+function TRegistryUserPreferences.GetDefaultString( const Index : Integer ) : string;
+begin
+  result := '';
+end;
+
+function TRegistryUserPreferences.GetFloat( const Index : Integer ): single;
+begin
+  Result := Registry.ReadFloat( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ), GetDefaultFloat( Index ){$ENDIF} );
+end;
+
+function TRegistryUserPreferences.GetInteger( const Index : Integer ) : Integer;
+begin
+  Result := Registry.ReadInteger( GetSection( Index ), GetIdentifier( Index ), GetDefaultInteger( Index )  );
+end;
+
+function TRegistryUserPreferences.GetString( const Index : Integer ): string;
+begin
+  Result := Registry.ReadString( GetSection( Index ), GetIdentifier( Index ), GetDefaultString( Index ) );
+end;
+
+procedure TRegistryUserPreferences.SetBoolean( const Index : Integer; const Value : Boolean );
+begin
+  Registry.WriteBool( GetSection( Index ), GetIdentifier( Index ), Value );
+  inherited;
+end;
+
+procedure TRegistryUserPreferences.SetDateTime( const Index: Integer; const Value: TDateTime );
+begin
+  Registry.WriteDateTime( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ){$ENDIF}, Value );
+  inherited;
+end;
+
+procedure TRegistryUserPreferences.SetFloat(const Index: Integer; const Value: single);
+begin
+  Registry.WriteFloat( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ){$ENDIF}, Value );
+  inherited;
+end;
+
+procedure TRegistryUserPreferences.SetInteger( const Index, Value : Integer );
+begin
+  Registry.WriteInteger( GetSection( Index ), GetIdentifier( Index ), Value );
+  inherited;
+end;
+
+procedure TRegistryUserPreferences.SetString( const Index : Integer; const Value : string );
+begin
+  Registry.WriteString( GetSection( Index ), GetIdentifier( Index ), Value );
+  inherited;
+end;
+
+procedure TRegistryUserPreferences.Update;
+begin
+  {$IFDEF REG}
+  Registry.CloseKey;
+  {$ELSE}
+  Registry.UpdateFile;
+  {$ENDIF}
+end;
+
+end.
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas
index bd371c55..b09f19f9 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas
@@ -1,155 +1,155 @@
-unit sdl_cpuinfo;

-{

-  $Id: sdl_cpuinfo.pas,v 1.2 2004/02/18 22:52:53 savage Exp $

-

-}

-{******************************************************************************}

-{                                                                              }

-{       Borland Delphi SDL - Simple DirectMedia Layer                          }

-{       Conversion of the Simple DirectMedia Layer Headers                     }

-{                                                                              }

-{ Portions created by Sam Lantinga <slouken@devolution.com> are                }

-{ Copyright (C) 1997-2004  Sam Lantinga                                        }

-{ 5635-34 Springhouse Dr.                                                      }

-{ Pleasanton, CA 94588 (USA)                                                   }

-{                                                                              }

-{ All Rights Reserved.                                                         }

-{                                                                              }

-{ The original files are : SDL_cpuinfo.h                                       }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Dominqiue Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Portions created by Dominqiue Louis are                                      }

-{ Copyright (C) 2000 - 2004 Dominqiue Louis.                                   }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }

-{   They are available from...                                                 }

-{   http://www.libsdl.org .                                                    }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{

-  $Log: sdl_cpuinfo.pas,v $

-  Revision 1.2  2004/02/18 22:52:53  savage

-  Forgot to add jedi-sdl.inc file. It's there now.

-

-  Revision 1.1  2004/02/18 22:35:54  savage

-  Brought sdl.pas up to 1.2.7 compatability

-  Thus...

-  Added SDL_GL_STEREO,

-      SDL_GL_MULTISAMPLEBUFFERS,

-      SDL_GL_MULTISAMPLESAMPLES

-

-  Add DLL/Shared object functions

-  function SDL_LoadObject( const sofile : PChar ) : Pointer;

-

-  function SDL_LoadFunction( handle : Pointer; const name : PChar ) : Pointer;

-

-  procedure SDL_UnloadObject( handle : Pointer );

-

-  Added function to create RWops from const memory: SDL_RWFromConstMem()

-  function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops;

-

-  Ported SDL_cpuinfo.h so Now you can test for Specific CPU types.

-

-

-}

-{******************************************************************************}

-

-interface

-

-{$I jedi-sdl.inc}

-

-uses

-  sdl;

-

-{* This function returns true if the CPU has the RDTSC instruction

- *}

-function SDL_HasRDTSC : SDL_Bool;

-cdecl; external {$IFDEF __GPC__}name 'SDL_HasRDTSC'{$ELSE} SDLLibName{$ENDIF __GPC__};

-{$EXTERNALSYM SDL_HasRDTSC}

-

-{* This function returns true if the CPU has MMX features

- *}

-function SDL_HasMMX : SDL_Bool;

-cdecl; external {$IFDEF __GPC__}name 'SDL_HasMMX'{$ELSE} SDLLibName{$ENDIF __GPC__};

-{$EXTERNALSYM SDL_HasMMX}

-

-{* This function returns true if the CPU has MMX Ext. features

- *}

-function SDL_HasMMXExt : SDL_Bool;

-cdecl; external {$IFDEF __GPC__}name 'SDL_HasMMXExt'{$ELSE} SDLLibName{$ENDIF __GPC__};

-{$EXTERNALSYM SDL_HasMMXExt}

-

-{* This function returns true if the CPU has 3DNow features

- *}

-function SDL_Has3DNow : SDL_Bool;

-cdecl; external {$IFDEF __GPC__}name 'SDL_Has3DNow'{$ELSE} SDLLibName{$ENDIF __GPC__};

-{$EXTERNALSYM SDL_Has3DNow}

-

-{* This function returns true if the CPU has 3DNow! Ext. features

- *}

-function SDL_Has3DNowExt : SDL_Bool;

-cdecl; external {$IFDEF __GPC__}name 'SDL_Has3DNowExt'{$ELSE} SDLLibName{$ENDIF __GPC__};

-{$EXTERNALSYM SDL_Has3DNowExt}

-

-{* This function returns true if the CPU has SSE features

- *}

-function SDL_HasSSE : SDL_Bool;

-cdecl; external {$IFDEF __GPC__}name 'SDL_HasSSE'{$ELSE} SDLLibName{$ENDIF __GPC__};

-{$EXTERNALSYM SDL_HasSSE}

-

-{* This function returns true if the CPU has SSE2 features

- *}

-function SDL_HasSSE2 : SDL_Bool;

-cdecl; external {$IFDEF __GPC__}name 'SDL_HasSSE2'{$ELSE} SDLLibName{$ENDIF __GPC__};

-{$EXTERNALSYM SDL_HasSSE2}

-

-{* This function returns true if the CPU has AltiVec features

- *}

-function SDL_HasAltiVec : SDL_Bool;

-cdecl; external {$IFDEF __GPC__}name 'SDL_HasAltiVec'{$ELSE} SDLLibName{$ENDIF __GPC__};

-{$EXTERNALSYM SDL_HasAltiVec}

-

-implementation

-

-end.

+unit sdl_cpuinfo;
+{
+  $Id: sdl_cpuinfo.pas,v 1.2 2004/02/18 22:52:53 savage Exp $
+
+}
+{******************************************************************************}
+{                                                                              }
+{       Borland Delphi SDL - Simple DirectMedia Layer                          }
+{       Conversion of the Simple DirectMedia Layer Headers                     }
+{                                                                              }
+{ Portions created by Sam Lantinga <slouken@devolution.com> are                }
+{ Copyright (C) 1997-2004  Sam Lantinga                                        }
+{ 5635-34 Springhouse Dr.                                                      }
+{ Pleasanton, CA 94588 (USA)                                                   }
+{                                                                              }
+{ All Rights Reserved.                                                         }
+{                                                                              }
+{ The original files are : SDL_cpuinfo.h                                       }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Dominqiue Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Portions created by Dominqiue Louis are                                      }
+{ Copyright (C) 2000 - 2004 Dominqiue Louis.                                   }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }
+{   They are available from...                                                 }
+{   http://www.libsdl.org .                                                    }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{
+  $Log: sdl_cpuinfo.pas,v $
+  Revision 1.2  2004/02/18 22:52:53  savage
+  Forgot to add jedi-sdl.inc file. It's there now.
+
+  Revision 1.1  2004/02/18 22:35:54  savage
+  Brought sdl.pas up to 1.2.7 compatability
+  Thus...
+  Added SDL_GL_STEREO,
+      SDL_GL_MULTISAMPLEBUFFERS,
+      SDL_GL_MULTISAMPLESAMPLES
+
+  Add DLL/Shared object functions
+  function SDL_LoadObject( const sofile : PChar ) : Pointer;
+
+  function SDL_LoadFunction( handle : Pointer; const name : PChar ) : Pointer;
+
+  procedure SDL_UnloadObject( handle : Pointer );
+
+  Added function to create RWops from const memory: SDL_RWFromConstMem()
+  function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops;
+
+  Ported SDL_cpuinfo.h so Now you can test for Specific CPU types.
+
+
+}
+{******************************************************************************}
+
+interface
+
+{$I jedi-sdl.inc}
+
+uses
+  sdl;
+
+{* This function returns true if the CPU has the RDTSC instruction
+ *}
+function SDL_HasRDTSC : SDL_Bool;
+cdecl; external {$IFDEF __GPC__}name 'SDL_HasRDTSC'{$ELSE} SDLLibName{$ENDIF __GPC__};
+{$EXTERNALSYM SDL_HasRDTSC}
+
+{* This function returns true if the CPU has MMX features
+ *}
+function SDL_HasMMX : SDL_Bool;
+cdecl; external {$IFDEF __GPC__}name 'SDL_HasMMX'{$ELSE} SDLLibName{$ENDIF __GPC__};
+{$EXTERNALSYM SDL_HasMMX}
+
+{* This function returns true if the CPU has MMX Ext. features
+ *}
+function SDL_HasMMXExt : SDL_Bool;
+cdecl; external {$IFDEF __GPC__}name 'SDL_HasMMXExt'{$ELSE} SDLLibName{$ENDIF __GPC__};
+{$EXTERNALSYM SDL_HasMMXExt}
+
+{* This function returns true if the CPU has 3DNow features
+ *}
+function SDL_Has3DNow : SDL_Bool;
+cdecl; external {$IFDEF __GPC__}name 'SDL_Has3DNow'{$ELSE} SDLLibName{$ENDIF __GPC__};
+{$EXTERNALSYM SDL_Has3DNow}
+
+{* This function returns true if the CPU has 3DNow! Ext. features
+ *}
+function SDL_Has3DNowExt : SDL_Bool;
+cdecl; external {$IFDEF __GPC__}name 'SDL_Has3DNowExt'{$ELSE} SDLLibName{$ENDIF __GPC__};
+{$EXTERNALSYM SDL_Has3DNowExt}
+
+{* This function returns true if the CPU has SSE features
+ *}
+function SDL_HasSSE : SDL_Bool;
+cdecl; external {$IFDEF __GPC__}name 'SDL_HasSSE'{$ELSE} SDLLibName{$ENDIF __GPC__};
+{$EXTERNALSYM SDL_HasSSE}
+
+{* This function returns true if the CPU has SSE2 features
+ *}
+function SDL_HasSSE2 : SDL_Bool;
+cdecl; external {$IFDEF __GPC__}name 'SDL_HasSSE2'{$ELSE} SDLLibName{$ENDIF __GPC__};
+{$EXTERNALSYM SDL_HasSSE2}
+
+{* This function returns true if the CPU has AltiVec features
+ *}
+function SDL_HasAltiVec : SDL_Bool;
+cdecl; external {$IFDEF __GPC__}name 'SDL_HasAltiVec'{$ELSE} SDLLibName{$ENDIF __GPC__};
+{$EXTERNALSYM SDL_HasAltiVec}
+
+implementation
+
+end.
  
\ No newline at end of file
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas
index cc95751d..9a58ff40 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas
@@ -1,202 +1,202 @@
-unit sdlgameinterface;

-{

-  $Id: sdlgameinterface.pas,v 1.4 2005/08/03 18:57:31 savage Exp $

-  

-}

-{******************************************************************************}

-{                                                                              }

-{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }

-{                    Game Interface Base class                                 }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Dominqiue Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Portions created by Dominqiue Louis are                                      }

-{ Copyright (C) 2000 - 2001 Dominqiue Louis.                                   }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{                                                                              }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }

-{   They are available from...                                                 }

-{   http://www.libsdl.org .                                                    }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{   September   23 2004 - DL : Initial Creation                                }

-{

-  $Log: sdlgameinterface.pas,v $

-  Revision 1.4  2005/08/03 18:57:31  savage

-  Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class

-

-  Revision 1.3  2004/10/17 18:41:49  savage

-  Slight Change to allow Reseting of Input Event handlers

-

-  Revision 1.2  2004/09/30 22:35:47  savage

-  Changes, enhancements and additions as required to get SoAoS working.

-

-

-}

-{******************************************************************************}

-

-interface

-

-uses

-  sdl,

-  sdlwindow;

-

-type

-  TGameInterfaceClass = class of TGameInterface;

-

-  TGameInterface = class( TObject )

-  private

-    FNextGameInterface : TGameInterfaceClass;

-  protected

-    Dragging : Boolean;

-    Loaded : Boolean;

-    procedure FreeSurfaces; virtual;

-    procedure Render; virtual; abstract;

-    procedure Close; virtual;

-    procedure Update( aElapsedTime : single ); virtual; 

-    procedure MouseDown( Button : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual;

-    procedure MouseMove( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ); virtual;

-    procedure MouseUp( Button : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual;

-    procedure MouseWheelScroll( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual;

-    procedure KeyDown( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ); virtual;

-  public

-    MainWindow : TSDLCustomWindow;

-    procedure ResetInputManager;

-    procedure LoadSurfaces; virtual;

-    function PointIsInRect( Point : TPoint; x, y, x1, y1 : integer ) : Boolean;

-    constructor Create( const aMainWindow : TSDLCustomWindow );

-    destructor Destroy; override;

-    property NextGameInterface : TGameInterfaceClass read FNextGameInterface write FNextGameInterface;

-  end;

-

-implementation

-

-{ TGameInterface }

-procedure TGameInterface.Close;

-begin

-  FNextGameInterface := nil;

-end;

-

-constructor TGameInterface.Create( const aMainWindow : TSDLCustomWindow );

-begin

-  inherited Create;

-  MainWindow := aMainWindow;

-  FNextGameInterface := TGameInterface;

-  ResetInputManager;

-end;

-

-destructor TGameInterface.Destroy;

-begin

-  if Loaded then

-    FreeSurfaces;

-  inherited;

-end;

-

-procedure TGameInterface.FreeSurfaces;

-begin

-  Loaded := False;

-end;

-

-procedure TGameInterface.KeyDown(var Key: TSDLKey; Shift: TSDLMod; unicode: UInt16);

-begin

-

-end;

-

-procedure TGameInterface.LoadSurfaces;

-begin

-  Loaded := True;

-end;

-

-procedure TGameInterface.MouseDown(Button: Integer; Shift: TSDLMod; MousePos: TPoint);

-begin

-  Dragging := True;

-end;

-

-procedure TGameInterface.MouseMove(Shift: TSDLMod; CurrentPos, RelativePos: TPoint);

-begin

-

-end;

-

-procedure TGameInterface.MouseUp(Button: Integer; Shift: TSDLMod; MousePos: TPoint);

-begin

-  Dragging := True;

-end;

-

-procedure TGameInterface.MouseWheelScroll(WheelDelta: Integer; Shift: TSDLMod; MousePos: TPoint);

-begin

-

-end;

-

-function TGameInterface.PointIsInRect( Point : TPoint; x, y, x1, y1: integer ): Boolean;

-begin

-  if ( Point.x >= x )

-  and ( Point.y >= y )

-  and ( Point.x <= x1 )

-  and ( Point.y <= y1 ) then

-    result := true

-  else

-    result := false;

-end;

-

-procedure TGameInterface.ResetInputManager;

-var

-  temp : TSDLNotifyEvent;

-begin

-  MainWindow.InputManager.Mouse.OnMouseDown := MouseDown;

-  MainWindow.InputManager.Mouse.OnMouseMove := MouseMove;

-  MainWindow.InputManager.Mouse.OnMouseUp := MouseUp;

-  MainWindow.InputManager.Mouse.OnMouseWheel := MouseWheelScroll;

-  MainWindow.InputManager.KeyBoard.OnKeyDown := KeyDown;

-  temp := Render;

-  MainWindow.OnRender := temp;

-  temp := Close;

-  MainWindow.OnClose := temp;

-  MainWindow.OnUpdate := Update;

-end;

-

-procedure TGameInterface.Update(aElapsedTime: single);

-begin

-

-end;

-

-end.

+unit sdlgameinterface;
+{
+  $Id: sdlgameinterface.pas,v 1.4 2005/08/03 18:57:31 savage Exp $
+  
+}
+{******************************************************************************}
+{                                                                              }
+{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }
+{                    Game Interface Base class                                 }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Dominqiue Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Portions created by Dominqiue Louis are                                      }
+{ Copyright (C) 2000 - 2001 Dominqiue Louis.                                   }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{                                                                              }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }
+{   They are available from...                                                 }
+{   http://www.libsdl.org .                                                    }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{   September   23 2004 - DL : Initial Creation                                }
+{
+  $Log: sdlgameinterface.pas,v $
+  Revision 1.4  2005/08/03 18:57:31  savage
+  Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class
+
+  Revision 1.3  2004/10/17 18:41:49  savage
+  Slight Change to allow Reseting of Input Event handlers
+
+  Revision 1.2  2004/09/30 22:35:47  savage
+  Changes, enhancements and additions as required to get SoAoS working.
+
+
+}
+{******************************************************************************}
+
+interface
+
+uses
+  sdl,
+  sdlwindow;
+
+type
+  TGameInterfaceClass = class of TGameInterface;
+
+  TGameInterface = class( TObject )
+  private
+    FNextGameInterface : TGameInterfaceClass;
+  protected
+    Dragging : Boolean;
+    Loaded : Boolean;
+    procedure FreeSurfaces; virtual;
+    procedure Render; virtual; abstract;
+    procedure Close; virtual;
+    procedure Update( aElapsedTime : single ); virtual; 
+    procedure MouseDown( Button : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual;
+    procedure MouseMove( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ); virtual;
+    procedure MouseUp( Button : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual;
+    procedure MouseWheelScroll( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual;
+    procedure KeyDown( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ); virtual;
+  public
+    MainWindow : TSDLCustomWindow;
+    procedure ResetInputManager;
+    procedure LoadSurfaces; virtual;
+    function PointIsInRect( Point : TPoint; x, y, x1, y1 : integer ) : Boolean;
+    constructor Create( const aMainWindow : TSDLCustomWindow );
+    destructor Destroy; override;
+    property NextGameInterface : TGameInterfaceClass read FNextGameInterface write FNextGameInterface;
+  end;
+
+implementation
+
+{ TGameInterface }
+procedure TGameInterface.Close;
+begin
+  FNextGameInterface := nil;
+end;
+
+constructor TGameInterface.Create( const aMainWindow : TSDLCustomWindow );
+begin
+  inherited Create;
+  MainWindow := aMainWindow;
+  FNextGameInterface := TGameInterface;
+  ResetInputManager;
+end;
+
+destructor TGameInterface.Destroy;
+begin
+  if Loaded then
+    FreeSurfaces;
+  inherited;
+end;
+
+procedure TGameInterface.FreeSurfaces;
+begin
+  Loaded := False;
+end;
+
+procedure TGameInterface.KeyDown(var Key: TSDLKey; Shift: TSDLMod; unicode: UInt16);
+begin
+
+end;
+
+procedure TGameInterface.LoadSurfaces;
+begin
+  Loaded := True;
+end;
+
+procedure TGameInterface.MouseDown(Button: Integer; Shift: TSDLMod; MousePos: TPoint);
+begin
+  Dragging := True;
+end;
+
+procedure TGameInterface.MouseMove(Shift: TSDLMod; CurrentPos, RelativePos: TPoint);
+begin
+
+end;
+
+procedure TGameInterface.MouseUp(Button: Integer; Shift: TSDLMod; MousePos: TPoint);
+begin
+  Dragging := True;
+end;
+
+procedure TGameInterface.MouseWheelScroll(WheelDelta: Integer; Shift: TSDLMod; MousePos: TPoint);
+begin
+
+end;
+
+function TGameInterface.PointIsInRect( Point : TPoint; x, y, x1, y1: integer ): Boolean;
+begin
+  if ( Point.x >= x )
+  and ( Point.y >= y )
+  and ( Point.x <= x1 )
+  and ( Point.y <= y1 ) then
+    result := true
+  else
+    result := false;
+end;
+
+procedure TGameInterface.ResetInputManager;
+var
+  temp : TSDLNotifyEvent;
+begin
+  MainWindow.InputManager.Mouse.OnMouseDown := MouseDown;
+  MainWindow.InputManager.Mouse.OnMouseMove := MouseMove;
+  MainWindow.InputManager.Mouse.OnMouseUp := MouseUp;
+  MainWindow.InputManager.Mouse.OnMouseWheel := MouseWheelScroll;
+  MainWindow.InputManager.KeyBoard.OnKeyDown := KeyDown;
+  temp := Render;
+  MainWindow.OnRender := temp;
+  temp := Close;
+  MainWindow.OnClose := temp;
+  MainWindow.OnUpdate := Update;
+end;
+
+procedure TGameInterface.Update(aElapsedTime: single);
+begin
+
+end;
+
+end.
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas
index 9151168a..4de4ebee 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas
@@ -1,5236 +1,5236 @@
-unit sdli386utils;

-{

-  $Id: sdli386utils.pas,v 1.5 2004/06/02 19:38:53 savage Exp $

-  

-}

-{******************************************************************************}

-{                                                                              }

-{       Borland Delphi SDL - Simple DirectMedia Layer                          }

-{                SDL Utility functions                                         }

-{                                                                              }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Tom Jones <tigertomjones@gmx.de>                                             }

-{                                                                              }

-{ Portions created by Tom Jones are                                            }

-{ Copyright (C) 2000 - 2001 Tom Jones.                                         }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }

-{ Róbert Kisnémeth <mikrobi@freemail.hu>                                       }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{   Helper functions...                                                        }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   SDL.dll on Windows platforms                                               }

-{   libSDL-1.1.so.0 on Linux platform                                          }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{               2000 - TJ : Initial creation                                   }

-{                                                                              }

-{   July   13   2001 - DL : Added PutPixel and GetPixel routines.              }

-{                                                                              }

-{   Sept   14   2001 - RK : Added flipping routines.                           }

-{                                                                              }

-{   Sept   19   2001 - RK : Added PutPixel & line drawing & blitting with ADD  }

-{                           effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel }

-{                           Added PSDLRect()                                   }

-{   Sept   22   2001 - DL : Removed need for Windows.pas by defining types here}

-{                           Also removed by poor attempt or a dialog box       }

-{                                                                              }

-{   Sept   25   2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine,   }

-{                           SubSurface, MonoSurface & TexturedSurface          }

-{                                                                              }

-{   Sept   26   2001 - DL : Made change so that it refers to native Pascal     }

-{                           types rather that Windows types. This makes it more}

-{                           portable to Linix.                                 }

-{                                                                              }

-{   Sept   27   2001 - RK : SDLUtils now can be compiled with FreePascal       }

-{                                                                              }

-{   Oct    27   2001 - JF : Added ScrollY function                             }

-{                                                                              }

-{   Jan    21   2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface          }

-{                                                                              }

-{   Mar    28   2002 - JF : Added SDL_RotateSurface                            }

-{                                                                              }

-{   May    13   2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub         }

-{                                                                              }

-{   May    27   2002 - YS : GradientFillRect function                          }

-{                                                                              }

-{   May    30   2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit               }

-{                           & SDL_50Scanline2xBlit                             }

-{                                                                              }

-{  June    12   2002 - RK : Added SDL_PixelTestSurfaceVsRect                   }

-{                                                                              }

-{  June    12   2002 - JF : Updated SDL_PixelTestSurfaceVsRect                 }

-{                                                                              }

-{ November  9   2002 - JF : Added Jason's boolean Surface functions            }

-{                                                                              }

-{ December 10   2002 - DE : Added Dean's SDL_ClipLine function                 }

-{                                                                              }

-{******************************************************************************}

-{

-  $Log: sdli386utils.pas,v $

-  Revision 1.5  2004/06/02 19:38:53  savage

-  Changes to SDL_GradientFillRect as suggested by

-  Ángel Eduardo García Hernández.  Many thanks.

-

-  Revision 1.4  2004/05/29 23:11:53  savage

-  Changes to SDL_ScaleSurfaceRect as suggested by

-  Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks.

-

-  Revision 1.3  2004/02/20 22:04:11  savage

-  Added Changes as mentioned by Rodrigo "Rui" R. (1/2 RRC2Soft) to facilitate FPC compilation and it also works in Delphi. Also syncronized the funcitons so that they are identical to sdlutils.pas, when no assembly version is available.

-

-  Revision 1.2  2004/02/14 00:23:39  savage

-  As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.

-

-  Revision 1.1  2004/02/05 00:08:20  savage

-  Module 1.0 release

-

-  

-}

-

-interface

-

-{$i jedi-sdl.inc}

-

-uses

-{$IFDEF UNIX}

-  Types,

-  Xlib,

-{$ENDIF}

-  SysUtils,

-  sdl;

-

-type

-  TGradientStyle = ( gsHorizontal, gsVertical );

-

-  // Pixel procedures

-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :

-  PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean;

-  

-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : cardinal; y : cardinal ) : Uint32;

-

-procedure SDL_PutPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :

-  cardinal );

-

-procedure SDL_AddPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :

-  cardinal );

-

-procedure SDL_SubPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :

-  cardinal );

-

-// Line procedures

-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );overload;

-

-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal ; DashLength, DashSpace : byte );  overload;  

-

-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-

-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-

-// Surface procedures

-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DstSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DstSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );

-

-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;

-  TextureRect : PSDL_Rect );

-

-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );

-

-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );

-

-// Flip procedures

-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );

-

-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );

-

-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;

-

-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload;

-

-function SDLRect( aRect : TRect ) : TSDL_Rect; overload;

-

-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,

-  Width, Height : integer ) : PSDL_Surface;

-

-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );

-

-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );

-

-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :

-  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );

-

-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :

-  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );

-

-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;

-

-// Fill Rect routine

-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );

-

-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );

-

-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );

-

-// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface!

-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );

-

-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );

-

-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );

-

-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :

-PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :

-boolean;

-

-// Jason's boolean Surface functions

-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-function SDL_ClipLine(var x1,y1,x2,y2: Integer; ClipRect: PSDL_Rect) : boolean;

-

-implementation

-

-uses

-  Math;

-

-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :

-  PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean;

-var

-  Src_Rect1, Src_Rect2 : TSDL_Rect;

-  right1, bottom1 : integer;

-  right2, bottom2 : integer;

-  Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;

-  Mod1, Mod2 : cardinal;

-  Addr1, Addr2 : cardinal;

-  BPP : cardinal;

-  Pitch1, Pitch2 : cardinal;

-  TransparentColor1, TransparentColor2 : cardinal;

-  tx, ty : cardinal;

-  StartTick : cardinal;

-  Color1, Color2 : cardinal;

-begin

-  Result := false;

-  if SrcRect1 = nil then

-  begin

-    with Src_Rect1 do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface1.w;

-      h := SrcSurface1.h;

-    end;

-  end

-  else

-    Src_Rect1 := SrcRect1^;

-  if SrcRect2 = nil then

-  begin

-    with Src_Rect2 do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface2.w;

-      h := SrcSurface2.h;

-    end;

-  end

-  else

-    Src_Rect2 := SrcRect2^;

-  with Src_Rect1 do

-  begin

-    Right1 := Left1 + w;

-    Bottom1 := Top1 + h;

-  end;

-  with Src_Rect2 do

-  begin

-    Right2 := Left2 + w;

-    Bottom2 := Top2 + h;

-  end;

-  if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <=

-    Top2 ) then

-    exit;

-  if Left1 <= Left2 then

-  begin

-    // 1. left, 2. right

-    Scan1Start := Src_Rect1.x + Left2 - Left1;

-    Scan2Start := Src_Rect2.x;

-    ScanWidth := Right1 - Left2;

-    with Src_Rect2 do

-      if ScanWidth > w then

-        ScanWidth := w;

-  end

-  else

-  begin

-    // 1. right, 2. left

-    Scan1Start := Src_Rect1.x;

-    Scan2Start := Src_Rect2.x + Left1 - Left2;

-    ScanWidth := Right2 - Left1;

-    with Src_Rect1 do

-      if ScanWidth > w then

-        ScanWidth := w;

-  end;

-  with SrcSurface1^ do

-  begin

-    Pitch1 := Pitch;

-    Addr1 := cardinal( Pixels );

-    inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );

-    with format^ do

-    begin

-      BPP := BytesPerPixel;

-      TransparentColor1 := colorkey;

-    end;

-  end;

-  with SrcSurface2^ do

-  begin

-    TransparentColor2 := format.colorkey;

-    Pitch2 := Pitch;

-    Addr2 := cardinal( Pixels );

-    inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) );

-  end;

-  Mod1 := Pitch1 - ( ScanWidth * BPP );

-  Mod2 := Pitch2 - ( ScanWidth * BPP );

-  inc( Addr1, BPP * Scan1Start );

-  inc( Addr2, BPP * Scan2Start );

-  if Top1 <= Top2 then

-  begin

-    // 1. up, 2. down

-    ScanHeight := Bottom1 - Top2;

-    if ScanHeight > Src_Rect2.h then

-      ScanHeight := Src_Rect2.h;

-    inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );

-  end

-  else

-  begin

-    // 1. down, 2. up

-    ScanHeight := Bottom2 - Top1;

-    if ScanHeight > Src_Rect1.h then

-      ScanHeight := Src_Rect1.h;

-    inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) );

-  end;

-  case BPP of

-    1 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <>

-            TransparentColor2 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1 );

-          inc( Addr2 );

-        end;

-        inc( Addr1, Mod1 );

-        inc( Addr2, Mod2 );

-      end;

-    2 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <>

-            TransparentColor2 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 2 );

-          inc( Addr2, 2 );

-        end;

-        inc( Addr1, Mod1 );

-        inc( Addr2, Mod2 );

-      end;

-    3 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          Color1 := PLongWord( Addr1 )^ and $00FFFFFF;

-          Color2 := PLongWord( Addr2 )^ and $00FFFFFF;

-          if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 )

-            then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 3 );

-          inc( Addr2, 3 );

-        end;

-        inc( Addr1, Mod1 );

-        inc( Addr2, Mod2 );

-      end;

-    4 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <>

-            TransparentColor2 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 4 );

-          inc( Addr2, 4 );

-        end;

-        inc( Addr1, Mod1 );

-        inc( Addr2, Mod2 );

-      end;

-  end;

-end;

-

-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : cardinal; y : cardinal ) : Uint32;

-var

-  bpp : UInt32;

-  p : PInteger;

-begin

-  bpp := SrcSurface.format.BytesPerPixel;

-  // Here p is the address to the pixel we want to retrieve

-  p := Pointer( Uint32( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) *

-    bpp );

-  case bpp of

-    1 : result := PUint8( p )^;

-    2 : result := PUint16( p )^;

-    3 :

-      if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then

-        result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or

-          PUInt8Array( p )[ 2 ]

-      else

-        result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or

-          PUInt8Array( p )[ 2 ] shl 16;

-    4 : result := PUint32( p )^;

-  else

-    result := 0; // shouldn't happen, but avoids warnings

-  end;

-end;

-

-procedure SDL_PutPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :

-  cardinal );

-var

-  Addr, Pitch, BPP : cardinal;

-begin

-  Addr := cardinal( SrcSurface.Pixels );

-  Pitch := SrcSurface.Pitch;

-  BPP := SrcSurface.format.BytesPerPixel;

-  asm

-    mov eax, y

-    mul Pitch      // EAX := y * Pitch

-    add Addr, eax  // Addr:= Addr + (y * Pitch)

-    mov eax, x

-    mov ecx, Color

-    cmp BPP, 1

-    jne @Not1BPP

-    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x

-    mov [eax], cl

-    jmp @Quit

-   @Not1BPP:

-    cmp BPP, 2

-    jne @Not2BPP

-    mul BPP   // EAX := x * BPP

-    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * BPP

-    mov [eax], cx

-    jmp @Quit

-   @Not2BPP:

-    cmp BPP, 3

-    jne @Not3BPP

-    mul BPP   // EAX := x * BPP

-    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * BPP

-    mov edx, [eax]

-    and edx, $ff000000

-    or edx, ecx

-    mov [eax], edx

-    jmp @Quit

-   @Not3BPP:

-    mul BPP   // EAX := x * BPP

-    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * BPP

-    mov [eax], ecx

-   @Quit:

-  end;

-end;

-

-procedure SDL_AddPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :

-  cardinal );

-var

-  SrcColor, FinalColor : cardinal;

-  Addr, Pitch, Bits : cardinal;

-begin

-  if Color = 0 then

-    exit;

-  Addr := cardinal( SrcSurface.Pixels );

-  Pitch := SrcSurface.Pitch;

-  Bits := SrcSurface.format.BitsPerPixel;

-  asm

-    mov eax, y

-    mul Pitch      // EAX := y * Pitch

-    add Addr, eax  // Addr:= Addr + (y * Pitch)

-    mov eax, x

-    cmp Bits, 8

-    jne @Not8bit

-    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x

-    mov cl, [eax]

-    movzx ecx, cl

-    mov SrcColor, ecx

-    mov edx, Color

-    and ecx, 3

-    and edx, 3

-    add ecx, edx

-    cmp ecx, 3

-    jbe @Skip1_8bit

-    mov ecx, 3

-   @Skip1_8bit:

-    mov FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $1c

-    and edx, $1c

-    add ecx, edx

-    cmp ecx, $1c

-    jbe @Skip2_8bit

-    mov ecx, $1c

-   @Skip2_8bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $e0

-    and edx, $e0

-    add ecx, edx

-    cmp ecx, $e0

-    jbe @Skip3_8bit

-    mov ecx, $e0

-   @Skip3_8bit:

-    or ecx, FinalColor

-    mov [eax], cl

-    jmp @Quit

-   @Not8bit:

-    cmp Bits, 15

-    jne @Not15bit

-    shl eax, 1

-    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * 2

-    mov ecx, [eax]

-    and ecx, $00007fff

-    mov SrcColor, ecx

-    mov edx, Color

-    and ecx, $1f

-    and edx, $1f

-    add ecx, edx

-    cmp ecx, $1f

-    jbe @Skip1_15bit

-    mov ecx, $1f

-   @Skip1_15bit:

-    mov FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $03e0

-    and edx, $03e0

-    add ecx, edx

-    cmp ecx, $03e0

-    jbe @Skip2_15bit

-    mov ecx, $03e0

-   @Skip2_15bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $7c00

-    and edx, $7c00

-    add ecx, edx

-    cmp ecx, $7c00

-    jbe @Skip3_15bit

-    mov ecx, $7c00

-   @Skip3_15bit:

-    or ecx, FinalColor

-    mov [eax], cx

-    jmp @Quit

-   @Not15Bit:

-    cmp Bits, 16

-    jne @Not16bit

-    shl eax, 1

-    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * 2

-    mov ecx, [eax]

-    and ecx, $0000ffff

-    mov SrcColor, ecx

-    mov edx, Color

-    and ecx, $1f

-    and edx, $1f

-    add ecx, edx

-    cmp ecx, $1f

-    jbe @Skip1_16bit

-    mov ecx, $1f

-   @Skip1_16bit:

-    mov FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $07e0

-    and edx, $07e0

-    add ecx, edx

-    cmp ecx, $07e0

-    jbe @Skip2_16bit

-    mov ecx, $07e0

-   @Skip2_16bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $f800

-    and edx, $f800

-    add ecx, edx

-    cmp ecx, $f800

-    jbe @Skip3_16bit

-    mov ecx, $f800

-   @Skip3_16bit:

-    or ecx, FinalColor

-    mov [eax], cx

-    jmp @Quit

-   @Not16Bit:

-    cmp Bits, 24

-    jne @Not24bit

-    mov ecx, 0

-    add ecx, eax

-    shl ecx, 1

-    add ecx, eax

-    mov eax, ecx

-    jmp @32bit

-   @Not24bit:

-    shl eax, 2

-   @32bit:

-    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * 2

-    mov ecx, [eax]

-    mov FinalColor, ecx

-    and FinalColor, $ff000000

-    and ecx, $00ffffff

-    mov SrcColor, ecx

-    mov edx, Color

-    and ecx, $000000ff

-    and edx, $000000ff

-    add ecx, edx

-    cmp ecx, $000000ff

-    jbe @Skip1_32bit

-    mov ecx, $000000ff

-   @Skip1_32bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $0000ff00

-    and edx, $0000ff00

-    add ecx, edx

-    cmp ecx, $0000ff00

-    jbe @Skip2_32bit

-    mov ecx, $0000ff00

-   @Skip2_32bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $00ff0000

-    and edx, $00ff0000

-    add ecx, edx

-    cmp ecx, $00ff0000

-    jbe @Skip3_32bit

-    mov ecx, $00ff0000

-   @Skip3_32bit:

-    or ecx, FinalColor

-    mov [eax], ecx

-   @Quit:

-  end;

-end;

-

-procedure SDL_SubPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :

-  cardinal );

-var

-  SrcColor, FinalColor : cardinal;

-  Addr, Pitch, Bits : cardinal;

-begin

-  if Color = 0 then

-    exit;

-  Addr := cardinal( SrcSurface.Pixels );

-  Pitch := SrcSurface.Pitch;

-  Bits := SrcSurface.format.BitsPerPixel;

-  asm

-    mov eax, y

-    mul Pitch      // EAX := y * Pitch

-    add Addr, eax  // Addr:= Addr + (y * Pitch)

-    mov eax, x

-    cmp Bits, 8

-    jne @Not8bit

-    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x

-    mov cl, [eax]

-    movzx ecx, cl

-    mov SrcColor, ecx

-    mov edx, Color

-    and ecx, 3

-    and edx, 3

-    sub ecx, edx

-    jns @Skip1_8bit

-    mov ecx, 0

-   @Skip1_8bit:

-    mov FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $1c

-    and edx, $1c

-    sub ecx, edx

-    jns @Skip2_8bit

-    mov ecx, 0

-   @Skip2_8bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $e0

-    and edx, $e0

-    sub ecx, edx

-    jns @Skip3_8bit

-    mov ecx, 0

-   @Skip3_8bit:

-    or ecx, FinalColor

-    mov [eax], cl

-    jmp @Quit

-   @Not8bit:

-    cmp Bits, 15

-    jne @Not15bit

-    shl eax, 1

-    add eax, Addr

-    mov ecx, [eax]

-    and ecx, $00007fff

-    mov SrcColor, ecx

-    mov edx, Color

-    and ecx, $1f

-    and edx, $1f

-    sub ecx, edx

-    jns @Skip1_15bit

-    mov ecx, 0

-   @Skip1_15bit:

-    mov FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $03e0

-    and edx, $03e0

-    sub ecx, edx

-    jns @Skip2_15bit

-    mov ecx, 0

-   @Skip2_15bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $7c00

-    and edx, $7c00

-    sub ecx, edx

-    jns @Skip3_15bit

-    mov ecx, 0

-   @Skip3_15bit:

-    or ecx, FinalColor

-    mov [eax], cx

-    jmp @Quit

-   @Not15Bit:

-    cmp Bits, 16

-    jne @Not16bit

-    shl eax, 1

-    add eax, Addr

-    mov ecx, [eax]

-    and ecx, $0000ffff

-    mov SrcColor, ecx

-    mov edx, Color

-    and ecx, $1f

-    and edx, $1f

-    sub ecx, edx

-    jns @Skip1_16bit

-    mov ecx, 0

-   @Skip1_16bit:

-    mov FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $07e0

-    and edx, $07e0

-    sub ecx, edx

-    jns @Skip2_16bit

-    mov ecx, 0

-   @Skip2_16bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $f800

-    and edx, $f800

-    sub ecx, edx

-    jns @Skip3_16bit

-    mov ecx, 0

-   @Skip3_16bit:

-    or ecx, FinalColor

-    mov [eax], cx

-    jmp @Quit

-   @Not16Bit:

-    cmp Bits, 24

-    jne @Not24bit

-    mov ecx, 0

-    add ecx, eax

-    shl ecx, 1

-    add ecx, eax

-    mov eax, ecx

-    jmp @32bit

-   @Not24bit:

-    shl eax, 2

-   @32bit:

-    add eax, Addr

-    mov ecx, [eax]

-    mov FinalColor, ecx

-    and FinalColor, $ff000000

-    and ecx, $00ffffff

-    mov SrcColor, ecx

-    mov edx, Color

-    and ecx, $000000ff

-    and edx, $000000ff

-    sub ecx, edx

-    jns @Skip1_32bit

-    mov ecx, 0

-   @Skip1_32bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $0000ff00

-    and edx, $0000ff00

-    sub ecx, edx

-    jns @Skip2_32bit

-    mov ecx, 0

-   @Skip2_32bit:

-    or FinalColor, ecx

-    mov ecx, SrcColor

-    mov edx, Color

-    and ecx, $00ff0000

-    and edx, $00ff0000

-    sub ecx, edx

-    jns @Skip3_32bit

-    mov ecx, 0

-   @Skip3_32bit:

-    or ecx, FinalColor

-    mov [eax], ecx

-   @Quit:

-  end;

-end;

-

-// Draw a line between x1,y1 and x2,y2 to the given surface

-// NOTE: The surface must be locked before calling this!

-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-var

-  dx, dy, sdx, sdy, x, y, px, py : integer;

-begin

-  dx := x2 - x1;

-  dy := y2 - y1;

-  if dx < 0 then

-    sdx := -1

-  else

-    sdx := 1;

-  if dy < 0 then

-    sdy := -1

-  else

-    sdy := 1;

-  dx := sdx * dx + 1;

-  dy := sdy * dy + 1;

-  x := 0;

-  y := 0;

-  px := x1;

-  py := y1;

-  if dx >= dy then

-  begin

-    for x := 0 to dx - 1 do

-    begin

-      SDL_PutPixel( DstSurface, px, py, Color );

-      y := y + dy;

-      if y >= dx then

-      begin

-        y := y - dx;

-        py := py + sdy;

-      end;

-      px := px + sdx;

-    end;

-  end

-  else

-  begin

-    for y := 0 to dy - 1 do

-    begin

-      SDL_PutPixel( DstSurface, px, py, Color );

-      x := x + dx;

-      if x >= dy then

-      begin

-        x := x - dy;

-        px := px + sdx;

-      end;

-      py := py + sdy;

-    end;

-  end;

-end;

-

-// Draw a dashed line between x1,y1 and x2,y2 to the given surface

-// NOTE: The surface must be locked before calling this!

-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal ; DashLength, DashSpace : byte );  overload;

-var

-  dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean;

-begin

-  counter := 0;

-  drawdash := true; //begin line drawing with dash

-

-  //Avoid invalid user-passed dash parameters

-  if (DashLength < 1)

-  then DashLength := 1;

-  if (DashSpace < 1)

-  then DashSpace := 0;

-

-  dx := x2 - x1;

-  dy := y2 - y1;

-  if dx < 0 then

-    sdx := -1

-  else

-    sdx := 1;

-  if dy < 0 then

-    sdy := -1

-  else

-    sdy := 1;

-  dx := sdx * dx + 1;

-  dy := sdy * dy + 1;

-  x := 0;

-  y := 0;

-  px := x1;

-  py := y1;

-  if dx >= dy then

-  begin

-    for x := 0 to dx - 1 do

-      begin

-

-      //Alternate drawing dashes, or leaving spaces

-      if drawdash then

-        begin

-          SDL_PutPixel( DstSurface, px, py, Color );

-          inc(counter);

-          if (counter > DashLength-1) and (DashSpace > 0) then

-            begin

-              drawdash := false;

-              counter := 0;

-            end;

-        end

-      else //space

-        begin

-          inc(counter);

-          if counter > DashSpace-1 then

-            begin

-              drawdash := true;

-              counter := 0;

-            end;

-        end;

-

-      y := y + dy;

-      if y >= dx then

-      begin

-        y := y - dx;

-        py := py + sdy;

-      end;

-      px := px + sdx;

-    end;

-  end

-  else

-  begin

-    for y := 0 to dy - 1 do

-    begin

-

-      //Alternate drawing dashes, or leaving spaces

-      if drawdash then

-        begin

-          SDL_PutPixel( DstSurface, px, py, Color );

-          inc(counter);

-          if (counter > DashLength-1) and (DashSpace > 0) then

-            begin

-              drawdash := false;

-              counter := 0;

-            end;

-        end

-      else //space

-        begin

-          inc(counter);

-          if counter > DashSpace-1 then

-            begin

-              drawdash := true;

-              counter := 0;

-            end;

-        end;

-

-      x := x + dx;

-      if x >= dy then

-      begin

-        x := x - dy;

-        px := px + sdx;

-      end;

-      py := py + sdy;

-    end;

-  end;

-end;

-

-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-var

-  dx, dy, sdx, sdy, x, y, px, py : integer;

-begin

-  dx := x2 - x1;

-  dy := y2 - y1;

-  if dx < 0 then

-    sdx := -1

-  else

-    sdx := 1;

-  if dy < 0 then

-    sdy := -1

-  else

-    sdy := 1;

-  dx := sdx * dx + 1;

-  dy := sdy * dy + 1;

-  x := 0;

-  y := 0;

-  px := x1;

-  py := y1;

-  if dx >= dy then

-  begin

-    for x := 0 to dx - 1 do

-    begin

-      SDL_AddPixel( DstSurface, px, py, Color );

-      y := y + dy;

-      if y >= dx then

-      begin

-        y := y - dx;

-        py := py + sdy;

-      end;

-      px := px + sdx;

-    end;

-  end

-  else

-  begin

-    for y := 0 to dy - 1 do

-    begin

-      SDL_AddPixel( DstSurface, px, py, Color );

-      x := x + dx;

-      if x >= dy then

-      begin

-        x := x - dy;

-        px := px + sdx;

-      end;

-      py := py + sdy;

-    end;

-  end;

-end;

-

-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-var

-  dx, dy, sdx, sdy, x, y, px, py : integer;

-begin

-  dx := x2 - x1;

-  dy := y2 - y1;

-  if dx < 0 then

-    sdx := -1

-  else

-    sdx := 1;

-  if dy < 0 then

-    sdy := -1

-  else

-    sdy := 1;

-  dx := sdx * dx + 1;

-  dy := sdy * dy + 1;

-  x := 0;

-  y := 0;

-  px := x1;

-  py := y1;

-  if dx >= dy then

-  begin

-    for x := 0 to dx - 1 do

-    begin

-      SDL_SubPixel( DstSurface, px, py, Color );

-      y := y + dy;

-      if y >= dx then

-      begin

-        y := y - dx;

-        py := py + sdy;

-      end;

-      px := px + sdx;

-    end;

-  end

-  else

-  begin

-    for y := 0 to dy - 1 do

-    begin

-      SDL_SubPixel( DstSurface, px, py, Color );

-      x := x + dx;

-      if x >= dy then

-      begin

-        x := x - dy;

-        px := px + sdx;

-      end;

-      py := py + sdy;

-    end;

-  end;

-end;

-

-// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces.

-// In 8 bit color depth mode the procedure works with the default packed

-//  palette (RRRGGGBB). It handles all clipping.

-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DstSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  Src, Dest : TSDL_Rect;

-  Diff : integer;

-  SrcAddr, DestAddr : cardinal;

-  // TransparentColor: cardinal;

-  _ebx, _esi, _edi, _esp : cardinal;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DstSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DstSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    //    TransparentColor := format.ColorKey;

-  end;

-  with DstSurface^ do

-  begin

-    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DstSurface );

-  case bits of

-    8 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        cmp al, 0

-        je @SkipColor         // if AL=0 or AL=transparent color then skip everything

-        mov esp, eax          // ESP - source color

-        mov bl, [edi]         // BL := destination color

-        mov dl, bl            // DL := destination color

-        and ax, $03           // Adding BLUE

-        and bl, $03

-        add al, bl

-        cmp al, $03

-        jbe @Skip1

-        mov al, $03

-       @Skip1:

-        mov cl, al

-        mov eax, esp          // Adding GREEN

-        mov bl, dl

-        and al, $1c

-        and bl, $1c

-        add al, bl

-        cmp al, $1c

-        jbe @Skip2

-        mov al, $1c

-       @Skip2:

-        or cl, al

-        mov eax, esp          // Adding RED

-        mov bl, dl

-        and ax, $e0

-        and bx, $e0

-        add ax, bx

-        cmp ax, $e0

-        jbe @Skip3

-        mov al, $e0

-       @Skip3:

-        or cl, al

-        mov [edi], cl

-       @SkipColor:

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    15 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax          // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AX := source color

-        cmp ax, 0

-        je @SkipColor         // if AX=0 then skip everything

-        mov esp, eax          // ESP - source color

-        mov bx, [edi]         // BX := destination color

-        mov dx, bx            // DX := destination color

-        and ax, $001F         // Adding BLUE

-        and bx, $001F

-        add ax, bx

-        cmp ax, $001F

-        jbe @Skip1

-        mov ax, $001F

-       @Skip1:

-        mov cx, ax

-        mov eax, esp          // Adding GREEN

-        mov bx, dx

-        and ax, $3E0

-        and bx, $3E0

-        add ax, bx

-        cmp ax, $3E0

-        jbe @Skip2

-        mov ax, $3E0

-       @Skip2:

-        or cx, ax

-        mov eax, esp          // Adding RED

-        mov bx, dx

-        and ax, $7C00

-        and bx, $7C00

-        add ax, bx

-        cmp ax, $7C00

-        jbe @Skip3

-        mov ax, $7C00

-       @Skip3:

-        or cx, ax

-        mov [edi], cx

-       @SkipColor:

-        add esi, 2

-        add edi, 2

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    16 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AX := source color

-        cmp ax, 0

-        je @SkipColor         // if AX=0 then skip everything

-        mov esp, eax          // ESP - source color

-        mov bx, [edi]         // BX := destination color

-        mov dx, bx            // DX := destination color

-        and ax, $1F           // Adding BLUE

-        and bx, $1F

-        add ax, bx

-        cmp ax, $1F

-        jbe @Skip1

-        mov ax, $1F

-       @Skip1:

-        mov cx, ax

-        mov eax, esp          // Adding GREEN

-        mov bx, dx

-        and ax, $7E0

-        and bx, $7E0

-        add ax, bx

-        cmp ax, $7E0

-        jbe @Skip2

-        mov ax, $7E0

-       @Skip2:

-        or cx, ax

-        mov eax, esp          // Adding RED

-        mov bx, dx

-        and eax, $F800

-        and ebx, $F800

-        add eax, ebx

-        cmp eax, $F800

-        jbe @Skip3

-        mov ax, $F800

-       @Skip3:

-        or cx, ax

-        mov [edi], cx

-       @SkipColor:

-        add esi, 2

-        add edi, 2

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    24 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       add WorkX, ax         // WorkX := Src.w * 2

-       add WorkX, ax         // WorkX := Src.w * 3

-       @Loopx:

-        mov bl, [edi]         // BX := destination color

-        mov al, [esi]         // AX := source color

-        cmp al, 0

-        je @Skip              // if AL=0 then skip COMPONENT

-        mov ah, 0             // AX := COLOR COMPONENT

-        mov bh, 0

-        add bx, ax

-        cmp bx, $00ff

-        jb @Skip

-        mov bl, $ff

-       @Skip:

-        mov [edi], bl

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    32 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       shl ax, 2

-       mov WorkX, ax         // WorkX := Src.w * 4

-       @Loopx:

-        mov bl, [edi]         // BX := destination color

-        mov al, [esi]         // AX := source color

-        cmp al, 0

-        je @Skip              // if AL=0 then skip COMPONENT

-        mov ah, 0             // AX := COLOR COMPONENT

-        mov bh, 0

-        add bx, ax

-        cmp bx, $00ff

-        jb @Skip

-        mov bl, $ff

-       @Skip:

-        mov [edi], bl

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DstSurface );

-end;

-

-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DstSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  Src, Dest : TSDL_Rect;

-  Diff : integer;

-  SrcAddr, DestAddr : cardinal;

-  _ebx, _esi, _edi, _esp : cardinal;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DstSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DstSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-  end;

-  with DstSurface^ do

-  begin

-    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := DstSurface.Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DstSurface );

-  case bits of

-    8 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        cmp al, 0

-        je @SkipColor         // if AL=0 then skip everything

-        mov esp, eax          // ESP - source color

-        mov bl, [edi]         // BL := destination color

-        mov dl, bl            // DL := destination color

-        and al, $03           // Subtract BLUE

-        and bl, $03

-        sub bl, al

-        jns @Skip1

-        mov bl, 0

-       @Skip1:

-        mov cl, bl

-        mov eax, esp          // Subtract GREEN

-        mov bl, dl

-        and al, $1c

-        and bl, $1c

-        sub bl, al

-        jns @Skip2

-        mov bl, 0

-       @Skip2:

-        or cl, bl

-        mov eax, esp          // Subtract RED

-        mov bl, dl

-        and ax, $e0

-        and bx, $e0

-        sub bx, ax

-        jns @Skip3

-        mov bl, 0

-       @Skip3:

-        or cl, bl

-        mov [edi], cl

-       @SkipColor:

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    15 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax          // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AX := source color

-        cmp ax, 0

-        je @SkipColor         // if AX=0 then skip everything

-        mov esp, eax          // ESP - source color

-        mov bx, [edi]         // BX := destination color

-        mov dx, bx            // DX := destination color

-        and ax, $001F         // Subtract BLUE

-        and bx, $001F

-        sub bx, ax

-        jns @Skip1

-        mov bx, 0

-       @Skip1:

-        mov cx, bx

-        mov eax, esp          // Subtract GREEN

-        mov bx, dx

-        and ax, $3E0

-        and bx, $3E0

-        sub bx, ax

-        jns @Skip2

-        mov bx, 0

-       @Skip2:

-        or cx, bx

-        mov eax, esp          // Subtract RED

-        mov bx, dx

-        and ax, $7C00

-        and bx, $7C00

-        sub bx, ax

-        jns @Skip3

-        mov bx, 0

-       @Skip3:

-        or cx, bx

-        mov [edi], cx

-       @SkipColor:

-        add esi, 2

-        add edi, 2

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    16 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AX := source color

-        cmp ax, 0

-        je @SkipColor         // if AX=0 then skip everything

-        mov esp, eax          // ESP - source color

-        mov bx, [edi]         // BX := destination color

-        mov dx, bx            // DX := destination color

-        and ax, $1F           // Subtracting BLUE

-        and bx, $1F

-        sub bx, ax

-        jns @Skip1

-        mov bx, 0

-       @Skip1:

-        mov cx, bx

-        mov eax, esp          // Adding GREEN

-        mov bx, dx

-        and ax, $7E0

-        and bx, $7E0

-        sub bx, ax

-        jns @Skip2

-        mov bx, 0

-       @Skip2:

-        or cx, bx

-        mov eax, esp          // Adding RED

-        mov bx, dx

-        and eax, $F800

-        and ebx, $F800

-        sub ebx, eax

-        jns @Skip3

-        mov bx, 0

-       @Skip3:

-        or cx, bx

-        mov [edi], cx

-       @SkipColor:

-        add esi, 2

-        add edi, 2

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    24 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       add WorkX, ax         // WorkX := Src.w * 2

-       add WorkX, ax         // WorkX := Src.w * 3

-       @Loopx:

-        mov bl, [edi]         // BX := destination color

-        mov al, [esi]         // AX := source color

-        cmp al, 0

-        je @Skip              // if AL=0 then skip COMPONENT

-        mov ah, 0             // AX := COLOR COMPONENT

-        mov bh, 0

-        sub bx, ax

-        jns @Skip

-        mov bl, 0

-       @Skip:

-        mov [edi], bl

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    32 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       shl ax, 2

-       mov WorkX, ax         // WorkX := Src.w * 4

-       @Loopx:

-        mov bl, [edi]         // BX := destination color

-        mov al, [esi]         // AX := source color

-        cmp al, 0

-        je @Skip              // if AL=0 then skip COMPONENT

-        mov ah, 0             // AX := COLOR COMPONENT

-        mov bh, 0

-        sub bx, ax

-        jns @Skip

-        mov bl, 0

-       @Skip:

-        mov [edi], bl

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DstSurface );

-end;

-

-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );

-var

-  Src, Dest : TSDL_Rect;

-  Diff : integer;

-  SrcAddr, DestAddr : cardinal;

-  _ebx, _esi, _edi, _esp : cardinal;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  SrcTransparentColor : cardinal;

-  Bits : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DstSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DstSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    SrcTransparentColor := format.colorkey;

-  end;

-  with DstSurface^ do

-  begin

-    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := DstSurface.Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DstSurface );

-  case bits of

-    8 :

-      asm

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      mov ecx, Color

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        movzx eax, al

-        cmp eax, SrcTransparentColor

-        je @SkipColor         // if AL=Transparent color then skip everything

-        mov [edi], cl

-       @SkipColor:

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      end;

-    15, 16 :

-      asm

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      mov ecx, Color

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AX := source color

-        movzx eax, ax

-        cmp eax, SrcTransparentColor

-        je @SkipColor         // if AX=Transparent color then skip everything

-        mov [edi], cx

-       @SkipColor:

-        inc esi

-        inc esi

-        inc edi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      end;

-    24 :

-      asm

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov _ebx, ebx

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      mov ecx, Color

-      and ecx, $00ffffff

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov eax, [esi]         // EAX := source color

-        and eax, $00ffffff

-        cmp eax, SrcTransparentColor

-        je @SkipColor         // if EAX=Transparent color then skip everything

-        mov ebx, [edi]

-        and ebx, $ff000000

-        or ebx, ecx

-        mov [edi], ecx

-       @SkipColor:

-        add esi, 3

-        add edi, 3

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp, _esp

-      mov edi, _edi

-      mov esi, _esi

-      mov ebx, _ebx

-      end;

-    32 :

-      asm

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      mov ecx, Color

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov eax, [esi]         // EAX := source color

-        cmp eax, SrcTransparentColor

-        je @SkipColor         // if EAX=Transparent color then skip everything

-        mov [edi], ecx

-       @SkipColor:

-        add esi, 4

-        add edi, 4

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp, _esp

-      mov edi, _edi

-      mov esi, _esi

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DstSurface );

-end;

-// TextureRect.w and TextureRect.h are not used.

-// The TextureSurface's size MUST larger than the drawing rectangle!!!

-

-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;

-  TextureRect : PSDL_Rect );

-var

-  Src, Dest : TSDL_Rect;

-  Diff : integer;

-  SrcAddr, DestAddr, TextAddr : cardinal;

-  _ebx, _esi, _edi, _esp : cardinal;

-  WorkX, WorkY : word;

-  SrcMod, DestMod, TextMod : cardinal;

-  SrcTransparentColor : cardinal;

-  Bits : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DstSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DstSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    SrcTransparentColor := format.colorkey;

-  end;

-  with DstSurface^ do

-  begin

-    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := DstSurface.Format.BitsPerPixel;

-  end;

-  with Texture^ do

-  begin

-    TextAddr := cardinal( Pixels ) + UInt32( TextureRect.y ) * Pitch +

-      UInt32( TextureRect.x ) * Format.BytesPerPixel;

-    TextMod := Pitch - Src.w * Format.BytesPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DstSurface );

-  SDL_LockSurface( Texture );

-  case bits of

-    8 :

-      asm

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov _ebx, ebx

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ebx, TextAddr

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        movzx eax, al

-        cmp eax, SrcTransparentColor

-        je @SkipColor         // if AL=Transparent color then skip everything

-        mov al, [ebx]

-        mov [edi], al

-       @SkipColor:

-        inc esi

-        inc edi

-        inc ebx

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       add ebx, TextMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx, _ebx

-      end;

-    15, 16 :

-      asm

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ecx, TextAddr

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AL := source color

-        movzx eax, ax

-        cmp eax, SrcTransparentColor

-        je @SkipColor         // if AL=Transparent color then skip everything

-        mov ax, [ecx]

-        mov [edi], ax

-       @SkipColor:

-        inc esi

-        inc esi

-        inc edi

-        inc edi

-        inc ecx

-        inc ecx

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       add ecx, TextMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      end;

-    24 :

-      asm

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov _ebx, ebx

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ebx, TextAddr

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov eax, [esi]         // AL := source color

-        and eax, $00ffffff

-        cmp eax, SrcTransparentColor

-        je @SkipColor         // if AL=Transparent color then skip everything

-        mov eax, [ebx]

-        and eax, $00ffffff

-        mov ecx, [edi]

-        and ecx, $ff000000

-        or ecx, eax

-        mov [edi], eax

-       @SkipColor:

-        add esi, 3

-        add edi, 3

-        add ebx, 3

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       add ebx, TextMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx, _ebx

-      end;

-    32 :

-      asm

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ecx, TextAddr

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov eax, [esi]         // AL := source color

-        cmp eax, SrcTransparentColor

-        je @SkipColor         // if AL=Transparent color then skip everything

-        mov eax, [ecx]

-        mov [edi], eax

-       @SkipColor:

-        add esi, 4

-        add edi, 4

-        add ecx, 4

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       add ecx, TextMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DstSurface );

-  SDL_UnlockSurface( Texture );

-end;

-

-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );

-var

-  xc, yc : cardinal;

-  rx, wx, ry, wy, ry16 : cardinal;

-  color : cardinal;

-  modx, mody : cardinal;

-begin

-  // Warning! No checks for surface pointers!!!

-  if srcrect = nil then

-    srcrect := @SrcSurface.clip_rect;

-  if dstrect = nil then

-    dstrect := @DstSurface.clip_rect;

-  if SDL_MustLock( SrcSurface ) then

-    SDL_LockSurface( SrcSurface );

-  if SDL_MustLock( DstSurface ) then

-    SDL_LockSurface( DstSurface );

-  modx := trunc( ( srcrect.w / dstrect.w ) * 65536 );

-  mody := trunc( ( srcrect.h / dstrect.h ) * 65536 );

-  //rx := srcrect.x * 65536;

-  ry := srcrect.y * 65536;

-  wy := dstrect.y;

-  for yc := 0 to dstrect.h - 1 do

-  begin

-    rx := srcrect.x * 65536;

-    wx := dstrect.x;

-    ry16 := ry shr 16;

-    for xc := 0 to dstrect.w - 1 do

-    begin

-      color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 );

-      SDL_PutPixel( DstSurface, wx, wy, color );

-      rx := rx + modx;

-      inc( wx );

-    end;

-    ry := ry + mody;

-    inc( wy );

-  end;

-  if SDL_MustLock( SrcSurface ) then

-    SDL_UnlockSurface( SrcSurface );

-  if SDL_MustLock( DstSurface ) then

-    SDL_UnlockSurface( DstSurface );

-end;

-// Re-map a rectangular area into an area defined by four vertices

-// Converted from C to Pascal by KiCHY

-

-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );

-const

-  SHIFTS = 15; // Extend ints to limit round-off error (try 2 - 20)

-  THRESH = 1 shl SHIFTS; // Threshold for pixel size value

-  procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal );

-  var

-    tm, lm, rm, bm, m : TPoint;

-    mx, my : cardinal;

-    cr : cardinal;

-  begin

-    // Does the destination area specify a single pixel?

-    if ( ( abs( ul.x - ur.x ) < THRESH ) and

-      ( abs( ul.x - lr.x ) < THRESH ) and

-      ( abs( ul.x - ll.x ) < THRESH ) and

-      ( abs( ul.y - ur.y ) < THRESH ) and

-      ( abs( ul.y - lr.y ) < THRESH ) and

-      ( abs( ul.y - ll.y ) < THRESH ) ) then

-    begin // Yes

-      cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) );

-      SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr );

-    end

-    else

-    begin // No

-      // Quarter the source and the destination, and then recurse

-      tm.x := ( ul.x + ur.x ) shr 1;

-      tm.y := ( ul.y + ur.y ) shr 1;

-      bm.x := ( ll.x + lr.x ) shr 1;

-      bm.y := ( ll.y + lr.y ) shr 1;

-      lm.x := ( ul.x + ll.x ) shr 1;

-      lm.y := ( ul.y + ll.y ) shr 1;

-      rm.x := ( ur.x + lr.x ) shr 1;

-      rm.y := ( ur.y + lr.y ) shr 1;

-      m.x := ( tm.x + bm.x ) shr 1;

-      m.y := ( tm.y + bm.y ) shr 1;

-      mx := ( x1 + x2 ) shr 1;

-      my := ( y1 + y2 ) shr 1;

-      CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my );

-      CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my );

-      CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 );

-      CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 );

-    end;

-  end;

-var

-  _UL, _UR, _LR, _LL : TPoint;

-  Rect_x, Rect_y, Rect_w, Rect_h : integer;

-begin

-  if SDL_MustLock( SrcSurface ) then

-    SDL_LockSurface( SrcSurface );

-  if SDL_MustLock( DstSurface ) then

-    SDL_LockSurface( DstSurface );

-  if SrcRect = nil then

-  begin

-    Rect_x := 0;

-    Rect_y := 0;

-    Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS;

-    Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS;

-  end

-  else

-  begin

-    Rect_x := SrcRect.x;

-    Rect_y := SrcRect.y;

-    Rect_w := ( SrcRect.w - 1 ) shl SHIFTS;

-    Rect_h := ( SrcRect.h - 1 ) shl SHIFTS;

-  end;

-  // Shift all values to help reduce round-off error.

-  _ul.x := ul.x shl SHIFTS;

-  _ul.y := ul.y shl SHIFTS;

-  _ur.x := ur.x shl SHIFTS;

-  _ur.y := ur.y shl SHIFTS;

-  _lr.x := lr.x shl SHIFTS;

-  _lr.y := lr.y shl SHIFTS;

-  _ll.x := ll.x shl SHIFTS;

-  _ll.y := ll.y shl SHIFTS;

-  CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h );

-  if SDL_MustLock( SrcSurface ) then

-    SDL_UnlockSurface( SrcSurface );

-  if SDL_MustLock( DstSurface ) then

-    SDL_UnlockSurface( DstSurface );

-end;

-

-// flips a rectangle vertically on given surface

-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );

-var

-  TmpRect : TSDL_Rect;

-  Locked : boolean;

-  y, FlipLength, RowLength : integer;

-  Row1, Row2 : Pointer;

-  OneRow : TByteArray; // Optimize it if you wish

-begin

-  if DstSurface <> nil then

-  begin

-    if Rect = nil then

-    begin // if Rect=nil then we flip the whole surface

-      TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );

-      Rect := @TmpRect;

-    end;

-    FlipLength := Rect^.h shr 1 - 1;

-    RowLength := Rect^.w * DstSurface^.format.BytesPerPixel;

-    if SDL_MustLock( DstSurface ) then

-    begin

-      Locked := true;

-      SDL_LockSurface( DstSurface );

-    end

-    else

-      Locked := false;

-    Row1 := pointer( cardinal( DstSurface^.Pixels ) + UInt32( Rect^.y ) *

-      DstSurface^.Pitch );

-    Row2 := pointer( cardinal( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 )

-      * DstSurface^.Pitch );

-    for y := 0 to FlipLength do

-    begin

-      Move( Row1^, OneRow, RowLength );

-      Move( Row2^, Row1^, RowLength );

-      Move( OneRow, Row2^, RowLength );

-      inc( cardinal( Row1 ), DstSurface^.Pitch );

-      dec( cardinal( Row2 ), DstSurface^.Pitch );

-    end;

-    if Locked then

-      SDL_UnlockSurface( DstSurface );

-  end;

-end;

-

-// flips a rectangle horizontally on given surface

-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );

-type

-  T24bit = packed array[ 0..2 ] of byte;

-  T24bitArray = packed array[ 0..8191 ] of T24bit;

-  P24bitArray = ^T24bitArray;

-  TLongWordArray = array[ 0..8191 ] of LongWord;

-  PLongWordArray = ^TLongWordArray;

-var

-  TmpRect : TSDL_Rect;

-  Row8bit : PByteArray;

-  Row16bit : PWordArray;

-  Row24bit : P24bitArray;

-  Row32bit : PLongWordArray;

-  y, x, RightSide, FlipLength : integer;

-  Pixel : cardinal;

-  Pixel24 : T24bit;

-  Locked : boolean;

-begin

-  if DstSurface <> nil then

-  begin

-    if Rect = nil then

-    begin

-      TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );

-      Rect := @TmpRect;

-    end;

-    FlipLength := Rect^.w shr 1 - 1;

-    if SDL_MustLock( DstSurface ) then

-    begin

-      Locked := true;

-      SDL_LockSurface( DstSurface );

-    end

-    else

-      Locked := false;

-    case DstSurface^.format.BytesPerPixel of

-      1 :

-        begin

-          Row8Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *

-            DstSurface^.pitch );

-          for y := 1 to Rect^.h do

-          begin

-            RightSide := Rect^.w - 1;

-            for x := 0 to FlipLength do

-            begin

-              Pixel := Row8Bit^[ x ];

-              Row8Bit^[ x ] := Row8Bit^[ RightSide ];

-              Row8Bit^[ RightSide ] := Pixel;

-              dec( RightSide );

-            end;

-            inc( cardinal( Row8Bit ), DstSurface^.pitch );

-          end;

-        end;

-      2 :

-        begin

-          Row16Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *

-            DstSurface^.pitch );

-          for y := 1 to Rect^.h do

-          begin

-            RightSide := Rect^.w - 1;

-            for x := 0 to FlipLength do

-            begin

-              Pixel := Row16Bit^[ x ];

-              Row16Bit^[ x ] := Row16Bit^[ RightSide ];

-              Row16Bit^[ RightSide ] := Pixel;

-              dec( RightSide );

-            end;

-            inc( cardinal( Row16Bit ), DstSurface^.pitch );

-          end;

-        end;

-      3 :

-        begin

-          Row24Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *

-            DstSurface^.pitch );

-          for y := 1 to Rect^.h do

-          begin

-            RightSide := Rect^.w - 1;

-            for x := 0 to FlipLength do

-            begin

-              Pixel24 := Row24Bit^[ x ];

-              Row24Bit^[ x ] := Row24Bit^[ RightSide ];

-              Row24Bit^[ RightSide ] := Pixel24;

-              dec( RightSide );

-            end;

-            inc( cardinal( Row24Bit ), DstSurface^.pitch );

-          end;

-        end;

-      4 :

-        begin

-          Row32Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *

-            DstSurface^.pitch );

-          for y := 1 to Rect^.h do

-          begin

-            RightSide := Rect^.w - 1;

-            for x := 0 to FlipLength do

-            begin

-              Pixel := Row32Bit^[ x ];

-              Row32Bit^[ x ] := Row32Bit^[ RightSide ];

-              Row32Bit^[ RightSide ] := Pixel;

-              dec( RightSide );

-            end;

-            inc( cardinal( Row32Bit ), DstSurface^.pitch );

-          end;

-        end;

-    end;

-    if Locked then

-      SDL_UnlockSurface( DstSurface );

-  end;

-end;

-

-// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer.

-// But you MUST free it after you don't need it anymore!!!

-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;

-var

-  Rect : PSDL_Rect;

-begin

-  New( Rect );

-  with Rect^ do

-  begin

-    x := aLeft;

-    y := aTop;

-    w := aWidth;

-    h := aHeight;

-  end;

-  Result := Rect;

-end;

-

-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect;

-begin

-  with result do

-  begin

-    x := aLeft;

-    y := aTop;

-    w := aWidth;

-    h := aHeight;

-  end;

-end;

-

-function SDLRect( aRect : TRect ) : TSDL_Rect;

-begin

-  with aRect do

-    result := SDLRect( Left, Top, Right - Left, Bottom - Top );

-end;

-

-procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw,

-  depth : integer );

-var

-  dx, dy, e, d, dx2 : integer;

-  src_pitch, dst_pitch : uint16;

-  src_pixels, dst_pixels : PUint8;

-begin

-  if ( yw >= dst_surface^.h ) then

-    exit;

-  dx := ( x2 - x1 );

-  dy := ( y2 - y1 );

-  dy := dy shl 1;

-  e := dy - dx;

-  dx2 := dx shl 1;

-  src_pitch := Surface^.pitch;

-  dst_pitch := dst_surface^.pitch;

-  src_pixels := PUint8( integer( Surface^.pixels ) + yr * src_pitch + y1 * depth );

-  dst_pixels := PUint8( integer( dst_surface^.pixels ) + yw * dst_pitch + x1 *

-    depth );

-  for d := 0 to dx - 1 do

-  begin

-    move( src_pixels^, dst_pixels^, depth );

-    while ( e >= 0 ) do

-    begin

-      inc( src_pixels, depth );

-      e := e - dx2;

-    end;

-    inc( dst_pixels, depth );

-    e := e + dy;

-  end;

-end;

-

-function sign( x : integer ) : integer;

-begin

-  if x > 0 then

-    result := 1

-  else

-    result := -1;

-end;

-

-// Stretches a part of a surface

-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,

-  Width, Height : integer ) : PSDL_Surface;

-var

-  dst_surface : PSDL_Surface;

-  dx, dy, e, d, dx2, srcx2, srcy2 : integer;

-  destx1, desty1 : integer;

-begin

-  srcx2 := srcx1 + SrcW;

-  srcy2 := srcy1 + SrcH;

-  result := nil;

-  destx1 := 0;

-  desty1 := 0;

-  dx := abs( integer( Height - desty1 ) );

-  dy := abs( integer( SrcY2 - SrcY1 ) );

-  e := ( dy shl 1 ) - dx;

-  dx2 := dx shl 1;

-  dy := dy shl 1;

-  dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height -

-      desty1,

-      SrcSurface^.Format^.BitsPerPixel,

-      SrcSurface^.Format^.RMask,

-      SrcSurface^.Format^.GMask,

-      SrcSurface^.Format^.BMask,

-      SrcSurface^.Format^.AMask );

-  if ( dst_surface^.format^.BytesPerPixel = 1 ) then

-    SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 );

-  SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey );

-  if ( SDL_MustLock( dst_surface ) ) then

-    if ( SDL_LockSurface( dst_surface ) < 0 ) then

-      exit;

-  for d := 0 to dx - 1 do

-  begin

-    SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1,

-      SrcSurface^.format^.BytesPerPixel );

-    while e >= 0 do

-    begin

-      inc( SrcY1 );

-      e := e - dx2;

-    end;

-    inc( desty1 );

-    e := e + dy;

-  end;

-  if SDL_MUSTLOCK( dst_surface ) then

-    SDL_UnlockSurface( dst_surface );

-  result := dst_surface;

-end;

-

-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );

-var

-  r1, r2 : TSDL_Rect;

-  //buffer: PSDL_Surface;

-  YPos : Integer;

-begin

-  if ( DstSurface <> nil ) and ( DifY <> 0 ) then

-  begin

-    //if DifY > 0 then // going up

-    //begin

-    ypos := 0;

-    r1.x := 0;

-    r2.x := 0;

-    r1.w := DstSurface.w;

-    r2.w := DstSurface.w;

-    r1.h := DifY;

-    r2.h := DifY;

-    while ypos < DstSurface.h do

-    begin

-      r1.y := ypos;

-      r2.y := ypos + DifY;

-      SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 );

-      ypos := ypos + DifY;

-    end;

-    //end

-    //else

-    //begin // Going Down

-    //end;

-  end;

-end;

-

-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );

-var

-  r1, r2 : TSDL_Rect;

-  buffer : PSDL_Surface;

-begin

-  if ( DstSurface <> nil ) and ( DifX <> 0 ) then

-  begin

-    buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2,

-      DstSurface^.h * 2,

-      DstSurface^.Format^.BitsPerPixel,

-      DstSurface^.Format^.RMask,

-      DstSurface^.Format^.GMask,

-      DstSurface^.Format^.BMask,

-      DstSurface^.Format^.AMask );

-    if buffer <> nil then

-    begin

-      if ( buffer^.format^.BytesPerPixel = 1 ) then

-        SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 );

-      r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h );

-      r2 := SDLRect( 0, 0, buffer^.w, buffer^.h );

-      SDL_BlitSurface( DstSurface, @r1, buffer, @r2 );

-      SDL_BlitSurface( buffer, @r2, DstSurface, @r2 );

-      SDL_FreeSurface( buffer );

-    end;

-  end;

-end;

-

-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :

-  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );

-var

-  aSin, aCos : Single;

-  MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer;

-  Colour, TempTransparentColour : UInt32;

-  MAXX, MAXY : Integer;

-begin

-  // Rotate the surface to the target surface.

-  TempTransparentColour := SrcSurface.format.colorkey;

-  if srcRect.w > srcRect.h then

-  begin

-    Width := srcRect.w;

-    Height := srcRect.w;

-  end

-  else

-  begin

-    Width := srcRect.h;

-    Height := srcRect.h;

-  end;

-

-  maxx := DstSurface.w;

-  maxy := DstSurface.h;

-  aCos := cos( Angle );

-  aSin := sin( Angle );

-

-  Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) );

-  Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) );

-

-  OX := Width div 2;

-  OY := Height div 2; ;

-  MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2;

-  MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2;

-  ROX := ( -( srcRect.w div 2 ) ) + Offsetx;

-  ROY := ( -( srcRect.h div 2 ) ) + OffsetY;

-  Tx := ox + round( ROX * aSin - ROY * aCos );

-  Ty := oy + round( ROY * aSin + ROX * aCos );

-  SX := 0;

-  for DX := DestX - TX to DestX - TX + ( width ) do

-  begin

-    Inc( SX );

-    SY := 0;

-    for DY := DestY - TY to DestY - TY + ( Height ) do

-    begin

-      RX := SX - OX;

-      RY := SY - OY;

-      NX := round( mx + RX * aSin + RY * aCos ); //

-      NY := round( my + RY * aSin - RX * aCos ); //

-      // Used for testing only

-     //SDL_PutPixel(DstSurface.SDLSurfacePointer,DX,DY,0);

-      if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then

-      begin

-        if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then

-        begin

-          if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then

-          begin

-            Colour := SDL_GetPixel( SrcSurface, NX, NY );

-            if Colour <> TempTransparentColour then

-            begin

-              SDL_PutPixel( DstSurface, DX, DY, Colour );

-            end;

-          end;

-        end;

-      end;

-      inc( SY );

-    end;

-  end;

-end;

-

-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :

-  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );

-begin

-  SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) );

-end;

-

-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;

-var

-  RealRect : TSDL_Rect;

-  OutOfRange : Boolean;

-begin

-  OutOfRange := false;

-  if dstrect = nil then

-  begin

-    RealRect.x := 0;

-    RealRect.y := 0;

-    RealRect.w := DstSurface.w;

-    RealRect.h := DstSurface.h;

-  end

-  else

-  begin

-    if dstrect.x < DstSurface.w then

-    begin

-      RealRect.x := dstrect.x;

-    end

-    else if dstrect.x < 0 then

-    begin

-      realrect.x := 0;

-    end

-    else

-    begin

-      OutOfRange := True;

-    end;

-    if dstrect.y < DstSurface.h then

-    begin

-      RealRect.y := dstrect.y;

-    end

-    else if dstrect.y < 0 then

-    begin

-      realrect.y := 0;

-    end

-    else

-    begin

-      OutOfRange := True;

-    end;

-    if OutOfRange = False then

-    begin

-      if realrect.x + dstrect.w <= DstSurface.w then

-      begin

-        RealRect.w := dstrect.w;

-      end

-      else

-      begin

-        RealRect.w := dstrect.w - realrect.x;

-      end;

-      if realrect.y + dstrect.h <= DstSurface.h then

-      begin

-        RealRect.h := dstrect.h;

-      end

-      else

-      begin

-        RealRect.h := dstrect.h - realrect.y;

-      end;

-    end;

-  end;

-  if OutOfRange = False then

-  begin

-    result := realrect;

-  end

-  else

-  begin

-    realrect.w := 0;

-    realrect.h := 0;

-    realrect.x := 0;

-    realrect.y := 0;

-    result := realrect;

-  end;

-end;

-

-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );

-var

-  RealRect : TSDL_Rect;

-  Addr : pointer;

-  ModX, BPP : cardinal;

-  x, y, R, G, B, SrcColor : cardinal;

-begin

-  RealRect := ValidateSurfaceRect( DstSurface, DstRect );

-  if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then

-  begin

-    SDL_LockSurface( DstSurface );

-    BPP := DstSurface.format.BytesPerPixel;

-    with DstSurface^ do

-    begin

-      Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );

-      ModX := Pitch - UInt32( RealRect.w ) * BPP;

-    end;

-    case DstSurface.format.BitsPerPixel of

-      8 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $E0 + Color and $E0;

-              G := SrcColor and $1C + Color and $1C;

-              B := SrcColor and $03 + Color and $03;

-              if R > $E0 then

-                R := $E0;

-              if G > $1C then

-                G := $1C;

-              if B > $03 then

-                B := $03;

-              PUInt8( Addr )^ := R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-      15 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $7C00 + Color and $7C00;

-              G := SrcColor and $03E0 + Color and $03E0;

-              B := SrcColor and $001F + Color and $001F;

-              if R > $7C00 then

-                R := $7C00;

-              if G > $03E0 then

-                G := $03E0;

-              if B > $001F then

-                B := $001F;

-              PUInt16( Addr )^ := R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-      16 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $F800 + Color and $F800;

-              G := SrcColor and $07C0 + Color and $07C0;

-              B := SrcColor and $001F + Color and $001F;

-              if R > $F800 then

-                R := $F800;

-              if G > $07C0 then

-                G := $07C0;

-              if B > $001F then

-                B := $001F;

-              PUInt16( Addr )^ := R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-      24 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $00FF0000 + Color and $00FF0000;

-              G := SrcColor and $0000FF00 + Color and $0000FF00;

-              B := SrcColor and $000000FF + Color and $000000FF;

-              if R > $FF0000 then

-                R := $FF0000;

-              if G > $00FF00 then

-                G := $00FF00;

-              if B > $0000FF then

-                B := $0000FF;

-              PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-      32 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $00FF0000 + Color and $00FF0000;

-              G := SrcColor and $0000FF00 + Color and $0000FF00;

-              B := SrcColor and $000000FF + Color and $000000FF;

-              if R > $FF0000 then

-                R := $FF0000;

-              if G > $00FF00 then

-                G := $00FF00;

-              if B > $0000FF then

-                B := $0000FF;

-              PUInt32( Addr )^ := R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-    end;

-    SDL_UnlockSurface( DstSurface );

-  end;

-end;

-

-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );

-var

-  RealRect : TSDL_Rect;

-  Addr : pointer;

-  ModX, BPP : cardinal;

-  x, y, R, G, B, SrcColor : cardinal;

-begin

-  RealRect := ValidateSurfaceRect( DstSurface, DstRect );

-  if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then

-  begin

-    SDL_LockSurface( DstSurface );

-    BPP := DstSurface.format.BytesPerPixel;

-    with DstSurface^ do

-    begin

-      Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );

-      ModX := Pitch - UInt32( RealRect.w ) * BPP;

-    end;

-    case DstSurface.format.BitsPerPixel of

-      8 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $E0 - Color and $E0;

-              G := SrcColor and $1C - Color and $1C;

-              B := SrcColor and $03 - Color and $03;

-              if R > $E0 then

-                R := 0;

-              if G > $1C then

-                G := 0;

-              if B > $03 then

-                B := 0;

-              PUInt8( Addr )^ := R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-      15 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $7C00 - Color and $7C00;

-              G := SrcColor and $03E0 - Color and $03E0;

-              B := SrcColor and $001F - Color and $001F;

-              if R > $7C00 then

-                R := 0;

-              if G > $03E0 then

-                G := 0;

-              if B > $001F then

-                B := 0;

-              PUInt16( Addr )^ := R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-      16 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $F800 - Color and $F800;

-              G := SrcColor and $07C0 - Color and $07C0;

-              B := SrcColor and $001F - Color and $001F;

-              if R > $F800 then

-                R := 0;

-              if G > $07C0 then

-                G := 0;

-              if B > $001F then

-                B := 0;

-              PUInt16( Addr )^ := R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-      24 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $00FF0000 - Color and $00FF0000;

-              G := SrcColor and $0000FF00 - Color and $0000FF00;

-              B := SrcColor and $000000FF - Color and $000000FF;

-              if R > $FF0000 then

-                R := 0;

-              if G > $00FF00 then

-                G := 0;

-              if B > $0000FF then

-                B := 0;

-              PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-      32 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $00FF0000 - Color and $00FF0000;

-              G := SrcColor and $0000FF00 - Color and $0000FF00;

-              B := SrcColor and $000000FF - Color and $000000FF;

-              if R > $FF0000 then

-                R := 0;

-              if G > $00FF00 then

-                G := 0;

-              if B > $0000FF then

-                B := 0;

-              PUInt32( Addr )^ := R or G or B;

-              inc( UInt32( Addr ), BPP );

-            end;

-            inc( UInt32( Addr ), ModX );

-          end;

-        end;

-    end;

-    SDL_UnlockSurface( DstSurface );

-  end;

-end;

-

-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );

-var

-  FBC : array[ 0..255 ] of Cardinal;

-  // temp vars

-  i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer;

-

-  TempStepV, TempStepH : Single;

-  TempLeft, TempTop, TempHeight, TempWidth : integer;

-  TempRect : TSDL_Rect;

-

-begin

-  // calc FBC

-  YR := StartColor.r;

-  YG := StartColor.g;

-  YB := StartColor.b;

-  SR := YR;

-  SG := YG;

-  SB := YB;

-  DR := EndColor.r - SR;

-  DG := EndColor.g - SG;

-  DB := EndColor.b - SB;

-

-  for i := 0 to 255 do

-  begin

-    FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB );

-    YR := SR + round( DR / 255 * i );

-    YG := SG + round( DG / 255 * i );

-    YB := SB + round( DB / 255 * i );

-  end;

-

-  //  if aStyle = 1 then begin

-  TempStepH := Rect.w / 255;

-  TempStepV := Rect.h / 255;

-  TempHeight := Trunc( TempStepV + 1 );

-  TempWidth := Trunc( TempStepH + 1 );

-  TempTop := 0;

-  TempLeft := 0;

-  TempRect.x := Rect.x;

-  TempRect.y := Rect.y;

-  TempRect.h := Rect.h;

-  TempRect.w := Rect.w;

-

-  case Style of

-    gsHorizontal :

-      begin

-        TempRect.h := TempHeight;

-        for i := 0 to 255 do

-        begin

-          TempRect.y := Rect.y + TempTop;

-          SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );

-          TempTop := Trunc( TempStepV * i );

-        end;

-      end;

-    gsVertical :

-      begin

-        TempRect.w := TempWidth;

-        for i := 0 to 255 do

-        begin

-          TempRect.x := Rect.x + TempLeft;

-          SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );

-          TempLeft := Trunc( TempStepH * i );

-        end;

-      end;

-  end;

-end;

-

-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );

-var

-  ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;

-  SrcPitch, DestPitch, x, y, w, h : UInt32;

-begin

-  if ( Src = nil ) or ( Dest = nil ) then

-    exit;

-  if ( Src.w shl 1 ) < Dest.w then

-    exit;

-  if ( Src.h shl 1 ) < Dest.h then

-    exit;

-

-  if SDL_MustLock( Src ) then

-    SDL_LockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_LockSurface( Dest );

-

-  ReadRow := UInt32( Src.Pixels );

-  WriteRow := UInt32( Dest.Pixels );

-

-  SrcPitch := Src.pitch;

-  DestPitch := Dest.pitch;

-

-  w := Src.w;

-  h := Src.h;

-

-  case Src.format.BytesPerPixel of

-    1 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-           mov ebx, DestPitch

-

-           @LoopX:

-             mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^;

-             mov [edx], al

-             mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^;

-             mov [edx + ebx], al // PUInt8(WriteAddr + DestPitch)^ := PUInt8(ReadAddr)^;

-             mov [edx + ebx + 1], al // PUInt8(WriteAddr + DestPitch + 1)^ := PUInt8(ReadAddr)^;

-

-             inc ecx // inc(ReadAddr);

-             add edx, 2 // inc(WriteAddr, 2);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    2 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-           mov ebx, DestPitch

-

-           @LoopX:

-             mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;

-             mov [edx], ax

-             mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;

-             mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^;

-             mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^;

-

-             add ecx, 2 // inc(ReadAddr, 2);

-             add edx, 4 // inc(WriteAddr, 4);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    3 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-           mov ebx, DestPitch

-

-           @LoopX:

-             mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             and eax, $00ffffff

-             and dword ptr [edx], $ff000000

-             or [edx], eax

-             and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             or [edx + 3], eax

-             and dword ptr [edx + ebx], $00ffffff // (PUInt32(WriteAddr + DestPitch)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             or [edx + ebx], eax

-             and dword ptr [edx + ebx + 3], $00ffffff // (PUInt32(WriteAddr + DestPitch + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             or [edx + ebx + 3], eax

-

-             add ecx, 3 // inc(ReadAddr, 3);

-             add edx, 6 // inc(WriteAddr, 6);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    4 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-           mov ebx, DestPitch

-

-           @LoopX:

-             mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^;

-             mov [edx], eax

-             mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^;

-             mov [edx + ebx], eax // PUInt32(WriteAddr + DestPitch)^ := PUInt32(ReadAddr)^;

-             mov [edx + ebx + 4], eax // PUInt32(WriteAddr + DestPitch + 4)^ := PUInt32(ReadAddr)^;

-

-             add ecx, 4 // inc(ReadAddr, 4);

-             add edx, 8 // inc(WriteAddr, 8);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-  end;

-

-  if SDL_MustLock( Src ) then

-    SDL_UnlockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_UnlockSurface( Dest );

-end;

-

-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );

-var

-  ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;

-  SrcPitch, DestPitch, x, y, w, h : UInt32;

-begin

-  if ( Src = nil ) or ( Dest = nil ) then

-    exit;

-  if ( Src.w shl 1 ) < Dest.w then

-    exit;

-  if ( Src.h shl 1 ) < Dest.h then

-    exit;

-

-  if SDL_MustLock( Src ) then

-    SDL_LockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_LockSurface( Dest );

-

-  ReadRow := UInt32( Src.Pixels );

-  WriteRow := UInt32( Dest.Pixels );

-

-  SrcPitch := Src.pitch;

-  DestPitch := Dest.pitch;

-

-  w := Src.w;

-  h := Src.h;

-

-  case Src.format.BytesPerPixel of

-    1 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-

-           @LoopX:

-             mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^;

-             mov [edx], al

-             mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^;

-

-             inc ecx // inc(ReadAddr);

-             add edx, 2 // inc(WriteAddr, 2);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    2 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-

-           @LoopX:

-             mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;

-             mov [edx], ax

-             mov [edx + 2], eax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;

-

-             add ecx, 2 // inc(ReadAddr, 2);

-             add edx, 4 // inc(WriteAddr, 4);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    3 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-

-           @LoopX:

-             mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             and eax, $00ffffff

-             and dword ptr [edx], $ff000000

-             or [edx], eax

-             and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             or [edx + 3], eax

-

-             add ecx, 3 // inc(ReadAddr, 3);

-             add edx, 6 // inc(WriteAddr, 6);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    4 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-

-           @LoopX:

-             mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^;

-             mov [edx], eax

-             mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^;

-

-             add ecx, 4 // inc(ReadAddr, 4);

-             add edx, 8 // inc(WriteAddr, 8);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-  end;

-

-  if SDL_MustLock( Src ) then

-    SDL_UnlockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_UnlockSurface( Dest );

-end;

-

-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );

-var

-  ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;

-  SrcPitch, DestPitch, x, y, w, h : UInt32;

-begin

-  if ( Src = nil ) or ( Dest = nil ) then

-    exit;

-  if ( Src.w shl 1 ) < Dest.w then

-    exit;

-  if ( Src.h shl 1 ) < Dest.h then

-    exit;

-

-  if SDL_MustLock( Src ) then

-    SDL_LockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_LockSurface( Dest );

-

-  ReadRow := UInt32( Src.Pixels );

-  WriteRow := UInt32( Dest.Pixels );

-

-  SrcPitch := Src.pitch;

-  DestPitch := Dest.pitch;

-

-  w := Src.w;

-  h := Src.h;

-

-  case Src.format.BitsPerPixel of

-    8 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-           mov ebx, DestPitch

-

-           @LoopX:

-             mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^;

-             mov [edx], al

-             mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^;

-             shr al, 1

-             and al, $6d

-             mov [edx + ebx], al // PUInt8(WriteAddr + DestPitch)^ := PUInt8(ReadAddr)^;

-             mov [edx + ebx + 1], al // PUInt8(WriteAddr + DestPitch + 1)^ := PUInt8(ReadAddr)^;

-

-             inc ecx // inc(ReadAddr);

-             add edx, 2 // inc(WriteAddr, 2);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    15 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-           mov ebx, DestPitch

-

-           @LoopX:

-             mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;

-             mov [edx], ax

-             mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;

-             shr ax, 1

-             and ax, $3def

-             mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^;

-             mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^;

-

-             add ecx, 2 // inc(ReadAddr, 2);

-             add edx, 4 // inc(WriteAddr, 4);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    16 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-           mov ebx, DestPitch

-

-           @LoopX:

-             mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;

-             mov [edx], ax

-             mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;

-             shr ax, 1

-             and ax, $7bef

-             mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^;

-             mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^;

-

-             add ecx, 2 // inc(ReadAddr, 2);

-             add edx, 4 // inc(WriteAddr, 4);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    24 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-           mov ebx, DestPitch

-

-           @LoopX:

-             mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             and eax, $00ffffff

-             and dword ptr [edx], $ff000000

-             or [edx], eax

-             and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             or [edx + 3], eax

-             shr eax, 1

-             and eax, $007f7f7f

-             and dword ptr [edx + ebx], $00ffffff // (PUInt32(WriteAddr + DestPitch)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             or [edx + ebx], eax

-             and dword ptr [edx + ebx + 3], $00ffffff // (PUInt32(WriteAddr + DestPitch + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);

-             or [edx + ebx + 3], eax

-

-             add ecx, 3 // inc(ReadAddr, 3);

-             add edx, 6 // inc(WriteAddr, 6);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-    32 :

-      asm

-         push ebx

-         mov eax, h // for y := 1 to Src.h do

-         mov y, eax

-         @LoopY:

-           mov eax, ReadRow // ReadAddr := ReadRow;

-           mov ReadAddr, eax

-

-           mov eax, WriteRow // WriteAddr := WriteRow;

-           mov WriteAddr, eax

-

-           mov eax, w // for x := 1 to Src.w do

-           mov x, eax

-

-           mov ecx, ReadAddr

-           mov edx, WriteAddr

-           mov ebx, DestPitch

-

-           @LoopX:

-             mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^;

-             mov [edx], eax

-             mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^;

-             shr eax, 1

-             and eax, $7f7f7f7f

-             mov [edx + ebx], eax // PUInt32(WriteAddr + DestPitch)^ := PUInt32(ReadAddr)^;

-             mov [edx + ebx + 4], eax // PUInt32(WriteAddr + DestPitch + 4)^ := PUInt32(ReadAddr)^;

-

-             add ecx, 4 // inc(ReadAddr, 4);

-             add edx, 8 // inc(WriteAddr, 8);

-

-             dec x

-           jnz @LoopX

-

-           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);

-           add ReadRow, eax

-

-           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);

-           add WriteRow, eax

-           add WriteRow, eax

-

-           dec y

-         jnz @LoopY

-         pop ebx

-      end;

-  end;

-

-  if SDL_MustLock( Src ) then

-    SDL_UnlockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_UnlockSurface( Dest );

-end;

-

-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :

-boolean;

-var

-  Src_Rect1, Src_Rect2 : TSDL_Rect;

-  right1, bottom1 : integer;

-  right2, bottom2 : integer;

-  Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;

-  Mod1: cardinal;

-  Addr1 : cardinal;

-  BPP : cardinal;

-  Pitch1 : cardinal;

-  TransparentColor1 : cardinal;

-  tx, ty : cardinal;

-  StartTick : cardinal;

-  Color1 : cardinal;

-begin

-  Result := false;

-  if SrcRect1 = nil then

-  begin

-    with Src_Rect1 do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface1.w;

-      h := SrcSurface1.h;

-    end;

-  end

-  else

-    Src_Rect1 := SrcRect1^;

-

-    Src_Rect2 := SrcRect2^;

-  with Src_Rect1 do

-  begin

-    Right1 := Left1 + w;

-    Bottom1 := Top1 + h;

-  end;

-  with Src_Rect2 do

-  begin

-    Right2 := Left2 + w;

-    Bottom2 := Top2 + h;

-  end;

-  if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( 

-Bottom1 <=

-    Top2 ) then

-    exit;

-  if Left1 <= Left2 then

-  begin

-    // 1. left, 2. right

-    Scan1Start := Src_Rect1.x + Left2 - Left1;

-    Scan2Start := Src_Rect2.x;

-    ScanWidth := Right1 - Left2;

-    with Src_Rect2 do

-      if ScanWidth > w then

-        ScanWidth := w;

-  end

-  else

-  begin

-    // 1. right, 2. left

-    Scan1Start := Src_Rect1.x;

-    Scan2Start := Src_Rect2.x + Left1 - Left2;

-    ScanWidth := Right2 - Left1;

-    with Src_Rect1 do

-      if ScanWidth > w then

-        ScanWidth := w;

-  end;

-  with SrcSurface1^ do

-  begin

-    Pitch1 := Pitch;

-    Addr1 := cardinal( Pixels );

-    inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );

-    with format^ do

-    begin

-      BPP := BytesPerPixel;

-      TransparentColor1 := colorkey;

-    end;

-  end;

-

-  Mod1 := Pitch1 - ( ScanWidth * BPP );

-

-  inc( Addr1, BPP * Scan1Start );

-

-  if Top1 <= Top2 then

-  begin

-    // 1. up, 2. down

-    ScanHeight := Bottom1 - Top2;

-    if ScanHeight > Src_Rect2.h then

-      ScanHeight := Src_Rect2.h;

-    inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );

-  end

-  else

-  begin

-    // 1. down, 2. up

-    ScanHeight := Bottom2 - Top1;

-    if ScanHeight > Src_Rect1.h then

-      ScanHeight := Src_Rect1.h;

-

-  end;

-  case BPP of

-    1 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PByte( Addr1 )^ <> TransparentColor1 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1 );

-

-        end;

-        inc( Addr1, Mod1 );

-

-      end;

-    2 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PWord( Addr1 )^ <> TransparentColor1 )  then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 2 );

-

-        end;

-        inc( Addr1, Mod1 );

-

-      end;

-    3 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          Color1 := PLongWord( Addr1 )^ and $00FFFFFF;

-

-          if ( Color1 <> TransparentColor1 )

-            then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 3 );

-

-        end;

-        inc( Addr1, Mod1 );

-

-      end;

-    4 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PLongWord( Addr1 )^ <> TransparentColor1 )  then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 4 );

-

-        end;

-        inc( Addr1, Mod1 );

-

-      end;

-  end;

-end;

-

-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  Src, Dest : TSDL_Rect;

-  Diff : integer;

-  SrcAddr, DestAddr, TransparentColor : cardinal;

-  // TransparentColor: cardinal;

-  _ebx, _esi, _edi, _esp : cardinal;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        cmp al, 0

-        je @SkipColor         // if AL=0 or AL=transparent color then skip everything

-        cmp al, byte ptr TransparentColor

-        je @SkipColor

-        or al, [edi]

-        mov [edi], al

-       @SkipColor:

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    15 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax          // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AX := source color

-        cmp ax, 0

-        je @SkipColor         // if AX=0 then skip everything

-        cmp ax, word ptr TransparentColor

-        je @SkipColor

-        or ax, [edi]

-        mov [edi], ax

-       @SkipColor:

-        add esi, 2

-        add edi, 2

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    16 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AX := source color

-        cmp ax, 0

-        je @SkipColor         // if AX=0 then skip everything

-        cmp ax, word ptr TransparentColor

-        je @SkipColor

-        or ax, [edi]

-        mov [edi], ax

-       @SkipColor:

-        add esi, 2

-        add edi, 2

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    24 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       add WorkX, ax         // WorkX := Src.w * 2

-       add WorkX, ax         // WorkX := Src.w * 3

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        or al, [edi]

-        mov [edi], al

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    32 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       shl ax, 2

-       mov WorkX, ax         // WorkX := Src.w * 4

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        or al, [edi]

-        mov [edi], al

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  Src, Dest : TSDL_Rect;

-  Diff : integer;

-  SrcAddr, DestAddr, TransparentColor : cardinal;

-  // TransparentColor: cardinal;

-  _ebx, _esi, _edi, _esp : cardinal;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        cmp al, 0

-        je @SkipColor         // if AL=0 or AL=transparent color then skip everything

-        cmp al, byte ptr TransparentColor

-        je @SkipColor

-        and al, [edi]

-        mov [edi], al

-       @SkipColor:

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    15 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax          // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AX := source color

-        cmp ax, 0

-        je @SkipColor         // if AX=0 then skip everything

-        cmp ax, word ptr TransparentColor

-        je @SkipColor

-        and ax, [edi]

-        mov [edi], ax

-       @SkipColor:

-        add esi, 2

-        add edi, 2

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    16 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       @Loopx:

-        mov ax, [esi]         // AX := source color

-        cmp ax, 0

-        je @SkipColor         // if AX=0 then skip everything

-        cmp ax, word ptr TransparentColor

-        je @SkipColor

-        and ax, [edi]

-        mov [edi], ax

-       @SkipColor:

-        add esi, 2

-        add edi, 2

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    24 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       mov WorkX, ax         // WorkX := Src.w

-       add WorkX, ax         // WorkX := Src.w * 2

-       add WorkX, ax         // WorkX := Src.w * 3

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        and al, [edi]

-        mov [edi], al

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-    32 :

-      asm

-      mov _ebx, ebx

-      mov _esi, esi

-      mov _edi, edi

-      mov _esp, esp

-      mov esi, SrcAddr      // ESI - Source Offset

-      mov edi, DestAddr     // EDI - Destination Offset

-      mov ax, Src.h         //  WorkY := Src.h

-      mov WorkY, ax

-      @LoopY:

-       mov ax, Src.w

-       shl ax, 2

-       mov WorkX, ax         // WorkX := Src.w * 4

-       @Loopx:

-        mov al, [esi]         // AL := source color

-        and al, [edi]

-        mov [edi], al

-        inc esi

-        inc edi

-        dec WorkX

-       jnz @LoopX

-       add esi, SrcMod

-       add edi, DestMod

-       dec WorkY

-      jnz @LoopY

-      mov esp,_esp

-      mov edi,_edi

-      mov esi,_esi

-      mov ebx,_ebx

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-

-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;

-  Src, Dest : TSDL_Rect;

-  Diff : integer;

-  SrcAddr, DestAddr : cardinal;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt8( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt8( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                if Pixel2 and $E0 > Pixel1 and $E0 then R := Pixel2 and $E0 else R := Pixel1 and $E0;

-                if Pixel2 and $1C > Pixel1 and $1C then G := Pixel2 and $1C else G := Pixel1 and $1C;

-                if Pixel2 and $03 > Pixel1 and $03 then B := Pixel2 and $03 else B := Pixel1 and $03;

-

-                if R > $E0 then

-                  R := $E0;

-                if G > $1C then

-                  G := $1C;

-                if B > $03 then

-                  B := $03;

-                PUInt8( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt8( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    15 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-              if Pixel2 and $7C00 > Pixel1 and $7C00 then R := Pixel2 and $7C00 else R := Pixel1 and $7C00;

-              if Pixel2 and $03E0 > Pixel1 and $03E0 then G := Pixel2 and $03E0 else G := Pixel1 and $03E0;

-              if Pixel2 and $001F > Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;

-

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    16 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-              if Pixel2 and $F800 > Pixel1 and $F800 then R := Pixel2 and $F800 else R := Pixel1 and $F800;

-              if Pixel2 and $07E0 > Pixel1 and $07E0 then G := Pixel2 and $07E0 else G := Pixel1 and $07E0;

-              if Pixel2 and $001F > Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;

-

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    24 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;

-              if Pixel2 > 0 then

-              begin

-

-              if Pixel2 and $FF0000 > Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;

-              if Pixel2 and $00FF00 > Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;

-              if Pixel2 and $0000FF > Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;

-

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );

-              end

-              else

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;

-            end;

-            inc( SrcAddr, 3 );

-            inc( DestAddr, 3 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    32 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-              if Pixel2 and $FF0000 > Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;

-              if Pixel2 and $00FF00 > Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;

-              if Pixel2 and $0000FF > Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;

-

-                PUInt32( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt32( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 4 );

-            inc( DestAddr, 4 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-

-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;

-  Src, Dest : TSDL_Rect;

-  Diff : integer;

-  SrcAddr, DestAddr : cardinal;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt8( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt8( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                if Pixel2 and $E0 < Pixel1 and $E0 then R := Pixel2 and $E0 else R := Pixel1 and $E0;

-                if Pixel2 and $1C < Pixel1 and $1C then G := Pixel2 and $1C else G := Pixel1 and $1C;

-                if Pixel2 and $03 < Pixel1 and $03 then B := Pixel2 and $03 else B := Pixel1 and $03;

-

-                if R > $E0 then

-                  R := $E0;

-                if G > $1C then

-                  G := $1C;

-                if B > $03 then

-                  B := $03;

-                PUInt8( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt8( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    15 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-              if Pixel2 and $7C00 < Pixel1 and $7C00 then R := Pixel2 and $7C00 else R := Pixel1 and $7C00;

-              if Pixel2 and $03E0 < Pixel1 and $03E0 then G := Pixel2 and $03E0 else G := Pixel1 and $03E0;

-              if Pixel2 and $001F < Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;

-

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    16 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-              if Pixel2 and $F800 < Pixel1 and $F800 then R := Pixel2 and $F800 else R := Pixel1 and $F800;

-              if Pixel2 and $07E0 < Pixel1 and $07E0 then G := Pixel2 and $07E0 else G := Pixel1 and $07E0;

-              if Pixel2 and $001F < Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;

-

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    24 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;

-              if Pixel2 > 0 then

-              begin

-

-              if Pixel2 and $FF0000 < Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;

-              if Pixel2 and $00FF00 < Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;

-              if Pixel2 and $0000FF < Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;

-

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );

-              end

-              else

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;

-            end;

-            inc( SrcAddr, 3 );

-            inc( DestAddr, 3 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    32 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-              if Pixel2 and $FF0000 < Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;

-              if Pixel2 and $00FF00 < Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;

-              if Pixel2 and $0000FF < Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;

-

-                PUInt32( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt32( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 4 );

-            inc( DestAddr, 4 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-function SDL_ClipLine(var x1,y1,x2,y2: Integer; ClipRect: PSDL_Rect) : boolean;

-var tflag, flag1, flag2: word;

-    txy, xedge, yedge: Integer;

-    slope: single;

-

-  function ClipCode(x,y: Integer): word;

-  begin

-    Result := 0;

-    if x < ClipRect.x then Result := 1;

-    if x >= ClipRect.w + ClipRect.x then Result := Result or 2;

-    if y < ClipRect.y then Result := Result or 4;

-    if y >= ClipRect.h + ClipRect.y then Result := Result or 8;

-  end;

-

-begin

-  flag1 := ClipCode(x1,y1);

-  flag2 := ClipCode(x2,y2);

-  result := true;

-

-  while true do

-  begin

-    if (flag1 or flag2) = 0 then Exit; // all in

-

-    if (flag1 and flag2) <> 0 then

-      begin

-        result := false;

-        Exit; // all out

-      end;

-

-    if flag2 = 0 then

-      begin

-        txy := x1; x1 := x2; x2 := txy;

-        txy := y1; y1 := y2; y2 := txy;

-        tflag := flag1; flag1 := flag2; flag2 := tflag;

-      end;

-

-    if (flag2 and 3) <> 0 then

-      begin

-        if (flag2 and 1) <> 0 then

-          xedge := ClipRect.x

-        else

-          xedge := ClipRect.w + ClipRect.x -1; // back 1 pixel otherwise we end up in a loop

-

-        slope := (y2 - y1) / (x2 - x1);

-        y2 := y1 + Round(slope * (xedge - x1));

-        x2 := xedge;

-      end

-    else

-      begin

-        if (flag2 and 4) <> 0 then

-          yedge := ClipRect.y

-        else

-          yedge := ClipRect.h + ClipRect.y -1; // up 1 pixel otherwise we end up in a loop

-

-        slope := (x2 - x1) / (y2 - y1);

-        x2 := x1 + Round(slope * (yedge - y1));

-        y2 := yedge;

-      end;

-

-    flag2 := ClipCode(x2, y2);

-  end;

-end;

-

-end.

-

-

+unit sdli386utils;
+{
+  $Id: sdli386utils.pas,v 1.5 2004/06/02 19:38:53 savage Exp $
+  
+}
+{******************************************************************************}
+{                                                                              }
+{       Borland Delphi SDL - Simple DirectMedia Layer                          }
+{                SDL Utility functions                                         }
+{                                                                              }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Tom Jones <tigertomjones@gmx.de>                                             }
+{                                                                              }
+{ Portions created by Tom Jones are                                            }
+{ Copyright (C) 2000 - 2001 Tom Jones.                                         }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }
+{ Róbert Kisnémeth <mikrobi@freemail.hu>                                       }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{   Helper functions...                                                        }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   SDL.dll on Windows platforms                                               }
+{   libSDL-1.1.so.0 on Linux platform                                          }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{               2000 - TJ : Initial creation                                   }
+{                                                                              }
+{   July   13   2001 - DL : Added PutPixel and GetPixel routines.              }
+{                                                                              }
+{   Sept   14   2001 - RK : Added flipping routines.                           }
+{                                                                              }
+{   Sept   19   2001 - RK : Added PutPixel & line drawing & blitting with ADD  }
+{                           effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel }
+{                           Added PSDLRect()                                   }
+{   Sept   22   2001 - DL : Removed need for Windows.pas by defining types here}
+{                           Also removed by poor attempt or a dialog box       }
+{                                                                              }
+{   Sept   25   2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine,   }
+{                           SubSurface, MonoSurface & TexturedSurface          }
+{                                                                              }
+{   Sept   26   2001 - DL : Made change so that it refers to native Pascal     }
+{                           types rather that Windows types. This makes it more}
+{                           portable to Linix.                                 }
+{                                                                              }
+{   Sept   27   2001 - RK : SDLUtils now can be compiled with FreePascal       }
+{                                                                              }
+{   Oct    27   2001 - JF : Added ScrollY function                             }
+{                                                                              }
+{   Jan    21   2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface          }
+{                                                                              }
+{   Mar    28   2002 - JF : Added SDL_RotateSurface                            }
+{                                                                              }
+{   May    13   2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub         }
+{                                                                              }
+{   May    27   2002 - YS : GradientFillRect function                          }
+{                                                                              }
+{   May    30   2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit               }
+{                           & SDL_50Scanline2xBlit                             }
+{                                                                              }
+{  June    12   2002 - RK : Added SDL_PixelTestSurfaceVsRect                   }
+{                                                                              }
+{  June    12   2002 - JF : Updated SDL_PixelTestSurfaceVsRect                 }
+{                                                                              }
+{ November  9   2002 - JF : Added Jason's boolean Surface functions            }
+{                                                                              }
+{ December 10   2002 - DE : Added Dean's SDL_ClipLine function                 }
+{                                                                              }
+{******************************************************************************}
+{
+  $Log: sdli386utils.pas,v $
+  Revision 1.5  2004/06/02 19:38:53  savage
+  Changes to SDL_GradientFillRect as suggested by
+  Ángel Eduardo García Hernández.  Many thanks.
+
+  Revision 1.4  2004/05/29 23:11:53  savage
+  Changes to SDL_ScaleSurfaceRect as suggested by
+  Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks.
+
+  Revision 1.3  2004/02/20 22:04:11  savage
+  Added Changes as mentioned by Rodrigo "Rui" R. (1/2 RRC2Soft) to facilitate FPC compilation and it also works in Delphi. Also syncronized the funcitons so that they are identical to sdlutils.pas, when no assembly version is available.
+
+  Revision 1.2  2004/02/14 00:23:39  savage
+  As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
+
+  Revision 1.1  2004/02/05 00:08:20  savage
+  Module 1.0 release
+
+  
+}
+
+interface
+
+{$i jedi-sdl.inc}
+
+uses
+{$IFDEF UNIX}
+  Types,
+  Xlib,
+{$ENDIF}
+  SysUtils,
+  sdl;
+
+type
+  TGradientStyle = ( gsHorizontal, gsVertical );
+
+  // Pixel procedures
+function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
+  PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean;
+  
+function SDL_GetPixel( SrcSurface : PSDL_Surface; x : cardinal; y : cardinal ) : Uint32;
+
+procedure SDL_PutPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
+  cardinal );
+
+procedure SDL_AddPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
+  cardinal );
+
+procedure SDL_SubPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
+  cardinal );
+
+// Line procedures
+procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );overload;
+
+procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal ; DashLength, DashSpace : byte );  overload;  
+
+procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+
+procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+
+// Surface procedures
+procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DstSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DstSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
+
+procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
+  TextureRect : PSDL_Rect );
+
+procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
+
+procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
+
+// Flip procedures
+procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
+
+procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
+
+function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
+
+function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload;
+
+function SDLRect( aRect : TRect ) : TSDL_Rect; overload;
+
+function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
+  Width, Height : integer ) : PSDL_Surface;
+
+procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
+
+procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
+
+procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
+  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
+
+procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
+  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
+
+function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
+
+// Fill Rect routine
+procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
+
+procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
+
+procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
+
+// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface!
+procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
+
+procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
+
+procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
+
+function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
+PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
+boolean;
+
+// Jason's boolean Surface functions
+procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+function SDL_ClipLine(var x1,y1,x2,y2: Integer; ClipRect: PSDL_Rect) : boolean;
+
+implementation
+
+uses
+  Math;
+
+function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
+  PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean;
+var
+  Src_Rect1, Src_Rect2 : TSDL_Rect;
+  right1, bottom1 : integer;
+  right2, bottom2 : integer;
+  Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;
+  Mod1, Mod2 : cardinal;
+  Addr1, Addr2 : cardinal;
+  BPP : cardinal;
+  Pitch1, Pitch2 : cardinal;
+  TransparentColor1, TransparentColor2 : cardinal;
+  tx, ty : cardinal;
+  StartTick : cardinal;
+  Color1, Color2 : cardinal;
+begin
+  Result := false;
+  if SrcRect1 = nil then
+  begin
+    with Src_Rect1 do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface1.w;
+      h := SrcSurface1.h;
+    end;
+  end
+  else
+    Src_Rect1 := SrcRect1^;
+  if SrcRect2 = nil then
+  begin
+    with Src_Rect2 do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface2.w;
+      h := SrcSurface2.h;
+    end;
+  end
+  else
+    Src_Rect2 := SrcRect2^;
+  with Src_Rect1 do
+  begin
+    Right1 := Left1 + w;
+    Bottom1 := Top1 + h;
+  end;
+  with Src_Rect2 do
+  begin
+    Right2 := Left2 + w;
+    Bottom2 := Top2 + h;
+  end;
+  if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <=
+    Top2 ) then
+    exit;
+  if Left1 <= Left2 then
+  begin
+    // 1. left, 2. right
+    Scan1Start := Src_Rect1.x + Left2 - Left1;
+    Scan2Start := Src_Rect2.x;
+    ScanWidth := Right1 - Left2;
+    with Src_Rect2 do
+      if ScanWidth > w then
+        ScanWidth := w;
+  end
+  else
+  begin
+    // 1. right, 2. left
+    Scan1Start := Src_Rect1.x;
+    Scan2Start := Src_Rect2.x + Left1 - Left2;
+    ScanWidth := Right2 - Left1;
+    with Src_Rect1 do
+      if ScanWidth > w then
+        ScanWidth := w;
+  end;
+  with SrcSurface1^ do
+  begin
+    Pitch1 := Pitch;
+    Addr1 := cardinal( Pixels );
+    inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
+    with format^ do
+    begin
+      BPP := BytesPerPixel;
+      TransparentColor1 := colorkey;
+    end;
+  end;
+  with SrcSurface2^ do
+  begin
+    TransparentColor2 := format.colorkey;
+    Pitch2 := Pitch;
+    Addr2 := cardinal( Pixels );
+    inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) );
+  end;
+  Mod1 := Pitch1 - ( ScanWidth * BPP );
+  Mod2 := Pitch2 - ( ScanWidth * BPP );
+  inc( Addr1, BPP * Scan1Start );
+  inc( Addr2, BPP * Scan2Start );
+  if Top1 <= Top2 then
+  begin
+    // 1. up, 2. down
+    ScanHeight := Bottom1 - Top2;
+    if ScanHeight > Src_Rect2.h then
+      ScanHeight := Src_Rect2.h;
+    inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
+  end
+  else
+  begin
+    // 1. down, 2. up
+    ScanHeight := Bottom2 - Top1;
+    if ScanHeight > Src_Rect1.h then
+      ScanHeight := Src_Rect1.h;
+    inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) );
+  end;
+  case BPP of
+    1 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <>
+            TransparentColor2 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1 );
+          inc( Addr2 );
+        end;
+        inc( Addr1, Mod1 );
+        inc( Addr2, Mod2 );
+      end;
+    2 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <>
+            TransparentColor2 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 2 );
+          inc( Addr2, 2 );
+        end;
+        inc( Addr1, Mod1 );
+        inc( Addr2, Mod2 );
+      end;
+    3 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
+          Color2 := PLongWord( Addr2 )^ and $00FFFFFF;
+          if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 )
+            then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 3 );
+          inc( Addr2, 3 );
+        end;
+        inc( Addr1, Mod1 );
+        inc( Addr2, Mod2 );
+      end;
+    4 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <>
+            TransparentColor2 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 4 );
+          inc( Addr2, 4 );
+        end;
+        inc( Addr1, Mod1 );
+        inc( Addr2, Mod2 );
+      end;
+  end;
+end;
+
+function SDL_GetPixel( SrcSurface : PSDL_Surface; x : cardinal; y : cardinal ) : Uint32;
+var
+  bpp : UInt32;
+  p : PInteger;
+begin
+  bpp := SrcSurface.format.BytesPerPixel;
+  // Here p is the address to the pixel we want to retrieve
+  p := Pointer( Uint32( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) *
+    bpp );
+  case bpp of
+    1 : result := PUint8( p )^;
+    2 : result := PUint16( p )^;
+    3 :
+      if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
+        result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or
+          PUInt8Array( p )[ 2 ]
+      else
+        result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or
+          PUInt8Array( p )[ 2 ] shl 16;
+    4 : result := PUint32( p )^;
+  else
+    result := 0; // shouldn't happen, but avoids warnings
+  end;
+end;
+
+procedure SDL_PutPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
+  cardinal );
+var
+  Addr, Pitch, BPP : cardinal;
+begin
+  Addr := cardinal( SrcSurface.Pixels );
+  Pitch := SrcSurface.Pitch;
+  BPP := SrcSurface.format.BytesPerPixel;
+  asm
+    mov eax, y
+    mul Pitch      // EAX := y * Pitch
+    add Addr, eax  // Addr:= Addr + (y * Pitch)
+    mov eax, x
+    mov ecx, Color
+    cmp BPP, 1
+    jne @Not1BPP
+    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x
+    mov [eax], cl
+    jmp @Quit
+   @Not1BPP:
+    cmp BPP, 2
+    jne @Not2BPP
+    mul BPP   // EAX := x * BPP
+    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * BPP
+    mov [eax], cx
+    jmp @Quit
+   @Not2BPP:
+    cmp BPP, 3
+    jne @Not3BPP
+    mul BPP   // EAX := x * BPP
+    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * BPP
+    mov edx, [eax]
+    and edx, $ff000000
+    or edx, ecx
+    mov [eax], edx
+    jmp @Quit
+   @Not3BPP:
+    mul BPP   // EAX := x * BPP
+    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * BPP
+    mov [eax], ecx
+   @Quit:
+  end;
+end;
+
+procedure SDL_AddPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
+  cardinal );
+var
+  SrcColor, FinalColor : cardinal;
+  Addr, Pitch, Bits : cardinal;
+begin
+  if Color = 0 then
+    exit;
+  Addr := cardinal( SrcSurface.Pixels );
+  Pitch := SrcSurface.Pitch;
+  Bits := SrcSurface.format.BitsPerPixel;
+  asm
+    mov eax, y
+    mul Pitch      // EAX := y * Pitch
+    add Addr, eax  // Addr:= Addr + (y * Pitch)
+    mov eax, x
+    cmp Bits, 8
+    jne @Not8bit
+    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x
+    mov cl, [eax]
+    movzx ecx, cl
+    mov SrcColor, ecx
+    mov edx, Color
+    and ecx, 3
+    and edx, 3
+    add ecx, edx
+    cmp ecx, 3
+    jbe @Skip1_8bit
+    mov ecx, 3
+   @Skip1_8bit:
+    mov FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $1c
+    and edx, $1c
+    add ecx, edx
+    cmp ecx, $1c
+    jbe @Skip2_8bit
+    mov ecx, $1c
+   @Skip2_8bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $e0
+    and edx, $e0
+    add ecx, edx
+    cmp ecx, $e0
+    jbe @Skip3_8bit
+    mov ecx, $e0
+   @Skip3_8bit:
+    or ecx, FinalColor
+    mov [eax], cl
+    jmp @Quit
+   @Not8bit:
+    cmp Bits, 15
+    jne @Not15bit
+    shl eax, 1
+    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * 2
+    mov ecx, [eax]
+    and ecx, $00007fff
+    mov SrcColor, ecx
+    mov edx, Color
+    and ecx, $1f
+    and edx, $1f
+    add ecx, edx
+    cmp ecx, $1f
+    jbe @Skip1_15bit
+    mov ecx, $1f
+   @Skip1_15bit:
+    mov FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $03e0
+    and edx, $03e0
+    add ecx, edx
+    cmp ecx, $03e0
+    jbe @Skip2_15bit
+    mov ecx, $03e0
+   @Skip2_15bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $7c00
+    and edx, $7c00
+    add ecx, edx
+    cmp ecx, $7c00
+    jbe @Skip3_15bit
+    mov ecx, $7c00
+   @Skip3_15bit:
+    or ecx, FinalColor
+    mov [eax], cx
+    jmp @Quit
+   @Not15Bit:
+    cmp Bits, 16
+    jne @Not16bit
+    shl eax, 1
+    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * 2
+    mov ecx, [eax]
+    and ecx, $0000ffff
+    mov SrcColor, ecx
+    mov edx, Color
+    and ecx, $1f
+    and edx, $1f
+    add ecx, edx
+    cmp ecx, $1f
+    jbe @Skip1_16bit
+    mov ecx, $1f
+   @Skip1_16bit:
+    mov FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $07e0
+    and edx, $07e0
+    add ecx, edx
+    cmp ecx, $07e0
+    jbe @Skip2_16bit
+    mov ecx, $07e0
+   @Skip2_16bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $f800
+    and edx, $f800
+    add ecx, edx
+    cmp ecx, $f800
+    jbe @Skip3_16bit
+    mov ecx, $f800
+   @Skip3_16bit:
+    or ecx, FinalColor
+    mov [eax], cx
+    jmp @Quit
+   @Not16Bit:
+    cmp Bits, 24
+    jne @Not24bit
+    mov ecx, 0
+    add ecx, eax
+    shl ecx, 1
+    add ecx, eax
+    mov eax, ecx
+    jmp @32bit
+   @Not24bit:
+    shl eax, 2
+   @32bit:
+    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x * 2
+    mov ecx, [eax]
+    mov FinalColor, ecx
+    and FinalColor, $ff000000
+    and ecx, $00ffffff
+    mov SrcColor, ecx
+    mov edx, Color
+    and ecx, $000000ff
+    and edx, $000000ff
+    add ecx, edx
+    cmp ecx, $000000ff
+    jbe @Skip1_32bit
+    mov ecx, $000000ff
+   @Skip1_32bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $0000ff00
+    and edx, $0000ff00
+    add ecx, edx
+    cmp ecx, $0000ff00
+    jbe @Skip2_32bit
+    mov ecx, $0000ff00
+   @Skip2_32bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $00ff0000
+    and edx, $00ff0000
+    add ecx, edx
+    cmp ecx, $00ff0000
+    jbe @Skip3_32bit
+    mov ecx, $00ff0000
+   @Skip3_32bit:
+    or ecx, FinalColor
+    mov [eax], ecx
+   @Quit:
+  end;
+end;
+
+procedure SDL_SubPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
+  cardinal );
+var
+  SrcColor, FinalColor : cardinal;
+  Addr, Pitch, Bits : cardinal;
+begin
+  if Color = 0 then
+    exit;
+  Addr := cardinal( SrcSurface.Pixels );
+  Pitch := SrcSurface.Pitch;
+  Bits := SrcSurface.format.BitsPerPixel;
+  asm
+    mov eax, y
+    mul Pitch      // EAX := y * Pitch
+    add Addr, eax  // Addr:= Addr + (y * Pitch)
+    mov eax, x
+    cmp Bits, 8
+    jne @Not8bit
+    add eax, Addr  // Now:   EAX:= Addr + (y * Pitch) + x
+    mov cl, [eax]
+    movzx ecx, cl
+    mov SrcColor, ecx
+    mov edx, Color
+    and ecx, 3
+    and edx, 3
+    sub ecx, edx
+    jns @Skip1_8bit
+    mov ecx, 0
+   @Skip1_8bit:
+    mov FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $1c
+    and edx, $1c
+    sub ecx, edx
+    jns @Skip2_8bit
+    mov ecx, 0
+   @Skip2_8bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $e0
+    and edx, $e0
+    sub ecx, edx
+    jns @Skip3_8bit
+    mov ecx, 0
+   @Skip3_8bit:
+    or ecx, FinalColor
+    mov [eax], cl
+    jmp @Quit
+   @Not8bit:
+    cmp Bits, 15
+    jne @Not15bit
+    shl eax, 1
+    add eax, Addr
+    mov ecx, [eax]
+    and ecx, $00007fff
+    mov SrcColor, ecx
+    mov edx, Color
+    and ecx, $1f
+    and edx, $1f
+    sub ecx, edx
+    jns @Skip1_15bit
+    mov ecx, 0
+   @Skip1_15bit:
+    mov FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $03e0
+    and edx, $03e0
+    sub ecx, edx
+    jns @Skip2_15bit
+    mov ecx, 0
+   @Skip2_15bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $7c00
+    and edx, $7c00
+    sub ecx, edx
+    jns @Skip3_15bit
+    mov ecx, 0
+   @Skip3_15bit:
+    or ecx, FinalColor
+    mov [eax], cx
+    jmp @Quit
+   @Not15Bit:
+    cmp Bits, 16
+    jne @Not16bit
+    shl eax, 1
+    add eax, Addr
+    mov ecx, [eax]
+    and ecx, $0000ffff
+    mov SrcColor, ecx
+    mov edx, Color
+    and ecx, $1f
+    and edx, $1f
+    sub ecx, edx
+    jns @Skip1_16bit
+    mov ecx, 0
+   @Skip1_16bit:
+    mov FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $07e0
+    and edx, $07e0
+    sub ecx, edx
+    jns @Skip2_16bit
+    mov ecx, 0
+   @Skip2_16bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $f800
+    and edx, $f800
+    sub ecx, edx
+    jns @Skip3_16bit
+    mov ecx, 0
+   @Skip3_16bit:
+    or ecx, FinalColor
+    mov [eax], cx
+    jmp @Quit
+   @Not16Bit:
+    cmp Bits, 24
+    jne @Not24bit
+    mov ecx, 0
+    add ecx, eax
+    shl ecx, 1
+    add ecx, eax
+    mov eax, ecx
+    jmp @32bit
+   @Not24bit:
+    shl eax, 2
+   @32bit:
+    add eax, Addr
+    mov ecx, [eax]
+    mov FinalColor, ecx
+    and FinalColor, $ff000000
+    and ecx, $00ffffff
+    mov SrcColor, ecx
+    mov edx, Color
+    and ecx, $000000ff
+    and edx, $000000ff
+    sub ecx, edx
+    jns @Skip1_32bit
+    mov ecx, 0
+   @Skip1_32bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $0000ff00
+    and edx, $0000ff00
+    sub ecx, edx
+    jns @Skip2_32bit
+    mov ecx, 0
+   @Skip2_32bit:
+    or FinalColor, ecx
+    mov ecx, SrcColor
+    mov edx, Color
+    and ecx, $00ff0000
+    and edx, $00ff0000
+    sub ecx, edx
+    jns @Skip3_32bit
+    mov ecx, 0
+   @Skip3_32bit:
+    or ecx, FinalColor
+    mov [eax], ecx
+   @Quit:
+  end;
+end;
+
+// Draw a line between x1,y1 and x2,y2 to the given surface
+// NOTE: The surface must be locked before calling this!
+procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+var
+  dx, dy, sdx, sdy, x, y, px, py : integer;
+begin
+  dx := x2 - x1;
+  dy := y2 - y1;
+  if dx < 0 then
+    sdx := -1
+  else
+    sdx := 1;
+  if dy < 0 then
+    sdy := -1
+  else
+    sdy := 1;
+  dx := sdx * dx + 1;
+  dy := sdy * dy + 1;
+  x := 0;
+  y := 0;
+  px := x1;
+  py := y1;
+  if dx >= dy then
+  begin
+    for x := 0 to dx - 1 do
+    begin
+      SDL_PutPixel( DstSurface, px, py, Color );
+      y := y + dy;
+      if y >= dx then
+      begin
+        y := y - dx;
+        py := py + sdy;
+      end;
+      px := px + sdx;
+    end;
+  end
+  else
+  begin
+    for y := 0 to dy - 1 do
+    begin
+      SDL_PutPixel( DstSurface, px, py, Color );
+      x := x + dx;
+      if x >= dy then
+      begin
+        x := x - dy;
+        px := px + sdx;
+      end;
+      py := py + sdy;
+    end;
+  end;
+end;
+
+// Draw a dashed line between x1,y1 and x2,y2 to the given surface
+// NOTE: The surface must be locked before calling this!
+procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal ; DashLength, DashSpace : byte );  overload;
+var
+  dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean;
+begin
+  counter := 0;
+  drawdash := true; //begin line drawing with dash
+
+  //Avoid invalid user-passed dash parameters
+  if (DashLength < 1)
+  then DashLength := 1;
+  if (DashSpace < 1)
+  then DashSpace := 0;
+
+  dx := x2 - x1;
+  dy := y2 - y1;
+  if dx < 0 then
+    sdx := -1
+  else
+    sdx := 1;
+  if dy < 0 then
+    sdy := -1
+  else
+    sdy := 1;
+  dx := sdx * dx + 1;
+  dy := sdy * dy + 1;
+  x := 0;
+  y := 0;
+  px := x1;
+  py := y1;
+  if dx >= dy then
+  begin
+    for x := 0 to dx - 1 do
+      begin
+
+      //Alternate drawing dashes, or leaving spaces
+      if drawdash then
+        begin
+          SDL_PutPixel( DstSurface, px, py, Color );
+          inc(counter);
+          if (counter > DashLength-1) and (DashSpace > 0) then
+            begin
+              drawdash := false;
+              counter := 0;
+            end;
+        end
+      else //space
+        begin
+          inc(counter);
+          if counter > DashSpace-1 then
+            begin
+              drawdash := true;
+              counter := 0;
+            end;
+        end;
+
+      y := y + dy;
+      if y >= dx then
+      begin
+        y := y - dx;
+        py := py + sdy;
+      end;
+      px := px + sdx;
+    end;
+  end
+  else
+  begin
+    for y := 0 to dy - 1 do
+    begin
+
+      //Alternate drawing dashes, or leaving spaces
+      if drawdash then
+        begin
+          SDL_PutPixel( DstSurface, px, py, Color );
+          inc(counter);
+          if (counter > DashLength-1) and (DashSpace > 0) then
+            begin
+              drawdash := false;
+              counter := 0;
+            end;
+        end
+      else //space
+        begin
+          inc(counter);
+          if counter > DashSpace-1 then
+            begin
+              drawdash := true;
+              counter := 0;
+            end;
+        end;
+
+      x := x + dx;
+      if x >= dy then
+      begin
+        x := x - dy;
+        px := px + sdx;
+      end;
+      py := py + sdy;
+    end;
+  end;
+end;
+
+procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+var
+  dx, dy, sdx, sdy, x, y, px, py : integer;
+begin
+  dx := x2 - x1;
+  dy := y2 - y1;
+  if dx < 0 then
+    sdx := -1
+  else
+    sdx := 1;
+  if dy < 0 then
+    sdy := -1
+  else
+    sdy := 1;
+  dx := sdx * dx + 1;
+  dy := sdy * dy + 1;
+  x := 0;
+  y := 0;
+  px := x1;
+  py := y1;
+  if dx >= dy then
+  begin
+    for x := 0 to dx - 1 do
+    begin
+      SDL_AddPixel( DstSurface, px, py, Color );
+      y := y + dy;
+      if y >= dx then
+      begin
+        y := y - dx;
+        py := py + sdy;
+      end;
+      px := px + sdx;
+    end;
+  end
+  else
+  begin
+    for y := 0 to dy - 1 do
+    begin
+      SDL_AddPixel( DstSurface, px, py, Color );
+      x := x + dx;
+      if x >= dy then
+      begin
+        x := x - dy;
+        px := px + sdx;
+      end;
+      py := py + sdy;
+    end;
+  end;
+end;
+
+procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+var
+  dx, dy, sdx, sdy, x, y, px, py : integer;
+begin
+  dx := x2 - x1;
+  dy := y2 - y1;
+  if dx < 0 then
+    sdx := -1
+  else
+    sdx := 1;
+  if dy < 0 then
+    sdy := -1
+  else
+    sdy := 1;
+  dx := sdx * dx + 1;
+  dy := sdy * dy + 1;
+  x := 0;
+  y := 0;
+  px := x1;
+  py := y1;
+  if dx >= dy then
+  begin
+    for x := 0 to dx - 1 do
+    begin
+      SDL_SubPixel( DstSurface, px, py, Color );
+      y := y + dy;
+      if y >= dx then
+      begin
+        y := y - dx;
+        py := py + sdy;
+      end;
+      px := px + sdx;
+    end;
+  end
+  else
+  begin
+    for y := 0 to dy - 1 do
+    begin
+      SDL_SubPixel( DstSurface, px, py, Color );
+      x := x + dx;
+      if x >= dy then
+      begin
+        x := x - dy;
+        px := px + sdx;
+      end;
+      py := py + sdy;
+    end;
+  end;
+end;
+
+// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces.
+// In 8 bit color depth mode the procedure works with the default packed
+//  palette (RRRGGGBB). It handles all clipping.
+procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DstSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  Src, Dest : TSDL_Rect;
+  Diff : integer;
+  SrcAddr, DestAddr : cardinal;
+  // TransparentColor: cardinal;
+  _ebx, _esi, _edi, _esp : cardinal;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DstSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DstSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    //    TransparentColor := format.ColorKey;
+  end;
+  with DstSurface^ do
+  begin
+    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DstSurface );
+  case bits of
+    8 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        cmp al, 0
+        je @SkipColor         // if AL=0 or AL=transparent color then skip everything
+        mov esp, eax          // ESP - source color
+        mov bl, [edi]         // BL := destination color
+        mov dl, bl            // DL := destination color
+        and ax, $03           // Adding BLUE
+        and bl, $03
+        add al, bl
+        cmp al, $03
+        jbe @Skip1
+        mov al, $03
+       @Skip1:
+        mov cl, al
+        mov eax, esp          // Adding GREEN
+        mov bl, dl
+        and al, $1c
+        and bl, $1c
+        add al, bl
+        cmp al, $1c
+        jbe @Skip2
+        mov al, $1c
+       @Skip2:
+        or cl, al
+        mov eax, esp          // Adding RED
+        mov bl, dl
+        and ax, $e0
+        and bx, $e0
+        add ax, bx
+        cmp ax, $e0
+        jbe @Skip3
+        mov al, $e0
+       @Skip3:
+        or cl, al
+        mov [edi], cl
+       @SkipColor:
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    15 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax          // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AX := source color
+        cmp ax, 0
+        je @SkipColor         // if AX=0 then skip everything
+        mov esp, eax          // ESP - source color
+        mov bx, [edi]         // BX := destination color
+        mov dx, bx            // DX := destination color
+        and ax, $001F         // Adding BLUE
+        and bx, $001F
+        add ax, bx
+        cmp ax, $001F
+        jbe @Skip1
+        mov ax, $001F
+       @Skip1:
+        mov cx, ax
+        mov eax, esp          // Adding GREEN
+        mov bx, dx
+        and ax, $3E0
+        and bx, $3E0
+        add ax, bx
+        cmp ax, $3E0
+        jbe @Skip2
+        mov ax, $3E0
+       @Skip2:
+        or cx, ax
+        mov eax, esp          // Adding RED
+        mov bx, dx
+        and ax, $7C00
+        and bx, $7C00
+        add ax, bx
+        cmp ax, $7C00
+        jbe @Skip3
+        mov ax, $7C00
+       @Skip3:
+        or cx, ax
+        mov [edi], cx
+       @SkipColor:
+        add esi, 2
+        add edi, 2
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    16 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AX := source color
+        cmp ax, 0
+        je @SkipColor         // if AX=0 then skip everything
+        mov esp, eax          // ESP - source color
+        mov bx, [edi]         // BX := destination color
+        mov dx, bx            // DX := destination color
+        and ax, $1F           // Adding BLUE
+        and bx, $1F
+        add ax, bx
+        cmp ax, $1F
+        jbe @Skip1
+        mov ax, $1F
+       @Skip1:
+        mov cx, ax
+        mov eax, esp          // Adding GREEN
+        mov bx, dx
+        and ax, $7E0
+        and bx, $7E0
+        add ax, bx
+        cmp ax, $7E0
+        jbe @Skip2
+        mov ax, $7E0
+       @Skip2:
+        or cx, ax
+        mov eax, esp          // Adding RED
+        mov bx, dx
+        and eax, $F800
+        and ebx, $F800
+        add eax, ebx
+        cmp eax, $F800
+        jbe @Skip3
+        mov ax, $F800
+       @Skip3:
+        or cx, ax
+        mov [edi], cx
+       @SkipColor:
+        add esi, 2
+        add edi, 2
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    24 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       add WorkX, ax         // WorkX := Src.w * 2
+       add WorkX, ax         // WorkX := Src.w * 3
+       @Loopx:
+        mov bl, [edi]         // BX := destination color
+        mov al, [esi]         // AX := source color
+        cmp al, 0
+        je @Skip              // if AL=0 then skip COMPONENT
+        mov ah, 0             // AX := COLOR COMPONENT
+        mov bh, 0
+        add bx, ax
+        cmp bx, $00ff
+        jb @Skip
+        mov bl, $ff
+       @Skip:
+        mov [edi], bl
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    32 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       shl ax, 2
+       mov WorkX, ax         // WorkX := Src.w * 4
+       @Loopx:
+        mov bl, [edi]         // BX := destination color
+        mov al, [esi]         // AX := source color
+        cmp al, 0
+        je @Skip              // if AL=0 then skip COMPONENT
+        mov ah, 0             // AX := COLOR COMPONENT
+        mov bh, 0
+        add bx, ax
+        cmp bx, $00ff
+        jb @Skip
+        mov bl, $ff
+       @Skip:
+        mov [edi], bl
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DstSurface );
+end;
+
+procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DstSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  Src, Dest : TSDL_Rect;
+  Diff : integer;
+  SrcAddr, DestAddr : cardinal;
+  _ebx, _esi, _edi, _esp : cardinal;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DstSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DstSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+  end;
+  with DstSurface^ do
+  begin
+    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := DstSurface.Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DstSurface );
+  case bits of
+    8 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        cmp al, 0
+        je @SkipColor         // if AL=0 then skip everything
+        mov esp, eax          // ESP - source color
+        mov bl, [edi]         // BL := destination color
+        mov dl, bl            // DL := destination color
+        and al, $03           // Subtract BLUE
+        and bl, $03
+        sub bl, al
+        jns @Skip1
+        mov bl, 0
+       @Skip1:
+        mov cl, bl
+        mov eax, esp          // Subtract GREEN
+        mov bl, dl
+        and al, $1c
+        and bl, $1c
+        sub bl, al
+        jns @Skip2
+        mov bl, 0
+       @Skip2:
+        or cl, bl
+        mov eax, esp          // Subtract RED
+        mov bl, dl
+        and ax, $e0
+        and bx, $e0
+        sub bx, ax
+        jns @Skip3
+        mov bl, 0
+       @Skip3:
+        or cl, bl
+        mov [edi], cl
+       @SkipColor:
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    15 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax          // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AX := source color
+        cmp ax, 0
+        je @SkipColor         // if AX=0 then skip everything
+        mov esp, eax          // ESP - source color
+        mov bx, [edi]         // BX := destination color
+        mov dx, bx            // DX := destination color
+        and ax, $001F         // Subtract BLUE
+        and bx, $001F
+        sub bx, ax
+        jns @Skip1
+        mov bx, 0
+       @Skip1:
+        mov cx, bx
+        mov eax, esp          // Subtract GREEN
+        mov bx, dx
+        and ax, $3E0
+        and bx, $3E0
+        sub bx, ax
+        jns @Skip2
+        mov bx, 0
+       @Skip2:
+        or cx, bx
+        mov eax, esp          // Subtract RED
+        mov bx, dx
+        and ax, $7C00
+        and bx, $7C00
+        sub bx, ax
+        jns @Skip3
+        mov bx, 0
+       @Skip3:
+        or cx, bx
+        mov [edi], cx
+       @SkipColor:
+        add esi, 2
+        add edi, 2
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    16 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AX := source color
+        cmp ax, 0
+        je @SkipColor         // if AX=0 then skip everything
+        mov esp, eax          // ESP - source color
+        mov bx, [edi]         // BX := destination color
+        mov dx, bx            // DX := destination color
+        and ax, $1F           // Subtracting BLUE
+        and bx, $1F
+        sub bx, ax
+        jns @Skip1
+        mov bx, 0
+       @Skip1:
+        mov cx, bx
+        mov eax, esp          // Adding GREEN
+        mov bx, dx
+        and ax, $7E0
+        and bx, $7E0
+        sub bx, ax
+        jns @Skip2
+        mov bx, 0
+       @Skip2:
+        or cx, bx
+        mov eax, esp          // Adding RED
+        mov bx, dx
+        and eax, $F800
+        and ebx, $F800
+        sub ebx, eax
+        jns @Skip3
+        mov bx, 0
+       @Skip3:
+        or cx, bx
+        mov [edi], cx
+       @SkipColor:
+        add esi, 2
+        add edi, 2
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    24 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       add WorkX, ax         // WorkX := Src.w * 2
+       add WorkX, ax         // WorkX := Src.w * 3
+       @Loopx:
+        mov bl, [edi]         // BX := destination color
+        mov al, [esi]         // AX := source color
+        cmp al, 0
+        je @Skip              // if AL=0 then skip COMPONENT
+        mov ah, 0             // AX := COLOR COMPONENT
+        mov bh, 0
+        sub bx, ax
+        jns @Skip
+        mov bl, 0
+       @Skip:
+        mov [edi], bl
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    32 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       shl ax, 2
+       mov WorkX, ax         // WorkX := Src.w * 4
+       @Loopx:
+        mov bl, [edi]         // BX := destination color
+        mov al, [esi]         // AX := source color
+        cmp al, 0
+        je @Skip              // if AL=0 then skip COMPONENT
+        mov ah, 0             // AX := COLOR COMPONENT
+        mov bh, 0
+        sub bx, ax
+        jns @Skip
+        mov bl, 0
+       @Skip:
+        mov [edi], bl
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DstSurface );
+end;
+
+procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
+var
+  Src, Dest : TSDL_Rect;
+  Diff : integer;
+  SrcAddr, DestAddr : cardinal;
+  _ebx, _esi, _edi, _esp : cardinal;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  SrcTransparentColor : cardinal;
+  Bits : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DstSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DstSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    SrcTransparentColor := format.colorkey;
+  end;
+  with DstSurface^ do
+  begin
+    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := DstSurface.Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DstSurface );
+  case bits of
+    8 :
+      asm
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      mov ecx, Color
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        movzx eax, al
+        cmp eax, SrcTransparentColor
+        je @SkipColor         // if AL=Transparent color then skip everything
+        mov [edi], cl
+       @SkipColor:
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      end;
+    15, 16 :
+      asm
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      mov ecx, Color
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AX := source color
+        movzx eax, ax
+        cmp eax, SrcTransparentColor
+        je @SkipColor         // if AX=Transparent color then skip everything
+        mov [edi], cx
+       @SkipColor:
+        inc esi
+        inc esi
+        inc edi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      end;
+    24 :
+      asm
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov _ebx, ebx
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      mov ecx, Color
+      and ecx, $00ffffff
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov eax, [esi]         // EAX := source color
+        and eax, $00ffffff
+        cmp eax, SrcTransparentColor
+        je @SkipColor         // if EAX=Transparent color then skip everything
+        mov ebx, [edi]
+        and ebx, $ff000000
+        or ebx, ecx
+        mov [edi], ecx
+       @SkipColor:
+        add esi, 3
+        add edi, 3
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp, _esp
+      mov edi, _edi
+      mov esi, _esi
+      mov ebx, _ebx
+      end;
+    32 :
+      asm
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      mov ecx, Color
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov eax, [esi]         // EAX := source color
+        cmp eax, SrcTransparentColor
+        je @SkipColor         // if EAX=Transparent color then skip everything
+        mov [edi], ecx
+       @SkipColor:
+        add esi, 4
+        add edi, 4
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp, _esp
+      mov edi, _edi
+      mov esi, _esi
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DstSurface );
+end;
+// TextureRect.w and TextureRect.h are not used.
+// The TextureSurface's size MUST larger than the drawing rectangle!!!
+
+procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
+  TextureRect : PSDL_Rect );
+var
+  Src, Dest : TSDL_Rect;
+  Diff : integer;
+  SrcAddr, DestAddr, TextAddr : cardinal;
+  _ebx, _esi, _edi, _esp : cardinal;
+  WorkX, WorkY : word;
+  SrcMod, DestMod, TextMod : cardinal;
+  SrcTransparentColor : cardinal;
+  Bits : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DstSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DstSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    SrcTransparentColor := format.colorkey;
+  end;
+  with DstSurface^ do
+  begin
+    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := DstSurface.Format.BitsPerPixel;
+  end;
+  with Texture^ do
+  begin
+    TextAddr := cardinal( Pixels ) + UInt32( TextureRect.y ) * Pitch +
+      UInt32( TextureRect.x ) * Format.BytesPerPixel;
+    TextMod := Pitch - Src.w * Format.BytesPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DstSurface );
+  SDL_LockSurface( Texture );
+  case bits of
+    8 :
+      asm
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov _ebx, ebx
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ebx, TextAddr
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        movzx eax, al
+        cmp eax, SrcTransparentColor
+        je @SkipColor         // if AL=Transparent color then skip everything
+        mov al, [ebx]
+        mov [edi], al
+       @SkipColor:
+        inc esi
+        inc edi
+        inc ebx
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       add ebx, TextMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx, _ebx
+      end;
+    15, 16 :
+      asm
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ecx, TextAddr
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AL := source color
+        movzx eax, ax
+        cmp eax, SrcTransparentColor
+        je @SkipColor         // if AL=Transparent color then skip everything
+        mov ax, [ecx]
+        mov [edi], ax
+       @SkipColor:
+        inc esi
+        inc esi
+        inc edi
+        inc edi
+        inc ecx
+        inc ecx
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       add ecx, TextMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      end;
+    24 :
+      asm
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov _ebx, ebx
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ebx, TextAddr
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov eax, [esi]         // AL := source color
+        and eax, $00ffffff
+        cmp eax, SrcTransparentColor
+        je @SkipColor         // if AL=Transparent color then skip everything
+        mov eax, [ebx]
+        and eax, $00ffffff
+        mov ecx, [edi]
+        and ecx, $ff000000
+        or ecx, eax
+        mov [edi], eax
+       @SkipColor:
+        add esi, 3
+        add edi, 3
+        add ebx, 3
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       add ebx, TextMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx, _ebx
+      end;
+    32 :
+      asm
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ecx, TextAddr
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov eax, [esi]         // AL := source color
+        cmp eax, SrcTransparentColor
+        je @SkipColor         // if AL=Transparent color then skip everything
+        mov eax, [ecx]
+        mov [edi], eax
+       @SkipColor:
+        add esi, 4
+        add edi, 4
+        add ecx, 4
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       add ecx, TextMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DstSurface );
+  SDL_UnlockSurface( Texture );
+end;
+
+procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
+var
+  xc, yc : cardinal;
+  rx, wx, ry, wy, ry16 : cardinal;
+  color : cardinal;
+  modx, mody : cardinal;
+begin
+  // Warning! No checks for surface pointers!!!
+  if srcrect = nil then
+    srcrect := @SrcSurface.clip_rect;
+  if dstrect = nil then
+    dstrect := @DstSurface.clip_rect;
+  if SDL_MustLock( SrcSurface ) then
+    SDL_LockSurface( SrcSurface );
+  if SDL_MustLock( DstSurface ) then
+    SDL_LockSurface( DstSurface );
+  modx := trunc( ( srcrect.w / dstrect.w ) * 65536 );
+  mody := trunc( ( srcrect.h / dstrect.h ) * 65536 );
+  //rx := srcrect.x * 65536;
+  ry := srcrect.y * 65536;
+  wy := dstrect.y;
+  for yc := 0 to dstrect.h - 1 do
+  begin
+    rx := srcrect.x * 65536;
+    wx := dstrect.x;
+    ry16 := ry shr 16;
+    for xc := 0 to dstrect.w - 1 do
+    begin
+      color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 );
+      SDL_PutPixel( DstSurface, wx, wy, color );
+      rx := rx + modx;
+      inc( wx );
+    end;
+    ry := ry + mody;
+    inc( wy );
+  end;
+  if SDL_MustLock( SrcSurface ) then
+    SDL_UnlockSurface( SrcSurface );
+  if SDL_MustLock( DstSurface ) then
+    SDL_UnlockSurface( DstSurface );
+end;
+// Re-map a rectangular area into an area defined by four vertices
+// Converted from C to Pascal by KiCHY
+
+procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
+const
+  SHIFTS = 15; // Extend ints to limit round-off error (try 2 - 20)
+  THRESH = 1 shl SHIFTS; // Threshold for pixel size value
+  procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal );
+  var
+    tm, lm, rm, bm, m : TPoint;
+    mx, my : cardinal;
+    cr : cardinal;
+  begin
+    // Does the destination area specify a single pixel?
+    if ( ( abs( ul.x - ur.x ) < THRESH ) and
+      ( abs( ul.x - lr.x ) < THRESH ) and
+      ( abs( ul.x - ll.x ) < THRESH ) and
+      ( abs( ul.y - ur.y ) < THRESH ) and
+      ( abs( ul.y - lr.y ) < THRESH ) and
+      ( abs( ul.y - ll.y ) < THRESH ) ) then
+    begin // Yes
+      cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) );
+      SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr );
+    end
+    else
+    begin // No
+      // Quarter the source and the destination, and then recurse
+      tm.x := ( ul.x + ur.x ) shr 1;
+      tm.y := ( ul.y + ur.y ) shr 1;
+      bm.x := ( ll.x + lr.x ) shr 1;
+      bm.y := ( ll.y + lr.y ) shr 1;
+      lm.x := ( ul.x + ll.x ) shr 1;
+      lm.y := ( ul.y + ll.y ) shr 1;
+      rm.x := ( ur.x + lr.x ) shr 1;
+      rm.y := ( ur.y + lr.y ) shr 1;
+      m.x := ( tm.x + bm.x ) shr 1;
+      m.y := ( tm.y + bm.y ) shr 1;
+      mx := ( x1 + x2 ) shr 1;
+      my := ( y1 + y2 ) shr 1;
+      CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my );
+      CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my );
+      CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 );
+      CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 );
+    end;
+  end;
+var
+  _UL, _UR, _LR, _LL : TPoint;
+  Rect_x, Rect_y, Rect_w, Rect_h : integer;
+begin
+  if SDL_MustLock( SrcSurface ) then
+    SDL_LockSurface( SrcSurface );
+  if SDL_MustLock( DstSurface ) then
+    SDL_LockSurface( DstSurface );
+  if SrcRect = nil then
+  begin
+    Rect_x := 0;
+    Rect_y := 0;
+    Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS;
+    Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS;
+  end
+  else
+  begin
+    Rect_x := SrcRect.x;
+    Rect_y := SrcRect.y;
+    Rect_w := ( SrcRect.w - 1 ) shl SHIFTS;
+    Rect_h := ( SrcRect.h - 1 ) shl SHIFTS;
+  end;
+  // Shift all values to help reduce round-off error.
+  _ul.x := ul.x shl SHIFTS;
+  _ul.y := ul.y shl SHIFTS;
+  _ur.x := ur.x shl SHIFTS;
+  _ur.y := ur.y shl SHIFTS;
+  _lr.x := lr.x shl SHIFTS;
+  _lr.y := lr.y shl SHIFTS;
+  _ll.x := ll.x shl SHIFTS;
+  _ll.y := ll.y shl SHIFTS;
+  CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h );
+  if SDL_MustLock( SrcSurface ) then
+    SDL_UnlockSurface( SrcSurface );
+  if SDL_MustLock( DstSurface ) then
+    SDL_UnlockSurface( DstSurface );
+end;
+
+// flips a rectangle vertically on given surface
+procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
+var
+  TmpRect : TSDL_Rect;
+  Locked : boolean;
+  y, FlipLength, RowLength : integer;
+  Row1, Row2 : Pointer;
+  OneRow : TByteArray; // Optimize it if you wish
+begin
+  if DstSurface <> nil then
+  begin
+    if Rect = nil then
+    begin // if Rect=nil then we flip the whole surface
+      TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
+      Rect := @TmpRect;
+    end;
+    FlipLength := Rect^.h shr 1 - 1;
+    RowLength := Rect^.w * DstSurface^.format.BytesPerPixel;
+    if SDL_MustLock( DstSurface ) then
+    begin
+      Locked := true;
+      SDL_LockSurface( DstSurface );
+    end
+    else
+      Locked := false;
+    Row1 := pointer( cardinal( DstSurface^.Pixels ) + UInt32( Rect^.y ) *
+      DstSurface^.Pitch );
+    Row2 := pointer( cardinal( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 )
+      * DstSurface^.Pitch );
+    for y := 0 to FlipLength do
+    begin
+      Move( Row1^, OneRow, RowLength );
+      Move( Row2^, Row1^, RowLength );
+      Move( OneRow, Row2^, RowLength );
+      inc( cardinal( Row1 ), DstSurface^.Pitch );
+      dec( cardinal( Row2 ), DstSurface^.Pitch );
+    end;
+    if Locked then
+      SDL_UnlockSurface( DstSurface );
+  end;
+end;
+
+// flips a rectangle horizontally on given surface
+procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
+type
+  T24bit = packed array[ 0..2 ] of byte;
+  T24bitArray = packed array[ 0..8191 ] of T24bit;
+  P24bitArray = ^T24bitArray;
+  TLongWordArray = array[ 0..8191 ] of LongWord;
+  PLongWordArray = ^TLongWordArray;
+var
+  TmpRect : TSDL_Rect;
+  Row8bit : PByteArray;
+  Row16bit : PWordArray;
+  Row24bit : P24bitArray;
+  Row32bit : PLongWordArray;
+  y, x, RightSide, FlipLength : integer;
+  Pixel : cardinal;
+  Pixel24 : T24bit;
+  Locked : boolean;
+begin
+  if DstSurface <> nil then
+  begin
+    if Rect = nil then
+    begin
+      TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
+      Rect := @TmpRect;
+    end;
+    FlipLength := Rect^.w shr 1 - 1;
+    if SDL_MustLock( DstSurface ) then
+    begin
+      Locked := true;
+      SDL_LockSurface( DstSurface );
+    end
+    else
+      Locked := false;
+    case DstSurface^.format.BytesPerPixel of
+      1 :
+        begin
+          Row8Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
+            DstSurface^.pitch );
+          for y := 1 to Rect^.h do
+          begin
+            RightSide := Rect^.w - 1;
+            for x := 0 to FlipLength do
+            begin
+              Pixel := Row8Bit^[ x ];
+              Row8Bit^[ x ] := Row8Bit^[ RightSide ];
+              Row8Bit^[ RightSide ] := Pixel;
+              dec( RightSide );
+            end;
+            inc( cardinal( Row8Bit ), DstSurface^.pitch );
+          end;
+        end;
+      2 :
+        begin
+          Row16Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
+            DstSurface^.pitch );
+          for y := 1 to Rect^.h do
+          begin
+            RightSide := Rect^.w - 1;
+            for x := 0 to FlipLength do
+            begin
+              Pixel := Row16Bit^[ x ];
+              Row16Bit^[ x ] := Row16Bit^[ RightSide ];
+              Row16Bit^[ RightSide ] := Pixel;
+              dec( RightSide );
+            end;
+            inc( cardinal( Row16Bit ), DstSurface^.pitch );
+          end;
+        end;
+      3 :
+        begin
+          Row24Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
+            DstSurface^.pitch );
+          for y := 1 to Rect^.h do
+          begin
+            RightSide := Rect^.w - 1;
+            for x := 0 to FlipLength do
+            begin
+              Pixel24 := Row24Bit^[ x ];
+              Row24Bit^[ x ] := Row24Bit^[ RightSide ];
+              Row24Bit^[ RightSide ] := Pixel24;
+              dec( RightSide );
+            end;
+            inc( cardinal( Row24Bit ), DstSurface^.pitch );
+          end;
+        end;
+      4 :
+        begin
+          Row32Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
+            DstSurface^.pitch );
+          for y := 1 to Rect^.h do
+          begin
+            RightSide := Rect^.w - 1;
+            for x := 0 to FlipLength do
+            begin
+              Pixel := Row32Bit^[ x ];
+              Row32Bit^[ x ] := Row32Bit^[ RightSide ];
+              Row32Bit^[ RightSide ] := Pixel;
+              dec( RightSide );
+            end;
+            inc( cardinal( Row32Bit ), DstSurface^.pitch );
+          end;
+        end;
+    end;
+    if Locked then
+      SDL_UnlockSurface( DstSurface );
+  end;
+end;
+
+// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer.
+// But you MUST free it after you don't need it anymore!!!
+function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
+var
+  Rect : PSDL_Rect;
+begin
+  New( Rect );
+  with Rect^ do
+  begin
+    x := aLeft;
+    y := aTop;
+    w := aWidth;
+    h := aHeight;
+  end;
+  Result := Rect;
+end;
+
+function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect;
+begin
+  with result do
+  begin
+    x := aLeft;
+    y := aTop;
+    w := aWidth;
+    h := aHeight;
+  end;
+end;
+
+function SDLRect( aRect : TRect ) : TSDL_Rect;
+begin
+  with aRect do
+    result := SDLRect( Left, Top, Right - Left, Bottom - Top );
+end;
+
+procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw,
+  depth : integer );
+var
+  dx, dy, e, d, dx2 : integer;
+  src_pitch, dst_pitch : uint16;
+  src_pixels, dst_pixels : PUint8;
+begin
+  if ( yw >= dst_surface^.h ) then
+    exit;
+  dx := ( x2 - x1 );
+  dy := ( y2 - y1 );
+  dy := dy shl 1;
+  e := dy - dx;
+  dx2 := dx shl 1;
+  src_pitch := Surface^.pitch;
+  dst_pitch := dst_surface^.pitch;
+  src_pixels := PUint8( integer( Surface^.pixels ) + yr * src_pitch + y1 * depth );
+  dst_pixels := PUint8( integer( dst_surface^.pixels ) + yw * dst_pitch + x1 *
+    depth );
+  for d := 0 to dx - 1 do
+  begin
+    move( src_pixels^, dst_pixels^, depth );
+    while ( e >= 0 ) do
+    begin
+      inc( src_pixels, depth );
+      e := e - dx2;
+    end;
+    inc( dst_pixels, depth );
+    e := e + dy;
+  end;
+end;
+
+function sign( x : integer ) : integer;
+begin
+  if x > 0 then
+    result := 1
+  else
+    result := -1;
+end;
+
+// Stretches a part of a surface
+function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
+  Width, Height : integer ) : PSDL_Surface;
+var
+  dst_surface : PSDL_Surface;
+  dx, dy, e, d, dx2, srcx2, srcy2 : integer;
+  destx1, desty1 : integer;
+begin
+  srcx2 := srcx1 + SrcW;
+  srcy2 := srcy1 + SrcH;
+  result := nil;
+  destx1 := 0;
+  desty1 := 0;
+  dx := abs( integer( Height - desty1 ) );
+  dy := abs( integer( SrcY2 - SrcY1 ) );
+  e := ( dy shl 1 ) - dx;
+  dx2 := dx shl 1;
+  dy := dy shl 1;
+  dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height -
+      desty1,
+      SrcSurface^.Format^.BitsPerPixel,
+      SrcSurface^.Format^.RMask,
+      SrcSurface^.Format^.GMask,
+      SrcSurface^.Format^.BMask,
+      SrcSurface^.Format^.AMask );
+  if ( dst_surface^.format^.BytesPerPixel = 1 ) then
+    SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
+  SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey );
+  if ( SDL_MustLock( dst_surface ) ) then
+    if ( SDL_LockSurface( dst_surface ) < 0 ) then
+      exit;
+  for d := 0 to dx - 1 do
+  begin
+    SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1,
+      SrcSurface^.format^.BytesPerPixel );
+    while e >= 0 do
+    begin
+      inc( SrcY1 );
+      e := e - dx2;
+    end;
+    inc( desty1 );
+    e := e + dy;
+  end;
+  if SDL_MUSTLOCK( dst_surface ) then
+    SDL_UnlockSurface( dst_surface );
+  result := dst_surface;
+end;
+
+procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
+var
+  r1, r2 : TSDL_Rect;
+  //buffer: PSDL_Surface;
+  YPos : Integer;
+begin
+  if ( DstSurface <> nil ) and ( DifY <> 0 ) then
+  begin
+    //if DifY > 0 then // going up
+    //begin
+    ypos := 0;
+    r1.x := 0;
+    r2.x := 0;
+    r1.w := DstSurface.w;
+    r2.w := DstSurface.w;
+    r1.h := DifY;
+    r2.h := DifY;
+    while ypos < DstSurface.h do
+    begin
+      r1.y := ypos;
+      r2.y := ypos + DifY;
+      SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 );
+      ypos := ypos + DifY;
+    end;
+    //end
+    //else
+    //begin // Going Down
+    //end;
+  end;
+end;
+
+procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
+var
+  r1, r2 : TSDL_Rect;
+  buffer : PSDL_Surface;
+begin
+  if ( DstSurface <> nil ) and ( DifX <> 0 ) then
+  begin
+    buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2,
+      DstSurface^.h * 2,
+      DstSurface^.Format^.BitsPerPixel,
+      DstSurface^.Format^.RMask,
+      DstSurface^.Format^.GMask,
+      DstSurface^.Format^.BMask,
+      DstSurface^.Format^.AMask );
+    if buffer <> nil then
+    begin
+      if ( buffer^.format^.BytesPerPixel = 1 ) then
+        SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
+      r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h );
+      r2 := SDLRect( 0, 0, buffer^.w, buffer^.h );
+      SDL_BlitSurface( DstSurface, @r1, buffer, @r2 );
+      SDL_BlitSurface( buffer, @r2, DstSurface, @r2 );
+      SDL_FreeSurface( buffer );
+    end;
+  end;
+end;
+
+procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
+  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
+var
+  aSin, aCos : Single;
+  MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer;
+  Colour, TempTransparentColour : UInt32;
+  MAXX, MAXY : Integer;
+begin
+  // Rotate the surface to the target surface.
+  TempTransparentColour := SrcSurface.format.colorkey;
+  if srcRect.w > srcRect.h then
+  begin
+    Width := srcRect.w;
+    Height := srcRect.w;
+  end
+  else
+  begin
+    Width := srcRect.h;
+    Height := srcRect.h;
+  end;
+
+  maxx := DstSurface.w;
+  maxy := DstSurface.h;
+  aCos := cos( Angle );
+  aSin := sin( Angle );
+
+  Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) );
+  Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) );
+
+  OX := Width div 2;
+  OY := Height div 2; ;
+  MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2;
+  MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2;
+  ROX := ( -( srcRect.w div 2 ) ) + Offsetx;
+  ROY := ( -( srcRect.h div 2 ) ) + OffsetY;
+  Tx := ox + round( ROX * aSin - ROY * aCos );
+  Ty := oy + round( ROY * aSin + ROX * aCos );
+  SX := 0;
+  for DX := DestX - TX to DestX - TX + ( width ) do
+  begin
+    Inc( SX );
+    SY := 0;
+    for DY := DestY - TY to DestY - TY + ( Height ) do
+    begin
+      RX := SX - OX;
+      RY := SY - OY;
+      NX := round( mx + RX * aSin + RY * aCos ); //
+      NY := round( my + RY * aSin - RX * aCos ); //
+      // Used for testing only
+     //SDL_PutPixel(DstSurface.SDLSurfacePointer,DX,DY,0);
+      if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then
+      begin
+        if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then
+        begin
+          if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then
+          begin
+            Colour := SDL_GetPixel( SrcSurface, NX, NY );
+            if Colour <> TempTransparentColour then
+            begin
+              SDL_PutPixel( DstSurface, DX, DY, Colour );
+            end;
+          end;
+        end;
+      end;
+      inc( SY );
+    end;
+  end;
+end;
+
+procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
+  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
+begin
+  SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) );
+end;
+
+function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
+var
+  RealRect : TSDL_Rect;
+  OutOfRange : Boolean;
+begin
+  OutOfRange := false;
+  if dstrect = nil then
+  begin
+    RealRect.x := 0;
+    RealRect.y := 0;
+    RealRect.w := DstSurface.w;
+    RealRect.h := DstSurface.h;
+  end
+  else
+  begin
+    if dstrect.x < DstSurface.w then
+    begin
+      RealRect.x := dstrect.x;
+    end
+    else if dstrect.x < 0 then
+    begin
+      realrect.x := 0;
+    end
+    else
+    begin
+      OutOfRange := True;
+    end;
+    if dstrect.y < DstSurface.h then
+    begin
+      RealRect.y := dstrect.y;
+    end
+    else if dstrect.y < 0 then
+    begin
+      realrect.y := 0;
+    end
+    else
+    begin
+      OutOfRange := True;
+    end;
+    if OutOfRange = False then
+    begin
+      if realrect.x + dstrect.w <= DstSurface.w then
+      begin
+        RealRect.w := dstrect.w;
+      end
+      else
+      begin
+        RealRect.w := dstrect.w - realrect.x;
+      end;
+      if realrect.y + dstrect.h <= DstSurface.h then
+      begin
+        RealRect.h := dstrect.h;
+      end
+      else
+      begin
+        RealRect.h := dstrect.h - realrect.y;
+      end;
+    end;
+  end;
+  if OutOfRange = False then
+  begin
+    result := realrect;
+  end
+  else
+  begin
+    realrect.w := 0;
+    realrect.h := 0;
+    realrect.x := 0;
+    realrect.y := 0;
+    result := realrect;
+  end;
+end;
+
+procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
+var
+  RealRect : TSDL_Rect;
+  Addr : pointer;
+  ModX, BPP : cardinal;
+  x, y, R, G, B, SrcColor : cardinal;
+begin
+  RealRect := ValidateSurfaceRect( DstSurface, DstRect );
+  if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
+  begin
+    SDL_LockSurface( DstSurface );
+    BPP := DstSurface.format.BytesPerPixel;
+    with DstSurface^ do
+    begin
+      Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
+      ModX := Pitch - UInt32( RealRect.w ) * BPP;
+    end;
+    case DstSurface.format.BitsPerPixel of
+      8 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $E0 + Color and $E0;
+              G := SrcColor and $1C + Color and $1C;
+              B := SrcColor and $03 + Color and $03;
+              if R > $E0 then
+                R := $E0;
+              if G > $1C then
+                G := $1C;
+              if B > $03 then
+                B := $03;
+              PUInt8( Addr )^ := R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+      15 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $7C00 + Color and $7C00;
+              G := SrcColor and $03E0 + Color and $03E0;
+              B := SrcColor and $001F + Color and $001F;
+              if R > $7C00 then
+                R := $7C00;
+              if G > $03E0 then
+                G := $03E0;
+              if B > $001F then
+                B := $001F;
+              PUInt16( Addr )^ := R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+      16 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $F800 + Color and $F800;
+              G := SrcColor and $07C0 + Color and $07C0;
+              B := SrcColor and $001F + Color and $001F;
+              if R > $F800 then
+                R := $F800;
+              if G > $07C0 then
+                G := $07C0;
+              if B > $001F then
+                B := $001F;
+              PUInt16( Addr )^ := R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+      24 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $00FF0000 + Color and $00FF0000;
+              G := SrcColor and $0000FF00 + Color and $0000FF00;
+              B := SrcColor and $000000FF + Color and $000000FF;
+              if R > $FF0000 then
+                R := $FF0000;
+              if G > $00FF00 then
+                G := $00FF00;
+              if B > $0000FF then
+                B := $0000FF;
+              PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+      32 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $00FF0000 + Color and $00FF0000;
+              G := SrcColor and $0000FF00 + Color and $0000FF00;
+              B := SrcColor and $000000FF + Color and $000000FF;
+              if R > $FF0000 then
+                R := $FF0000;
+              if G > $00FF00 then
+                G := $00FF00;
+              if B > $0000FF then
+                B := $0000FF;
+              PUInt32( Addr )^ := R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+    end;
+    SDL_UnlockSurface( DstSurface );
+  end;
+end;
+
+procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
+var
+  RealRect : TSDL_Rect;
+  Addr : pointer;
+  ModX, BPP : cardinal;
+  x, y, R, G, B, SrcColor : cardinal;
+begin
+  RealRect := ValidateSurfaceRect( DstSurface, DstRect );
+  if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
+  begin
+    SDL_LockSurface( DstSurface );
+    BPP := DstSurface.format.BytesPerPixel;
+    with DstSurface^ do
+    begin
+      Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
+      ModX := Pitch - UInt32( RealRect.w ) * BPP;
+    end;
+    case DstSurface.format.BitsPerPixel of
+      8 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $E0 - Color and $E0;
+              G := SrcColor and $1C - Color and $1C;
+              B := SrcColor and $03 - Color and $03;
+              if R > $E0 then
+                R := 0;
+              if G > $1C then
+                G := 0;
+              if B > $03 then
+                B := 0;
+              PUInt8( Addr )^ := R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+      15 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $7C00 - Color and $7C00;
+              G := SrcColor and $03E0 - Color and $03E0;
+              B := SrcColor and $001F - Color and $001F;
+              if R > $7C00 then
+                R := 0;
+              if G > $03E0 then
+                G := 0;
+              if B > $001F then
+                B := 0;
+              PUInt16( Addr )^ := R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+      16 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $F800 - Color and $F800;
+              G := SrcColor and $07C0 - Color and $07C0;
+              B := SrcColor and $001F - Color and $001F;
+              if R > $F800 then
+                R := 0;
+              if G > $07C0 then
+                G := 0;
+              if B > $001F then
+                B := 0;
+              PUInt16( Addr )^ := R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+      24 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $00FF0000 - Color and $00FF0000;
+              G := SrcColor and $0000FF00 - Color and $0000FF00;
+              B := SrcColor and $000000FF - Color and $000000FF;
+              if R > $FF0000 then
+                R := 0;
+              if G > $00FF00 then
+                G := 0;
+              if B > $0000FF then
+                B := 0;
+              PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+      32 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $00FF0000 - Color and $00FF0000;
+              G := SrcColor and $0000FF00 - Color and $0000FF00;
+              B := SrcColor and $000000FF - Color and $000000FF;
+              if R > $FF0000 then
+                R := 0;
+              if G > $00FF00 then
+                G := 0;
+              if B > $0000FF then
+                B := 0;
+              PUInt32( Addr )^ := R or G or B;
+              inc( UInt32( Addr ), BPP );
+            end;
+            inc( UInt32( Addr ), ModX );
+          end;
+        end;
+    end;
+    SDL_UnlockSurface( DstSurface );
+  end;
+end;
+
+procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
+var
+  FBC : array[ 0..255 ] of Cardinal;
+  // temp vars
+  i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer;
+
+  TempStepV, TempStepH : Single;
+  TempLeft, TempTop, TempHeight, TempWidth : integer;
+  TempRect : TSDL_Rect;
+
+begin
+  // calc FBC
+  YR := StartColor.r;
+  YG := StartColor.g;
+  YB := StartColor.b;
+  SR := YR;
+  SG := YG;
+  SB := YB;
+  DR := EndColor.r - SR;
+  DG := EndColor.g - SG;
+  DB := EndColor.b - SB;
+
+  for i := 0 to 255 do
+  begin
+    FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB );
+    YR := SR + round( DR / 255 * i );
+    YG := SG + round( DG / 255 * i );
+    YB := SB + round( DB / 255 * i );
+  end;
+
+  //  if aStyle = 1 then begin
+  TempStepH := Rect.w / 255;
+  TempStepV := Rect.h / 255;
+  TempHeight := Trunc( TempStepV + 1 );
+  TempWidth := Trunc( TempStepH + 1 );
+  TempTop := 0;
+  TempLeft := 0;
+  TempRect.x := Rect.x;
+  TempRect.y := Rect.y;
+  TempRect.h := Rect.h;
+  TempRect.w := Rect.w;
+
+  case Style of
+    gsHorizontal :
+      begin
+        TempRect.h := TempHeight;
+        for i := 0 to 255 do
+        begin
+          TempRect.y := Rect.y + TempTop;
+          SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
+          TempTop := Trunc( TempStepV * i );
+        end;
+      end;
+    gsVertical :
+      begin
+        TempRect.w := TempWidth;
+        for i := 0 to 255 do
+        begin
+          TempRect.x := Rect.x + TempLeft;
+          SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
+          TempLeft := Trunc( TempStepH * i );
+        end;
+      end;
+  end;
+end;
+
+procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
+var
+  ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
+  SrcPitch, DestPitch, x, y, w, h : UInt32;
+begin
+  if ( Src = nil ) or ( Dest = nil ) then
+    exit;
+  if ( Src.w shl 1 ) < Dest.w then
+    exit;
+  if ( Src.h shl 1 ) < Dest.h then
+    exit;
+
+  if SDL_MustLock( Src ) then
+    SDL_LockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_LockSurface( Dest );
+
+  ReadRow := UInt32( Src.Pixels );
+  WriteRow := UInt32( Dest.Pixels );
+
+  SrcPitch := Src.pitch;
+  DestPitch := Dest.pitch;
+
+  w := Src.w;
+  h := Src.h;
+
+  case Src.format.BytesPerPixel of
+    1 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+           mov ebx, DestPitch
+
+           @LoopX:
+             mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^;
+             mov [edx], al
+             mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^;
+             mov [edx + ebx], al // PUInt8(WriteAddr + DestPitch)^ := PUInt8(ReadAddr)^;
+             mov [edx + ebx + 1], al // PUInt8(WriteAddr + DestPitch + 1)^ := PUInt8(ReadAddr)^;
+
+             inc ecx // inc(ReadAddr);
+             add edx, 2 // inc(WriteAddr, 2);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    2 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+           mov ebx, DestPitch
+
+           @LoopX:
+             mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;
+             mov [edx], ax
+             mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;
+             mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^;
+             mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^;
+
+             add ecx, 2 // inc(ReadAddr, 2);
+             add edx, 4 // inc(WriteAddr, 4);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    3 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+           mov ebx, DestPitch
+
+           @LoopX:
+             mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             and eax, $00ffffff
+             and dword ptr [edx], $ff000000
+             or [edx], eax
+             and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             or [edx + 3], eax
+             and dword ptr [edx + ebx], $00ffffff // (PUInt32(WriteAddr + DestPitch)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             or [edx + ebx], eax
+             and dword ptr [edx + ebx + 3], $00ffffff // (PUInt32(WriteAddr + DestPitch + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             or [edx + ebx + 3], eax
+
+             add ecx, 3 // inc(ReadAddr, 3);
+             add edx, 6 // inc(WriteAddr, 6);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    4 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+           mov ebx, DestPitch
+
+           @LoopX:
+             mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^;
+             mov [edx], eax
+             mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^;
+             mov [edx + ebx], eax // PUInt32(WriteAddr + DestPitch)^ := PUInt32(ReadAddr)^;
+             mov [edx + ebx + 4], eax // PUInt32(WriteAddr + DestPitch + 4)^ := PUInt32(ReadAddr)^;
+
+             add ecx, 4 // inc(ReadAddr, 4);
+             add edx, 8 // inc(WriteAddr, 8);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+  end;
+
+  if SDL_MustLock( Src ) then
+    SDL_UnlockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_UnlockSurface( Dest );
+end;
+
+procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
+var
+  ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
+  SrcPitch, DestPitch, x, y, w, h : UInt32;
+begin
+  if ( Src = nil ) or ( Dest = nil ) then
+    exit;
+  if ( Src.w shl 1 ) < Dest.w then
+    exit;
+  if ( Src.h shl 1 ) < Dest.h then
+    exit;
+
+  if SDL_MustLock( Src ) then
+    SDL_LockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_LockSurface( Dest );
+
+  ReadRow := UInt32( Src.Pixels );
+  WriteRow := UInt32( Dest.Pixels );
+
+  SrcPitch := Src.pitch;
+  DestPitch := Dest.pitch;
+
+  w := Src.w;
+  h := Src.h;
+
+  case Src.format.BytesPerPixel of
+    1 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+
+           @LoopX:
+             mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^;
+             mov [edx], al
+             mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^;
+
+             inc ecx // inc(ReadAddr);
+             add edx, 2 // inc(WriteAddr, 2);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    2 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+
+           @LoopX:
+             mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;
+             mov [edx], ax
+             mov [edx + 2], eax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;
+
+             add ecx, 2 // inc(ReadAddr, 2);
+             add edx, 4 // inc(WriteAddr, 4);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    3 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+
+           @LoopX:
+             mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             and eax, $00ffffff
+             and dword ptr [edx], $ff000000
+             or [edx], eax
+             and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             or [edx + 3], eax
+
+             add ecx, 3 // inc(ReadAddr, 3);
+             add edx, 6 // inc(WriteAddr, 6);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    4 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+
+           @LoopX:
+             mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^;
+             mov [edx], eax
+             mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^;
+
+             add ecx, 4 // inc(ReadAddr, 4);
+             add edx, 8 // inc(WriteAddr, 8);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+  end;
+
+  if SDL_MustLock( Src ) then
+    SDL_UnlockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_UnlockSurface( Dest );
+end;
+
+procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
+var
+  ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
+  SrcPitch, DestPitch, x, y, w, h : UInt32;
+begin
+  if ( Src = nil ) or ( Dest = nil ) then
+    exit;
+  if ( Src.w shl 1 ) < Dest.w then
+    exit;
+  if ( Src.h shl 1 ) < Dest.h then
+    exit;
+
+  if SDL_MustLock( Src ) then
+    SDL_LockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_LockSurface( Dest );
+
+  ReadRow := UInt32( Src.Pixels );
+  WriteRow := UInt32( Dest.Pixels );
+
+  SrcPitch := Src.pitch;
+  DestPitch := Dest.pitch;
+
+  w := Src.w;
+  h := Src.h;
+
+  case Src.format.BitsPerPixel of
+    8 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+           mov ebx, DestPitch
+
+           @LoopX:
+             mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^;
+             mov [edx], al
+             mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^;
+             shr al, 1
+             and al, $6d
+             mov [edx + ebx], al // PUInt8(WriteAddr + DestPitch)^ := PUInt8(ReadAddr)^;
+             mov [edx + ebx + 1], al // PUInt8(WriteAddr + DestPitch + 1)^ := PUInt8(ReadAddr)^;
+
+             inc ecx // inc(ReadAddr);
+             add edx, 2 // inc(WriteAddr, 2);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    15 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+           mov ebx, DestPitch
+
+           @LoopX:
+             mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;
+             mov [edx], ax
+             mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;
+             shr ax, 1
+             and ax, $3def
+             mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^;
+             mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^;
+
+             add ecx, 2 // inc(ReadAddr, 2);
+             add edx, 4 // inc(WriteAddr, 4);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    16 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+           mov ebx, DestPitch
+
+           @LoopX:
+             mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;
+             mov [edx], ax
+             mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;
+             shr ax, 1
+             and ax, $7bef
+             mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^;
+             mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^;
+
+             add ecx, 2 // inc(ReadAddr, 2);
+             add edx, 4 // inc(WriteAddr, 4);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    24 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+           mov ebx, DestPitch
+
+           @LoopX:
+             mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             and eax, $00ffffff
+             and dword ptr [edx], $ff000000
+             or [edx], eax
+             and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             or [edx + 3], eax
+             shr eax, 1
+             and eax, $007f7f7f
+             and dword ptr [edx + ebx], $00ffffff // (PUInt32(WriteAddr + DestPitch)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             or [edx + ebx], eax
+             and dword ptr [edx + ebx + 3], $00ffffff // (PUInt32(WriteAddr + DestPitch + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
+             or [edx + ebx + 3], eax
+
+             add ecx, 3 // inc(ReadAddr, 3);
+             add edx, 6 // inc(WriteAddr, 6);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+    32 :
+      asm
+         push ebx
+         mov eax, h // for y := 1 to Src.h do
+         mov y, eax
+         @LoopY:
+           mov eax, ReadRow // ReadAddr := ReadRow;
+           mov ReadAddr, eax
+
+           mov eax, WriteRow // WriteAddr := WriteRow;
+           mov WriteAddr, eax
+
+           mov eax, w // for x := 1 to Src.w do
+           mov x, eax
+
+           mov ecx, ReadAddr
+           mov edx, WriteAddr
+           mov ebx, DestPitch
+
+           @LoopX:
+             mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^;
+             mov [edx], eax
+             mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^;
+             shr eax, 1
+             and eax, $7f7f7f7f
+             mov [edx + ebx], eax // PUInt32(WriteAddr + DestPitch)^ := PUInt32(ReadAddr)^;
+             mov [edx + ebx + 4], eax // PUInt32(WriteAddr + DestPitch + 4)^ := PUInt32(ReadAddr)^;
+
+             add ecx, 4 // inc(ReadAddr, 4);
+             add edx, 8 // inc(WriteAddr, 8);
+
+             dec x
+           jnz @LoopX
+
+           mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
+           add ReadRow, eax
+
+           mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
+           add WriteRow, eax
+           add WriteRow, eax
+
+           dec y
+         jnz @LoopY
+         pop ebx
+      end;
+  end;
+
+  if SDL_MustLock( Src ) then
+    SDL_UnlockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_UnlockSurface( Dest );
+end;
+
+function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
+boolean;
+var
+  Src_Rect1, Src_Rect2 : TSDL_Rect;
+  right1, bottom1 : integer;
+  right2, bottom2 : integer;
+  Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;
+  Mod1: cardinal;
+  Addr1 : cardinal;
+  BPP : cardinal;
+  Pitch1 : cardinal;
+  TransparentColor1 : cardinal;
+  tx, ty : cardinal;
+  StartTick : cardinal;
+  Color1 : cardinal;
+begin
+  Result := false;
+  if SrcRect1 = nil then
+  begin
+    with Src_Rect1 do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface1.w;
+      h := SrcSurface1.h;
+    end;
+  end
+  else
+    Src_Rect1 := SrcRect1^;
+
+    Src_Rect2 := SrcRect2^;
+  with Src_Rect1 do
+  begin
+    Right1 := Left1 + w;
+    Bottom1 := Top1 + h;
+  end;
+  with Src_Rect2 do
+  begin
+    Right2 := Left2 + w;
+    Bottom2 := Top2 + h;
+  end;
+  if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( 
+Bottom1 <=
+    Top2 ) then
+    exit;
+  if Left1 <= Left2 then
+  begin
+    // 1. left, 2. right
+    Scan1Start := Src_Rect1.x + Left2 - Left1;
+    Scan2Start := Src_Rect2.x;
+    ScanWidth := Right1 - Left2;
+    with Src_Rect2 do
+      if ScanWidth > w then
+        ScanWidth := w;
+  end
+  else
+  begin
+    // 1. right, 2. left
+    Scan1Start := Src_Rect1.x;
+    Scan2Start := Src_Rect2.x + Left1 - Left2;
+    ScanWidth := Right2 - Left1;
+    with Src_Rect1 do
+      if ScanWidth > w then
+        ScanWidth := w;
+  end;
+  with SrcSurface1^ do
+  begin
+    Pitch1 := Pitch;
+    Addr1 := cardinal( Pixels );
+    inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
+    with format^ do
+    begin
+      BPP := BytesPerPixel;
+      TransparentColor1 := colorkey;
+    end;
+  end;
+
+  Mod1 := Pitch1 - ( ScanWidth * BPP );
+
+  inc( Addr1, BPP * Scan1Start );
+
+  if Top1 <= Top2 then
+  begin
+    // 1. up, 2. down
+    ScanHeight := Bottom1 - Top2;
+    if ScanHeight > Src_Rect2.h then
+      ScanHeight := Src_Rect2.h;
+    inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
+  end
+  else
+  begin
+    // 1. down, 2. up
+    ScanHeight := Bottom2 - Top1;
+    if ScanHeight > Src_Rect1.h then
+      ScanHeight := Src_Rect1.h;
+
+  end;
+  case BPP of
+    1 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PByte( Addr1 )^ <> TransparentColor1 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1 );
+
+        end;
+        inc( Addr1, Mod1 );
+
+      end;
+    2 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PWord( Addr1 )^ <> TransparentColor1 )  then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 2 );
+
+        end;
+        inc( Addr1, Mod1 );
+
+      end;
+    3 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
+
+          if ( Color1 <> TransparentColor1 )
+            then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 3 );
+
+        end;
+        inc( Addr1, Mod1 );
+
+      end;
+    4 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PLongWord( Addr1 )^ <> TransparentColor1 )  then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 4 );
+
+        end;
+        inc( Addr1, Mod1 );
+
+      end;
+  end;
+end;
+
+procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  Src, Dest : TSDL_Rect;
+  Diff : integer;
+  SrcAddr, DestAddr, TransparentColor : cardinal;
+  // TransparentColor: cardinal;
+  _ebx, _esi, _edi, _esp : cardinal;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        cmp al, 0
+        je @SkipColor         // if AL=0 or AL=transparent color then skip everything
+        cmp al, byte ptr TransparentColor
+        je @SkipColor
+        or al, [edi]
+        mov [edi], al
+       @SkipColor:
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    15 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax          // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AX := source color
+        cmp ax, 0
+        je @SkipColor         // if AX=0 then skip everything
+        cmp ax, word ptr TransparentColor
+        je @SkipColor
+        or ax, [edi]
+        mov [edi], ax
+       @SkipColor:
+        add esi, 2
+        add edi, 2
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    16 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AX := source color
+        cmp ax, 0
+        je @SkipColor         // if AX=0 then skip everything
+        cmp ax, word ptr TransparentColor
+        je @SkipColor
+        or ax, [edi]
+        mov [edi], ax
+       @SkipColor:
+        add esi, 2
+        add edi, 2
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    24 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       add WorkX, ax         // WorkX := Src.w * 2
+       add WorkX, ax         // WorkX := Src.w * 3
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        or al, [edi]
+        mov [edi], al
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    32 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       shl ax, 2
+       mov WorkX, ax         // WorkX := Src.w * 4
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        or al, [edi]
+        mov [edi], al
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  Src, Dest : TSDL_Rect;
+  Diff : integer;
+  SrcAddr, DestAddr, TransparentColor : cardinal;
+  // TransparentColor: cardinal;
+  _ebx, _esi, _edi, _esp : cardinal;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        cmp al, 0
+        je @SkipColor         // if AL=0 or AL=transparent color then skip everything
+        cmp al, byte ptr TransparentColor
+        je @SkipColor
+        and al, [edi]
+        mov [edi], al
+       @SkipColor:
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    15 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax          // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AX := source color
+        cmp ax, 0
+        je @SkipColor         // if AX=0 then skip everything
+        cmp ax, word ptr TransparentColor
+        je @SkipColor
+        and ax, [edi]
+        mov [edi], ax
+       @SkipColor:
+        add esi, 2
+        add edi, 2
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    16 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       @Loopx:
+        mov ax, [esi]         // AX := source color
+        cmp ax, 0
+        je @SkipColor         // if AX=0 then skip everything
+        cmp ax, word ptr TransparentColor
+        je @SkipColor
+        and ax, [edi]
+        mov [edi], ax
+       @SkipColor:
+        add esi, 2
+        add edi, 2
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    24 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       mov WorkX, ax         // WorkX := Src.w
+       add WorkX, ax         // WorkX := Src.w * 2
+       add WorkX, ax         // WorkX := Src.w * 3
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        and al, [edi]
+        mov [edi], al
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+    32 :
+      asm
+      mov _ebx, ebx
+      mov _esi, esi
+      mov _edi, edi
+      mov _esp, esp
+      mov esi, SrcAddr      // ESI - Source Offset
+      mov edi, DestAddr     // EDI - Destination Offset
+      mov ax, Src.h         //  WorkY := Src.h
+      mov WorkY, ax
+      @LoopY:
+       mov ax, Src.w
+       shl ax, 2
+       mov WorkX, ax         // WorkX := Src.w * 4
+       @Loopx:
+        mov al, [esi]         // AL := source color
+        and al, [edi]
+        mov [edi], al
+        inc esi
+        inc edi
+        dec WorkX
+       jnz @LoopX
+       add esi, SrcMod
+       add edi, DestMod
+       dec WorkY
+      jnz @LoopY
+      mov esp,_esp
+      mov edi,_edi
+      mov esi,_esi
+      mov ebx,_ebx
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+
+procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
+  Src, Dest : TSDL_Rect;
+  Diff : integer;
+  SrcAddr, DestAddr : cardinal;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt8( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt8( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                if Pixel2 and $E0 > Pixel1 and $E0 then R := Pixel2 and $E0 else R := Pixel1 and $E0;
+                if Pixel2 and $1C > Pixel1 and $1C then G := Pixel2 and $1C else G := Pixel1 and $1C;
+                if Pixel2 and $03 > Pixel1 and $03 then B := Pixel2 and $03 else B := Pixel1 and $03;
+
+                if R > $E0 then
+                  R := $E0;
+                if G > $1C then
+                  G := $1C;
+                if B > $03 then
+                  B := $03;
+                PUInt8( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt8( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    15 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+              if Pixel2 and $7C00 > Pixel1 and $7C00 then R := Pixel2 and $7C00 else R := Pixel1 and $7C00;
+              if Pixel2 and $03E0 > Pixel1 and $03E0 then G := Pixel2 and $03E0 else G := Pixel1 and $03E0;
+              if Pixel2 and $001F > Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;
+
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    16 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+              if Pixel2 and $F800 > Pixel1 and $F800 then R := Pixel2 and $F800 else R := Pixel1 and $F800;
+              if Pixel2 and $07E0 > Pixel1 and $07E0 then G := Pixel2 and $07E0 else G := Pixel1 and $07E0;
+              if Pixel2 and $001F > Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;
+
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    24 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
+              if Pixel2 > 0 then
+              begin
+
+              if Pixel2 and $FF0000 > Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;
+              if Pixel2 and $00FF00 > Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;
+              if Pixel2 and $0000FF > Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;
+
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
+              end
+              else
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
+            end;
+            inc( SrcAddr, 3 );
+            inc( DestAddr, 3 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    32 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+              if Pixel2 and $FF0000 > Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;
+              if Pixel2 and $00FF00 > Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;
+              if Pixel2 and $0000FF > Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;
+
+                PUInt32( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt32( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 4 );
+            inc( DestAddr, 4 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+
+procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
+  Src, Dest : TSDL_Rect;
+  Diff : integer;
+  SrcAddr, DestAddr : cardinal;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt8( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt8( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                if Pixel2 and $E0 < Pixel1 and $E0 then R := Pixel2 and $E0 else R := Pixel1 and $E0;
+                if Pixel2 and $1C < Pixel1 and $1C then G := Pixel2 and $1C else G := Pixel1 and $1C;
+                if Pixel2 and $03 < Pixel1 and $03 then B := Pixel2 and $03 else B := Pixel1 and $03;
+
+                if R > $E0 then
+                  R := $E0;
+                if G > $1C then
+                  G := $1C;
+                if B > $03 then
+                  B := $03;
+                PUInt8( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt8( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    15 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+              if Pixel2 and $7C00 < Pixel1 and $7C00 then R := Pixel2 and $7C00 else R := Pixel1 and $7C00;
+              if Pixel2 and $03E0 < Pixel1 and $03E0 then G := Pixel2 and $03E0 else G := Pixel1 and $03E0;
+              if Pixel2 and $001F < Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;
+
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    16 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+              if Pixel2 and $F800 < Pixel1 and $F800 then R := Pixel2 and $F800 else R := Pixel1 and $F800;
+              if Pixel2 and $07E0 < Pixel1 and $07E0 then G := Pixel2 and $07E0 else G := Pixel1 and $07E0;
+              if Pixel2 and $001F < Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;
+
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    24 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
+              if Pixel2 > 0 then
+              begin
+
+              if Pixel2 and $FF0000 < Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;
+              if Pixel2 and $00FF00 < Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;
+              if Pixel2 and $0000FF < Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;
+
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
+              end
+              else
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
+            end;
+            inc( SrcAddr, 3 );
+            inc( DestAddr, 3 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    32 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+              if Pixel2 and $FF0000 < Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;
+              if Pixel2 and $00FF00 < Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;
+              if Pixel2 and $0000FF < Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;
+
+                PUInt32( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt32( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 4 );
+            inc( DestAddr, 4 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+function SDL_ClipLine(var x1,y1,x2,y2: Integer; ClipRect: PSDL_Rect) : boolean;
+var tflag, flag1, flag2: word;
+    txy, xedge, yedge: Integer;
+    slope: single;
+
+  function ClipCode(x,y: Integer): word;
+  begin
+    Result := 0;
+    if x < ClipRect.x then Result := 1;
+    if x >= ClipRect.w + ClipRect.x then Result := Result or 2;
+    if y < ClipRect.y then Result := Result or 4;
+    if y >= ClipRect.h + ClipRect.y then Result := Result or 8;
+  end;
+
+begin
+  flag1 := ClipCode(x1,y1);
+  flag2 := ClipCode(x2,y2);
+  result := true;
+
+  while true do
+  begin
+    if (flag1 or flag2) = 0 then Exit; // all in
+
+    if (flag1 and flag2) <> 0 then
+      begin
+        result := false;
+        Exit; // all out
+      end;
+
+    if flag2 = 0 then
+      begin
+        txy := x1; x1 := x2; x2 := txy;
+        txy := y1; y1 := y2; y2 := txy;
+        tflag := flag1; flag1 := flag2; flag2 := tflag;
+      end;
+
+    if (flag2 and 3) <> 0 then
+      begin
+        if (flag2 and 1) <> 0 then
+          xedge := ClipRect.x
+        else
+          xedge := ClipRect.w + ClipRect.x -1; // back 1 pixel otherwise we end up in a loop
+
+        slope := (y2 - y1) / (x2 - x1);
+        y2 := y1 + Round(slope * (xedge - x1));
+        x2 := xedge;
+      end
+    else
+      begin
+        if (flag2 and 4) <> 0 then
+          yedge := ClipRect.y
+        else
+          yedge := ClipRect.h + ClipRect.y -1; // up 1 pixel otherwise we end up in a loop
+
+        slope := (x2 - x1) / (y2 - y1);
+        x2 := x1 + Round(slope * (yedge - y1));
+        y2 := yedge;
+      end;
+
+    flag2 := ClipCode(x2, y2);
+  end;
+end;
+
+end.
+
+
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
index e1b2347e..094f4e0f 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
@@ -1,923 +1,923 @@
-unit sdlinput;

-{

-  $Id: sdlinput.pas,v 1.9 2007/08/22 21:18:43 savage Exp $

-  

-}

-{******************************************************************************}

-{                                                                              }

-{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }

-{                     SDL Input Wrapper                                        }

-{                                                                              }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Portions created by Dominique Louis are                                      }

-{ Copyright (C) 2003 - 2100 Dominique Louis.                                   }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{   SDL Mouse, Keyboard and Joystick wrapper                                   }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   SDL.dll on Windows platforms                                               }

-{   libSDL-1.1.so.0 on Linux platform                                          }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{ March      12     2003 - DL : Initial creation                               }

-{                                                                              }

-{ February   02     2004 - DL : Added Custom Cursor Support to the Mouse class }

-{

-  $Log: sdlinput.pas,v $

-  Revision 1.9  2007/08/22 21:18:43  savage

-  Thanks to Dean for his MouseDelta patch.

-

-  Revision 1.8  2005/08/03 18:57:32  savage

-  Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class

-

-  Revision 1.7  2004/09/30 22:32:04  savage

-  Updated with slightly different header comments

-

-  Revision 1.6  2004/09/12 21:52:58  savage

-  Slight changes to fix some issues with the sdl classes.

-

-  Revision 1.5  2004/05/10 21:11:49  savage

-  changes required to help get SoAoS off the ground.

-

-  Revision 1.4  2004/05/03 22:38:40  savage

-  Added the ability to enable or disable certain inputs @ runtime. Basically it just does not call UpdateInput if Enabled = false.

-  Can also disable and enable input devices via the InputManager.

-

-  Revision 1.3  2004/04/28 21:27:01  savage

-  Updated Joystick code and event handlers. Needs testing...

-

-  Revision 1.2  2004/02/14 22:36:29  savage

-  Fixed inconsistencies of using LoadLibrary and LoadModule.

-  Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.

-

-  Revision 1.1  2004/02/05 00:08:20  savage

-  Module 1.0 release

-

-

-}

-{******************************************************************************}

-

-interface

-

-{$i jedi-sdl.inc}

-

-uses

-  Classes,

-  sdl;

-

-type

-  TSDLInputType = ( itJoystick , itKeyBoard, itMouse );

-  TSDLInputTypes = set of TSDLInputType;

-

-  TSDLCustomInput = class( TObject )

-  private

-    FEnabled: Boolean;

-  public

-    constructor Create;

-    function UpdateInput( event: TSDL_EVENT ) : Boolean; virtual; abstract;

-    property Enabled : Boolean read FEnabled write FEnabled;

-  end;

-

-  TSDLJoyAxisMoveEvent =  procedure ( Which: UInt8; Axis: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};

-  TSDLJoyBallMoveEvent =  procedure ( Which: UInt8; Ball: UInt8; RelativePos: TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};

-  TSDLJoyHatMoveEvent =  procedure ( Which: UInt8; Hat: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};

-  TSDLJoyButtonEvent =  procedure ( Which: UInt8; Button: UInt8; State: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};

-

-

-  TSDLJoyStick = class( TSDLCustomInput )

-  private

-    FJoystick : PSDL_Joystick;

-    FJoystickIndex : Integer;

-    FJoyAxisMoveEvent : TSDLJoyAxisMoveEvent;

-    FJoyBallMoveEvent : TSDLJoyBallMoveEvent;

-    FJoyHatMoveEvent : TSDLJoyHatMoveEvent;

-    FJoyButtonDownEvent : TSDLJoyButtonEvent;

-    FJoyButtonUpEvent : TSDLJoyButtonEvent;

-    procedure DoAxisMove( Event : TSDL_Event );

-    procedure DoBallMove( Event : TSDL_Event );

-    procedure DoHatMove( Event : TSDL_Event );

-    procedure DoButtonDown( Event : TSDL_Event );

-    procedure DoButtonUp( Event : TSDL_Event );

-    function GetName: PChar;

-    function GetNumAxes: integer;

-    function GetNumBalls: integer;

-    function GetNumButtons: integer;

-    function GetNumHats: integer;

-  public

-    constructor Create( Index : Integer );

-    destructor Destroy; override;

-    procedure Open;

-    procedure Close;

-    function UpdateInput( Event: TSDL_EVENT ) : Boolean; override;

-    property Name : PChar read GetName;

-    property NumAxes : integer read GetNumAxes;

-    property NumBalls : integer read GetNumBalls;

-    property NumButtons : integer read GetNumButtons;

-    property NumHats : integer read GetNumHats;

-    property OnAxisMove : TSDLJoyAxisMoveEvent read FJoyAxisMoveEvent write FJoyAxisMoveEvent;

-    property OnBallMove : TSDLJoyBallMoveEvent read FJoyBallMoveEvent write FJoyBallMoveEvent;

-    property OnHatMove : TSDLJoyHatMoveEvent read FJoyHatMoveEvent write FJoyHatMoveEvent;

-    property OnButtonDown : TSDLJoyButtonEvent read FJoyButtonDownEvent write FJoyButtonDownEvent;

-    property OnButtonUp : TSDLJoyButtonEvent read FJoyButtonUpEvent write FJoyButtonUpEvent;

-  end;

-

-  TSDLJoySticks = class( TObject )

-  private

-    FNumOfJoySticks: Integer;

-    FJoyStickList : TList;

-    function GetJoyStick(Index: integer): TSDLJoyStick;

-    procedure SetJoyStick(Index: integer; const Value: TSDLJoyStick);

-  public

-    constructor Create;

-    destructor Destroy; override;

-    function UpdateInput( event: TSDL_EVENT ) : Boolean;

-    property NumOfJoySticks : Integer read FNumOfJoySticks write FNumOfJoySticks;

-    property JoySticks[ Index : integer ] : TSDLJoyStick read GetJoyStick write SetJoyStick;

-  end;

-

-  TSDLKeyBoardEvent =  procedure ( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};

-

-  TSDLKeyBoard = class( TSDLCustomInput )

-  private

-    FKeys : PKeyStateArr;

-    FOnKeyUp: TSDLKeyBoardEvent;

-    FOnKeyDown: TSDLKeyBoardEvent;

-    procedure DoKeyDown( keysym : PSDL_keysym );

-    procedure DoKeyUp( keysym : PSDL_keysym );

-  public

-    function IsKeyDown( Key : TSDLKey ) : Boolean;

-    function IsKeyUp( Key : TSDLKey ) : Boolean;

-    function UpdateInput( event: TSDL_EVENT ) : Boolean; override;

-    property Keys : PKeyStateArr read FKeys write FKeys;

-    property OnKeyDown : TSDLKeyBoardEvent read FOnKeyDown write FOnKeyDown;

-    property OnKeyUp : TSDLKeyBoardEvent read FOnKeyUp write FOnKeyUp;

-  end;

-

-  TSDLMouseButtonEvent =  procedure ( Button : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};

-  TSDLMouseMoveEvent =  procedure ( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};

-  TSDLMouseWheelEvent =  procedure ( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};

-

-  TSDLCustomCursor = class( TObject )

-  private

-    FFileName : string;

-    FHotPoint: TPoint;

-    procedure SetFileName(const aValue: string );

-    function ScanForChar( str : string; ch : Char; startPos : Integer; lookFor : Boolean ) : Integer;

-  public

-    constructor Create( const aFileName : string; aHotPoint: TPoint );

-    procedure LoadFromFile( const aFileName : string ); virtual; abstract;

-    procedure LoadFromStream( aStream : TStream ); virtual; abstract;

-    procedure Show; virtual; abstract;

-    property FileName : string read FFileName write SetFileName;

-    property HotPoint : TPoint read FHotPoint write FHotPoint;

-  end;

-

-  TSDLXPMCursor = class( TSDLCustomCursor )

-  private

-    FCursor : PSDL_Cursor;

-    procedure FreeCursor;

-  public

-    destructor Destroy; override;

-    procedure LoadFromFile( const aFileName : string ); override;

-    procedure LoadFromStream( aStream : TStream ); override;

-    procedure Show; override;

-  end;

-

-  TSDLCursorList = class( TStringList )

-  protected

-    function GetObject( aIndex : Integer ): TSDLCustomCursor; reintroduce;

-    procedure PutObject( aIndex : Integer; AObject : TSDLCustomCursor); reintroduce;

-  public

-    constructor Create;

-   function AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer; virtual;

-  end;

-

-  TSDLMouse = class( TSDLCustomInput )

-  private

-    FDragging : Boolean;

-    FMousePos : TPoint;

-    FOnMouseUp: TSDLMouseButtonEvent;

-    FOnMouseDown: TSDLMouseButtonEvent;

-    FOnMouseMove: TSDLMouseMoveEvent;

-    FOnMouseWheel: TSDLMouseWheelEvent;

-    FCursorList : TSDLCursorList; // Cursor Pointer

-    procedure DoMouseMove( Event: TSDL_Event );

-    procedure DoMouseDown( Event: TSDL_Event );

-    procedure DoMouseUp( Event: TSDL_Event );

-    procedure DoMouseWheelScroll( Event: TSDL_Event );

-    function GetMousePosition: TPoint;

-    procedure SetMousePosition(const Value: TPoint);

-    function GetMouseDelta: TPoint;

-  public

-    destructor Destroy; override;

-    function UpdateInput( event: TSDL_EVENT ) : Boolean; override;

-    function MouseIsDown( Button : Integer ) : Boolean;

-    function MouseIsUp( Button : Integer ) : Boolean;

-    procedure ShowCursor;

-    procedure HideCursor;

-    property OnMouseDown : TSDLMouseButtonEvent read FOnMouseDown write FOnMouseDown;

-    property OnMouseUp : TSDLMouseButtonEvent read FOnMouseUp write FOnMouseUp;

-    property OnMouseMove : TSDLMouseMoveEvent read FOnMouseMove write FOnMouseMove;

-    property OnMouseWheel : TSDLMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;

-    property MousePosition : TPoint read GetMousePosition write SetMousePosition;

-    property MouseDelta: TPoint read GetMouseDelta;

-    property Cursors : TSDLCursorList read FCursorList write FCursorList;

-  end;

-

-  TSDLInputManager = class( TObject )

-  private

-    FKeyBoard : TSDLKeyBoard;

-    FMouse : TSDLMouse;

-    FJoystick : TSDLJoysticks;

-  public

-    constructor Create( InitInputs : TSDLInputTypes );

-    destructor Destroy; override;

-    procedure Disable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 );

-    procedure Enable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 );

-    function UpdateInputs( event: TSDL_EVENT ) : Boolean;

-    property KeyBoard : TSDLKeyBoard read FKeyBoard write FKeyBoard;

-    property Mouse : TSDLMouse read FMouse write FMouse;

-    property JoyStick : TSDLJoysticks read FJoyStick write FJoyStick;

-  end;

-

-implementation

-

-uses

-  SysUtils;

-

-{ TSDLCustomInput }

-constructor TSDLCustomInput.Create;

-begin

-  inherited;

-  FEnabled := true;

-end;

-

-{ TSDLJoysticks }

-constructor TSDLJoysticks.Create;

-var

-  i : integer;

-begin

-  inherited;

-  if ( SDL_WasInit( SDL_INIT_JOYSTICK ) = 0 ) then

-    SDL_InitSubSystem( SDL_INIT_JOYSTICK );

-  FNumOfJoySticks := SDL_NumJoysticks;

-  FJoyStickList := TList.Create;

-  for i := 0 to FNumOfJoySticks - 1 do

-  begin

-    FJoyStickList.Add( TSDLJoyStick.Create( i )  );

-  end;

-end;

-

-destructor TSDLJoysticks.Destroy;

-var

-  i : integer;

-begin

-  if FJoyStickList.Count > 0 then

-  begin

-    for i := 0 to FJoyStickList.Count - 1 do

-    begin

-      TSDLJoyStick( FJoyStickList.Items[i] ).Free;

-    end;

-  end;

-  SDL_QuitSubSystem( SDL_INIT_JOYSTICK );

-  inherited;

-end;

-

-function TSDLJoySticks.GetJoyStick(Index: integer): TSDLJoyStick;

-begin

-  Result := TSDLJoyStick( FJoyStickList[ Index ] );

-end;

-

-procedure TSDLJoySticks.SetJoyStick(Index: integer;

-  const Value: TSDLJoyStick);

-begin

-  FJoyStickList[ Index ] :=  @Value;

-end;

-

-function TSDLJoysticks.UpdateInput(event: TSDL_EVENT): Boolean;

-var

-  i : integer;

-begin

-  result := false;

-  if FJoyStickList.Count > 0 then

-  begin

-    for i := 0 to FJoyStickList.Count - 1 do

-    begin

-      TSDLJoyStick( FJoyStickList.Items[i] ).UpdateInput( event );

-    end;

-  end;

-end;

-

-{ TSDLKeyBoard }

-procedure TSDLKeyBoard.DoKeyDown(keysym: PSDL_keysym);

-begin

-  if Assigned( FOnKeyDown ) then

-    FOnKeyDown( keysym.sym , keysym.modifier, keysym.unicode );

-end;

-

-procedure TSDLKeyBoard.DoKeyUp(keysym: PSDL_keysym);

-begin

-  if Assigned( FOnKeyUp ) then

-    FOnKeyUp( keysym.sym , keysym.modifier, keysym.unicode );

-end;

-

-function TSDLKeyBoard.IsKeyDown( Key: TSDLKey ): Boolean;

-begin

-  SDL_PumpEvents;

-

-  // Populate Keys array

-  FKeys := PKeyStateArr( SDL_GetKeyState( nil ) );

-  Result := ( FKeys[Key] = SDL_PRESSED );

-end;

-

-function TSDLKeyBoard.IsKeyUp( Key: TSDLKey ): Boolean;

-begin

-  SDL_PumpEvents;

-

-  // Populate Keys array

-  FKeys := PKeyStateArr( SDL_GetKeyState( nil ) );

-  Result := ( FKeys[Key] = SDL_RELEASED );

-end;

-

-function TSDLKeyBoard.UpdateInput(event: TSDL_EVENT): Boolean;

-begin

-  result := false;

-  if ( FEnabled ) then

-  begin

-    case event.type_ of

-      SDL_KEYDOWN :

-      begin

-        // handle key presses

-        DoKeyDown( @event.key.keysym );

-        result := true;

-      end;

-

-      SDL_KEYUP :

-      begin

-        // handle key releases

-        DoKeyUp( @event.key.keysym );

-        result := true;

-      end;

-    end;

-  end;

-end;

-

-{ TSDLMouse }

-destructor TSDLMouse.Destroy;

-begin

-

-  inherited;

-end;

-

-procedure TSDLMouse.DoMouseDown( Event: TSDL_Event );

-var

-  CurrentPos : TPoint;

-begin

-  FDragging := true;

-  if Assigned( FOnMouseDown ) then

-  begin

-    CurrentPos.x := event.button.x;

-    CurrentPos.y := event.button.y;

-    FOnMouseDown( event.button.button, SDL_GetModState, CurrentPos );

-  end;

-end;

-

-procedure TSDLMouse.DoMouseMove( Event: TSDL_Event );

-var

-  CurrentPos, RelativePos : TPoint;

-begin

-  if Assigned( FOnMouseMove ) then

-  begin

-    CurrentPos.x := event.motion.x;

-    CurrentPos.y := event.motion.y;

-    RelativePos.x := event.motion.xrel;

-    RelativePos.y := event.motion.yrel;

-    FOnMouseMove( SDL_GetModState, CurrentPos, RelativePos );

-  end;

-end;

-

-procedure TSDLMouse.DoMouseUp( event: TSDL_EVENT );

-var

-  Point : TPoint;

-begin

-  FDragging := false;

-  if Assigned( FOnMouseUp ) then

-  begin

-    Point.x := event.button.x;

-    Point.y := event.button.y;

-    FOnMouseUp( event.button.button, SDL_GetModState, Point );

-  end;

-end;

-

-procedure TSDLMouse.DoMouseWheelScroll( event: TSDL_EVENT );

-var

-  Point : TPoint;

-begin

-  if Assigned( FOnMouseWheel ) then

-  begin

-    Point.x := event.button.x;

-    Point.y := event.button.y;

-    if ( event.button.button = SDL_BUTTON_WHEELUP ) then

-      FOnMouseWheel( SDL_BUTTON_WHEELUP, SDL_GetModState, Point )

-    else

-      FOnMouseWheel( SDL_BUTTON_WHEELDOWN, SDL_GetModState, Point );

-  end;

-end;

-

-function TSDLMouse.GetMouseDelta: TPoint;

-begin

-  SDL_PumpEvents;

-  

-  SDL_GetRelativeMouseState( Result.X, Result.Y );

-end;

-

-function TSDLMouse.GetMousePosition: TPoint;

-begin

-  SDL_PumpEvents;

-

-  SDL_GetMouseState( FMousePos.X, FMousePos.Y );

-  Result := FMousePos;

-end;

-

-procedure TSDLMouse.HideCursor;

-begin

-  SDL_ShowCursor( SDL_DISABLE  );

-end;

-

-function TSDLMouse.MouseIsDown(Button: Integer): Boolean;

-begin

-  SDL_PumpEvents;

-

-  Result := ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 );

-end;

-

-function TSDLMouse.MouseIsUp(Button: Integer): Boolean;

-begin

-  SDL_PumpEvents;

-

-  Result := not ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 );

-end;

-

-procedure TSDLMouse.SetMousePosition(const Value: TPoint);

-begin

-  SDL_WarpMouse( Value.x, Value.y );

-end;

-

-procedure TSDLMouse.ShowCursor;

-begin

-  SDL_ShowCursor( SDL_ENABLE  );

-end;

-

-function TSDLMouse.UpdateInput(event: TSDL_EVENT): Boolean;

-begin

-  result := false;

-  if ( FEnabled ) then

-  begin

-    case event.type_ of

-      SDL_MOUSEMOTION :

-      begin

-        // handle Mouse Move

-        DoMouseMove( event );

-      end;

-

-      SDL_MOUSEBUTTONDOWN :

-      begin

-        // handle Mouse Down

-        if ( event.button.button = SDL_BUTTON_WHEELUP )

-        or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then

-          DoMouseWheelScroll( event )

-        else

-          DoMouseDown( event );

-      end;

-

-      SDL_MOUSEBUTTONUP :

-      begin

-        // handle Mouse Up

-        if ( event.button.button = SDL_BUTTON_WHEELUP )

-        or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then

-          DoMouseWheelScroll( event )

-        else

-          DoMouseUp( event );

-      end;

-    end;

-  end;

-end;

-

-{ TSDLInputManager }

-constructor TSDLInputManager.Create(InitInputs: TSDLInputTypes);

-begin

-  inherited Create;

-  if itJoystick in InitInputs then

-    FJoystick := TSDLJoysticks.Create;

-

-  if itKeyBoard in InitInputs then

-    FKeyBoard := TSDLKeyBoard.Create;

-    

-  if itMouse in InitInputs then

-    FMouse := TSDLMouse.Create;

-end;

-

-destructor TSDLInputManager.Destroy;

-begin

-  if FJoystick <> nil then

-    FreeAndNil( FJoystick );

-  if FKeyBoard <> nil then

-    FreeAndNil( FKeyBoard );

-  if FMouse <> nil then

-    FreeAndNil( FMouse );

-  inherited;

-end;

-

-procedure TSDLInputManager.Disable( InitInputs : TSDLInputTypes;  JoyStickNumber : Integer );

-begin

-  if itJoystick in InitInputs then

-    FJoystick.JoySticks[ JoyStickNumber ].Enabled := false;

-

-  if itKeyBoard in InitInputs then

-    FKeyBoard.Enabled := false;

-

-  if itMouse in InitInputs then

-    FMouse.Enabled := false;

-end;

-

-procedure TSDLInputManager.Enable( InitInputs: TSDLInputTypes; JoyStickNumber: Integer );

-begin

-  if itJoystick in InitInputs then

-    FJoystick.JoySticks[ JoyStickNumber ].Enabled := true;

-

-  if itKeyBoard in InitInputs then

-    FKeyBoard.Enabled := true;

-    

-  if itMouse in InitInputs then

-    FMouse.Enabled := true;

-end;

-

-function TSDLInputManager.UpdateInputs( event: TSDL_EVENT ): Boolean;

-begin

-  Result := false;

-  if ( FJoystick <> nil ) then

-   Result := FJoystick.UpdateInput( event );

-  if ( FKeyBoard <> nil ) then

-   Result := FKeyBoard.UpdateInput( event );

-  if ( FMouse <> nil ) then

-   Result := FMouse.UpdateInput( event );

-end;

-

-{ TSDLJoyStick }

-procedure TSDLJoyStick.Close;

-begin

-  SDL_JoystickClose( @FJoystick );

-end;

-

-constructor TSDLJoyStick.Create( Index : Integer );

-begin

-  inherited Create;

-  FJoystick := nil;

-  FJoystickIndex := Index;

-end;

-

-destructor TSDLJoyStick.Destroy;

-begin

-  if FJoystick <> nil then

-    Close;

-  inherited;

-end;

-

-procedure TSDLJoyStick.DoAxisMove(Event: TSDL_Event);

-begin

-  if Assigned( FJoyAxisMoveEvent ) then

-  begin

-    FJoyAxisMoveEvent( Event.jaxis.which, Event.jaxis.axis, Event.jaxis.value );

-  end

-end;

-

-procedure TSDLJoyStick.DoBallMove(Event: TSDL_Event);

-var

-  BallPoint : TPoint;

-begin

-  if Assigned( FJoyBallMoveEvent ) then

-  begin

-    BallPoint.x := Event.jball.xrel;

-    BallPoint.y := Event.jball.yrel;

-    FJoyBallMoveEvent( Event.jball.which, Event.jball.ball, BallPoint );

-  end;

-end;

-

-procedure TSDLJoyStick.DoButtonDown(Event: TSDL_Event);

-begin

-  if Assigned( FJoyButtonDownEvent ) then

-  begin

-    if ( Event.jbutton.state = SDL_PRESSED ) then

-      FJoyButtonDownEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state );

-  end;

-end;

-

-procedure TSDLJoyStick.DoButtonUp(Event: TSDL_Event);

-begin

-  if Assigned( FJoyButtonUpEvent ) then

-  begin

-    if ( Event.jbutton.state = SDL_RELEASED ) then

-      FJoyButtonUpEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state );

-  end

-end;

-

-procedure TSDLJoyStick.DoHatMove(Event: TSDL_Event);

-begin

-  if Assigned( FJoyHatMoveEvent ) then

-  begin

-    FJoyHatMoveEvent( Event.jhat.which, Event.jhat.hat, Event.jhat.value );

-  end;

-end;

-

-function TSDLJoyStick.GetName: PChar;

-begin

-  result := FJoystick.name;

-end;

-

-function TSDLJoyStick.GetNumAxes: integer;

-begin

-  result := FJoystick.naxes;

-end;

-

-function TSDLJoyStick.GetNumBalls: integer;

-begin

-  result := FJoystick.nballs;

-end;

-

-function TSDLJoyStick.GetNumButtons: integer;

-begin

-  result := FJoystick.nbuttons;

-end;

-

-function TSDLJoyStick.GetNumHats: integer;

-begin

-  result := FJoystick.nhats;

-end;

-

-procedure TSDLJoyStick.Open;

-begin

-  FJoystick := SDL_JoyStickOpen( FJoystickIndex );

-end;

-

-function TSDLJoyStick.UpdateInput(Event: TSDL_EVENT): Boolean;

-begin

-  Result := false;

-  

-  if ( FEnabled ) then

-  begin

-    case event.type_ of

-      SDL_JOYAXISMOTION :

-      begin

-        DoAxisMove( Event );

-      end;

-

-      SDL_JOYBALLMOTION :

-      begin

-        DoBallMove( Event );

-      end;

-

-      SDL_JOYHATMOTION :

-      begin

-        DoHatMove( Event );

-      end;

-

-      SDL_JOYBUTTONDOWN :

-      begin

-        DoButtonDown( Event );

-      end;

-

-      SDL_JOYBUTTONUP :

-      begin

-        DoButtonUp( Event );

-      end;

-    end;

-  end;

-end;

-

-{ TSDLCustomCursor }

-

-constructor TSDLCustomCursor.Create(const aFileName: string;  aHotPoint: TPoint);

-begin

-  inherited Create;

-  FHotPoint := aHotPoint;

-  LoadFromFile( aFileName );

-end;

-

-function TSDLCustomCursor.ScanForChar(str: string; ch: Char;

-  startPos: Integer; lookFor: Boolean): Integer;

-begin

-  Result := -1;

-  while ( ( ( str[ startPos ] = ch ) <> lookFor ) and ( startPos < Length( str ) ) ) do

-    inc( startPos );

-  if startPos <> Length( str ) then

-    Result := startPos;

-end;

-

-procedure TSDLCustomCursor.SetFileName(const aValue: string);

-begin

-  LoadFromFile( aValue );

-end;

-

-{ TSDLXPMCursor }

-

-destructor TSDLXPMCursor.Destroy;

-begin

-  FreeCursor;

-  inherited;

-end;

-

-procedure TSDLXPMCursor.FreeCursor;

-begin

-  if FCursor <> nil then

-  begin

-    SDL_FreeCursor( FCursor );

-    FFileName := ''; 

-  end;

-end;

-

-procedure TSDLXPMCursor.LoadFromFile(const aFileName: string);

-var

-  xpmFile : Textfile;

-  step : Integer;

-  holdPos : Integer;

-  counter : Integer;

-  dimensions : array[ 1..3 ] of Integer;

-  clr, clrNone, clrBlack, clrWhite : Char;

-  data, mask : array of UInt8;

-  i, col : Integer;

-  LineString : string;

-begin

-  FreeCursor;

-  AssignFile( xpmFile, aFileName );

-  Reset( xpmFile );

-  step := 0;

-  i := -1;

-  clrBlack := 'X';

-  clrWhite := ',';

-  clrNone := ' ';

-  counter := 0;

-  while not ( eof( xpmFile ) ) do

-  begin

-    Readln( xpmFile, LineString );

-    // scan for strings

-    if LineString[ 1 ] = '"' then

-    begin

-      case step of

-        0 : // Get dimensions  (should be width height number-of-colors ???)

-          begin

-            HoldPos := 2;

-            counter := ScanForChar( LineString, ' ', HoldPos, False );

-            counter := ScanForChar( LineString, ' ', counter, True );

-            dimensions[ 1 ] := StrToInt( Copy( LineString, HoldPos, counter - HoldPos ) );

-            counter := ScanForChar( LineString, ' ', counter, False );

-            holdPos := counter;

-            counter := ScanForChar( LineString, ' ', counter, True );

-            dimensions[ 2 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );

-            counter := ScanForChar( LineString, ' ', counter, False );

-            holdPos := counter;

-            counter := ScanForChar( LineString, ' ', counter, True );

-            dimensions[ 3 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );

-            step := 1;

-            SetLength( data, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );

-            SetLength( mask, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );

-            //Log.LogStatus( 'Length = ' + IntToStr( ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 ), 'LoadCursorFromFile' );

-          end;

-        1 : // get the symbols for transparent, black and white

-          begin

-            // get the symbol for the color

-            clr := LineString[ 2 ];

-            // look for the 'c' symbol

-            counter := ScanForChar( LineString, 'c', 3, True );

-            inc( counter );

-            counter := ScanForChar( LineString, ' ', counter, False );

-            if LowerCase( Copy( LineString, counter, 4 ) ) = 'none' then

-            begin

-              clrNone := clr;

-            end;

-            if LowerCase( Copy( LineString, counter, 7 ) ) = '#ffffff' then

-            begin

-              clrWhite := clr;

-            end;

-            if LowerCase( Copy( LineString, counter, 7 ) ) = '#000000' then

-            begin

-              clrBlack := clr;

-            end;

-            dec( dimensions[ 3 ] );

-            if dimensions[ 3 ] = 0 then

-            begin

-              step := 2;

-              counter := 0;

-            end;

-          end;

-        2 : // get cursor information -- modified from the SDL

-          // documentation of SDL_CreateCursor.

-          begin

-            for col := 1 to dimensions[1] do

-            begin

-              if ( ( col mod 8 ) <> 1 ) then

-              begin

-                data[ i ] := data[ i ] shl 1;

-                mask[ i ] := mask[ i ] shl 1;

-              end

-              else

-              begin

-                inc( i );

-                data[ i ] := 0;

-                mask[ i ] := 0;

-              end;

-              if LineString[ col ] = clrWhite then

-              begin

-                mask[ i ] := mask[ i ] or $01;

-              end

-              else if LineString[ col ] = clrBlack then

-              begin

-                data[ i ] := data[ i ] or $01;

-                mask[ i ] := mask[ i ] or $01;

-              end

-              else if LineString[ col + 1 ] = clrNone then

-              begin

-                //

-              end;

-            end;

-            inc(counter);

-            if counter = dimensions[2] then

-              step := 4;

-          end;

-      end;

-    end;

-  end;

-  CloseFile( xpmFile );

-  FCursor := SDL_CreateCursor( PUInt8( data ), PUInt8( mask ), dimensions[ 1 ], dimensions[ 2 ], FHotPoint.x, FHotPoint.y );

-end;

-

-procedure TSDLXPMCursor.LoadFromStream(aStream: TStream);

-begin

-  inherited;

-

-end;

-

-procedure TSDLXPMCursor.Show;

-begin

-  inherited;

-  SDL_SetCursor( FCursor );

-end;

-

-{ TSDLCursorList }

-function TSDLCursorList.AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer;

-begin

-  result := inherited AddObject( aName, aObject );

-end;

-

-constructor TSDLCursorList.Create;

-begin

-  inherited;

-  Duplicates := dupIgnore;

-end;

-

-function TSDLCursorList.GetObject(aIndex: Integer): TSDLCustomCursor;

-begin

-  result := TSDLCustomCursor( inherited GetObject( aIndex ) );

-end;

-

-procedure TSDLCursorList.PutObject(aIndex: Integer; aObject: TSDLCustomCursor);

-begin

-  inherited PutObject( aIndex, aObject );

-end;

-

-end.

+unit sdlinput;
+{
+  $Id: sdlinput.pas,v 1.9 2007/08/22 21:18:43 savage Exp $
+  
+}
+{******************************************************************************}
+{                                                                              }
+{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }
+{                     SDL Input Wrapper                                        }
+{                                                                              }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Portions created by Dominique Louis are                                      }
+{ Copyright (C) 2003 - 2100 Dominique Louis.                                   }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{   SDL Mouse, Keyboard and Joystick wrapper                                   }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   SDL.dll on Windows platforms                                               }
+{   libSDL-1.1.so.0 on Linux platform                                          }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{ March      12     2003 - DL : Initial creation                               }
+{                                                                              }
+{ February   02     2004 - DL : Added Custom Cursor Support to the Mouse class }
+{
+  $Log: sdlinput.pas,v $
+  Revision 1.9  2007/08/22 21:18:43  savage
+  Thanks to Dean for his MouseDelta patch.
+
+  Revision 1.8  2005/08/03 18:57:32  savage
+  Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class
+
+  Revision 1.7  2004/09/30 22:32:04  savage
+  Updated with slightly different header comments
+
+  Revision 1.6  2004/09/12 21:52:58  savage
+  Slight changes to fix some issues with the sdl classes.
+
+  Revision 1.5  2004/05/10 21:11:49  savage
+  changes required to help get SoAoS off the ground.
+
+  Revision 1.4  2004/05/03 22:38:40  savage
+  Added the ability to enable or disable certain inputs @ runtime. Basically it just does not call UpdateInput if Enabled = false.
+  Can also disable and enable input devices via the InputManager.
+
+  Revision 1.3  2004/04/28 21:27:01  savage
+  Updated Joystick code and event handlers. Needs testing...
+
+  Revision 1.2  2004/02/14 22:36:29  savage
+  Fixed inconsistencies of using LoadLibrary and LoadModule.
+  Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.
+
+  Revision 1.1  2004/02/05 00:08:20  savage
+  Module 1.0 release
+
+
+}
+{******************************************************************************}
+
+interface
+
+{$i jedi-sdl.inc}
+
+uses
+  Classes,
+  sdl;
+
+type
+  TSDLInputType = ( itJoystick , itKeyBoard, itMouse );
+  TSDLInputTypes = set of TSDLInputType;
+
+  TSDLCustomInput = class( TObject )
+  private
+    FEnabled: Boolean;
+  public
+    constructor Create;
+    function UpdateInput( event: TSDL_EVENT ) : Boolean; virtual; abstract;
+    property Enabled : Boolean read FEnabled write FEnabled;
+  end;
+
+  TSDLJoyAxisMoveEvent =  procedure ( Which: UInt8; Axis: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+  TSDLJoyBallMoveEvent =  procedure ( Which: UInt8; Ball: UInt8; RelativePos: TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
+  TSDLJoyHatMoveEvent =  procedure ( Which: UInt8; Hat: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+  TSDLJoyButtonEvent =  procedure ( Which: UInt8; Button: UInt8; State: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+
+
+  TSDLJoyStick = class( TSDLCustomInput )
+  private
+    FJoystick : PSDL_Joystick;
+    FJoystickIndex : Integer;
+    FJoyAxisMoveEvent : TSDLJoyAxisMoveEvent;
+    FJoyBallMoveEvent : TSDLJoyBallMoveEvent;
+    FJoyHatMoveEvent : TSDLJoyHatMoveEvent;
+    FJoyButtonDownEvent : TSDLJoyButtonEvent;
+    FJoyButtonUpEvent : TSDLJoyButtonEvent;
+    procedure DoAxisMove( Event : TSDL_Event );
+    procedure DoBallMove( Event : TSDL_Event );
+    procedure DoHatMove( Event : TSDL_Event );
+    procedure DoButtonDown( Event : TSDL_Event );
+    procedure DoButtonUp( Event : TSDL_Event );
+    function GetName: PChar;
+    function GetNumAxes: integer;
+    function GetNumBalls: integer;
+    function GetNumButtons: integer;
+    function GetNumHats: integer;
+  public
+    constructor Create( Index : Integer );
+    destructor Destroy; override;
+    procedure Open;
+    procedure Close;
+    function UpdateInput( Event: TSDL_EVENT ) : Boolean; override;
+    property Name : PChar read GetName;
+    property NumAxes : integer read GetNumAxes;
+    property NumBalls : integer read GetNumBalls;
+    property NumButtons : integer read GetNumButtons;
+    property NumHats : integer read GetNumHats;
+    property OnAxisMove : TSDLJoyAxisMoveEvent read FJoyAxisMoveEvent write FJoyAxisMoveEvent;
+    property OnBallMove : TSDLJoyBallMoveEvent read FJoyBallMoveEvent write FJoyBallMoveEvent;
+    property OnHatMove : TSDLJoyHatMoveEvent read FJoyHatMoveEvent write FJoyHatMoveEvent;
+    property OnButtonDown : TSDLJoyButtonEvent read FJoyButtonDownEvent write FJoyButtonDownEvent;
+    property OnButtonUp : TSDLJoyButtonEvent read FJoyButtonUpEvent write FJoyButtonUpEvent;
+  end;
+
+  TSDLJoySticks = class( TObject )
+  private
+    FNumOfJoySticks: Integer;
+    FJoyStickList : TList;
+    function GetJoyStick(Index: integer): TSDLJoyStick;
+    procedure SetJoyStick(Index: integer; const Value: TSDLJoyStick);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function UpdateInput( event: TSDL_EVENT ) : Boolean;
+    property NumOfJoySticks : Integer read FNumOfJoySticks write FNumOfJoySticks;
+    property JoySticks[ Index : integer ] : TSDLJoyStick read GetJoyStick write SetJoyStick;
+  end;
+
+  TSDLKeyBoardEvent =  procedure ( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+
+  TSDLKeyBoard = class( TSDLCustomInput )
+  private
+    FKeys : PKeyStateArr;
+    FOnKeyUp: TSDLKeyBoardEvent;
+    FOnKeyDown: TSDLKeyBoardEvent;
+    procedure DoKeyDown( keysym : PSDL_keysym );
+    procedure DoKeyUp( keysym : PSDL_keysym );
+  public
+    function IsKeyDown( Key : TSDLKey ) : Boolean;
+    function IsKeyUp( Key : TSDLKey ) : Boolean;
+    function UpdateInput( event: TSDL_EVENT ) : Boolean; override;
+    property Keys : PKeyStateArr read FKeys write FKeys;
+    property OnKeyDown : TSDLKeyBoardEvent read FOnKeyDown write FOnKeyDown;
+    property OnKeyUp : TSDLKeyBoardEvent read FOnKeyUp write FOnKeyUp;
+  end;
+
+  TSDLMouseButtonEvent =  procedure ( Button : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
+  TSDLMouseMoveEvent =  procedure ( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
+  TSDLMouseWheelEvent =  procedure ( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
+
+  TSDLCustomCursor = class( TObject )
+  private
+    FFileName : string;
+    FHotPoint: TPoint;
+    procedure SetFileName(const aValue: string );
+    function ScanForChar( str : string; ch : Char; startPos : Integer; lookFor : Boolean ) : Integer;
+  public
+    constructor Create( const aFileName : string; aHotPoint: TPoint );
+    procedure LoadFromFile( const aFileName : string ); virtual; abstract;
+    procedure LoadFromStream( aStream : TStream ); virtual; abstract;
+    procedure Show; virtual; abstract;
+    property FileName : string read FFileName write SetFileName;
+    property HotPoint : TPoint read FHotPoint write FHotPoint;
+  end;
+
+  TSDLXPMCursor = class( TSDLCustomCursor )
+  private
+    FCursor : PSDL_Cursor;
+    procedure FreeCursor;
+  public
+    destructor Destroy; override;
+    procedure LoadFromFile( const aFileName : string ); override;
+    procedure LoadFromStream( aStream : TStream ); override;
+    procedure Show; override;
+  end;
+
+  TSDLCursorList = class( TStringList )
+  protected
+    function GetObject( aIndex : Integer ): TSDLCustomCursor; reintroduce;
+    procedure PutObject( aIndex : Integer; AObject : TSDLCustomCursor); reintroduce;
+  public
+    constructor Create;
+   function AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer; virtual;
+  end;
+
+  TSDLMouse = class( TSDLCustomInput )
+  private
+    FDragging : Boolean;
+    FMousePos : TPoint;
+    FOnMouseUp: TSDLMouseButtonEvent;
+    FOnMouseDown: TSDLMouseButtonEvent;
+    FOnMouseMove: TSDLMouseMoveEvent;
+    FOnMouseWheel: TSDLMouseWheelEvent;
+    FCursorList : TSDLCursorList; // Cursor Pointer
+    procedure DoMouseMove( Event: TSDL_Event );
+    procedure DoMouseDown( Event: TSDL_Event );
+    procedure DoMouseUp( Event: TSDL_Event );
+    procedure DoMouseWheelScroll( Event: TSDL_Event );
+    function GetMousePosition: TPoint;
+    procedure SetMousePosition(const Value: TPoint);
+    function GetMouseDelta: TPoint;
+  public
+    destructor Destroy; override;
+    function UpdateInput( event: TSDL_EVENT ) : Boolean; override;
+    function MouseIsDown( Button : Integer ) : Boolean;
+    function MouseIsUp( Button : Integer ) : Boolean;
+    procedure ShowCursor;
+    procedure HideCursor;
+    property OnMouseDown : TSDLMouseButtonEvent read FOnMouseDown write FOnMouseDown;
+    property OnMouseUp : TSDLMouseButtonEvent read FOnMouseUp write FOnMouseUp;
+    property OnMouseMove : TSDLMouseMoveEvent read FOnMouseMove write FOnMouseMove;
+    property OnMouseWheel : TSDLMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
+    property MousePosition : TPoint read GetMousePosition write SetMousePosition;
+    property MouseDelta: TPoint read GetMouseDelta;
+    property Cursors : TSDLCursorList read FCursorList write FCursorList;
+  end;
+
+  TSDLInputManager = class( TObject )
+  private
+    FKeyBoard : TSDLKeyBoard;
+    FMouse : TSDLMouse;
+    FJoystick : TSDLJoysticks;
+  public
+    constructor Create( InitInputs : TSDLInputTypes );
+    destructor Destroy; override;
+    procedure Disable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 );
+    procedure Enable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 );
+    function UpdateInputs( event: TSDL_EVENT ) : Boolean;
+    property KeyBoard : TSDLKeyBoard read FKeyBoard write FKeyBoard;
+    property Mouse : TSDLMouse read FMouse write FMouse;
+    property JoyStick : TSDLJoysticks read FJoyStick write FJoyStick;
+  end;
+
+implementation
+
+uses
+  SysUtils;
+
+{ TSDLCustomInput }
+constructor TSDLCustomInput.Create;
+begin
+  inherited;
+  FEnabled := true;
+end;
+
+{ TSDLJoysticks }
+constructor TSDLJoysticks.Create;
+var
+  i : integer;
+begin
+  inherited;
+  if ( SDL_WasInit( SDL_INIT_JOYSTICK ) = 0 ) then
+    SDL_InitSubSystem( SDL_INIT_JOYSTICK );
+  FNumOfJoySticks := SDL_NumJoysticks;
+  FJoyStickList := TList.Create;
+  for i := 0 to FNumOfJoySticks - 1 do
+  begin
+    FJoyStickList.Add( TSDLJoyStick.Create( i )  );
+  end;
+end;
+
+destructor TSDLJoysticks.Destroy;
+var
+  i : integer;
+begin
+  if FJoyStickList.Count > 0 then
+  begin
+    for i := 0 to FJoyStickList.Count - 1 do
+    begin
+      TSDLJoyStick( FJoyStickList.Items[i] ).Free;
+    end;
+  end;
+  SDL_QuitSubSystem( SDL_INIT_JOYSTICK );
+  inherited;
+end;
+
+function TSDLJoySticks.GetJoyStick(Index: integer): TSDLJoyStick;
+begin
+  Result := TSDLJoyStick( FJoyStickList[ Index ] );
+end;
+
+procedure TSDLJoySticks.SetJoyStick(Index: integer;
+  const Value: TSDLJoyStick);
+begin
+  FJoyStickList[ Index ] :=  @Value;
+end;
+
+function TSDLJoysticks.UpdateInput(event: TSDL_EVENT): Boolean;
+var
+  i : integer;
+begin
+  result := false;
+  if FJoyStickList.Count > 0 then
+  begin
+    for i := 0 to FJoyStickList.Count - 1 do
+    begin
+      TSDLJoyStick( FJoyStickList.Items[i] ).UpdateInput( event );
+    end;
+  end;
+end;
+
+{ TSDLKeyBoard }
+procedure TSDLKeyBoard.DoKeyDown(keysym: PSDL_keysym);
+begin
+  if Assigned( FOnKeyDown ) then
+    FOnKeyDown( keysym.sym , keysym.modifier, keysym.unicode );
+end;
+
+procedure TSDLKeyBoard.DoKeyUp(keysym: PSDL_keysym);
+begin
+  if Assigned( FOnKeyUp ) then
+    FOnKeyUp( keysym.sym , keysym.modifier, keysym.unicode );
+end;
+
+function TSDLKeyBoard.IsKeyDown( Key: TSDLKey ): Boolean;
+begin
+  SDL_PumpEvents;
+
+  // Populate Keys array
+  FKeys := PKeyStateArr( SDL_GetKeyState( nil ) );
+  Result := ( FKeys[Key] = SDL_PRESSED );
+end;
+
+function TSDLKeyBoard.IsKeyUp( Key: TSDLKey ): Boolean;
+begin
+  SDL_PumpEvents;
+
+  // Populate Keys array
+  FKeys := PKeyStateArr( SDL_GetKeyState( nil ) );
+  Result := ( FKeys[Key] = SDL_RELEASED );
+end;
+
+function TSDLKeyBoard.UpdateInput(event: TSDL_EVENT): Boolean;
+begin
+  result := false;
+  if ( FEnabled ) then
+  begin
+    case event.type_ of
+      SDL_KEYDOWN :
+      begin
+        // handle key presses
+        DoKeyDown( @event.key.keysym );
+        result := true;
+      end;
+
+      SDL_KEYUP :
+      begin
+        // handle key releases
+        DoKeyUp( @event.key.keysym );
+        result := true;
+      end;
+    end;
+  end;
+end;
+
+{ TSDLMouse }
+destructor TSDLMouse.Destroy;
+begin
+
+  inherited;
+end;
+
+procedure TSDLMouse.DoMouseDown( Event: TSDL_Event );
+var
+  CurrentPos : TPoint;
+begin
+  FDragging := true;
+  if Assigned( FOnMouseDown ) then
+  begin
+    CurrentPos.x := event.button.x;
+    CurrentPos.y := event.button.y;
+    FOnMouseDown( event.button.button, SDL_GetModState, CurrentPos );
+  end;
+end;
+
+procedure TSDLMouse.DoMouseMove( Event: TSDL_Event );
+var
+  CurrentPos, RelativePos : TPoint;
+begin
+  if Assigned( FOnMouseMove ) then
+  begin
+    CurrentPos.x := event.motion.x;
+    CurrentPos.y := event.motion.y;
+    RelativePos.x := event.motion.xrel;
+    RelativePos.y := event.motion.yrel;
+    FOnMouseMove( SDL_GetModState, CurrentPos, RelativePos );
+  end;
+end;
+
+procedure TSDLMouse.DoMouseUp( event: TSDL_EVENT );
+var
+  Point : TPoint;
+begin
+  FDragging := false;
+  if Assigned( FOnMouseUp ) then
+  begin
+    Point.x := event.button.x;
+    Point.y := event.button.y;
+    FOnMouseUp( event.button.button, SDL_GetModState, Point );
+  end;
+end;
+
+procedure TSDLMouse.DoMouseWheelScroll( event: TSDL_EVENT );
+var
+  Point : TPoint;
+begin
+  if Assigned( FOnMouseWheel ) then
+  begin
+    Point.x := event.button.x;
+    Point.y := event.button.y;
+    if ( event.button.button = SDL_BUTTON_WHEELUP ) then
+      FOnMouseWheel( SDL_BUTTON_WHEELUP, SDL_GetModState, Point )
+    else
+      FOnMouseWheel( SDL_BUTTON_WHEELDOWN, SDL_GetModState, Point );
+  end;
+end;
+
+function TSDLMouse.GetMouseDelta: TPoint;
+begin
+  SDL_PumpEvents;
+  
+  SDL_GetRelativeMouseState( Result.X, Result.Y );
+end;
+
+function TSDLMouse.GetMousePosition: TPoint;
+begin
+  SDL_PumpEvents;
+
+  SDL_GetMouseState( FMousePos.X, FMousePos.Y );
+  Result := FMousePos;
+end;
+
+procedure TSDLMouse.HideCursor;
+begin
+  SDL_ShowCursor( SDL_DISABLE  );
+end;
+
+function TSDLMouse.MouseIsDown(Button: Integer): Boolean;
+begin
+  SDL_PumpEvents;
+
+  Result := ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 );
+end;
+
+function TSDLMouse.MouseIsUp(Button: Integer): Boolean;
+begin
+  SDL_PumpEvents;
+
+  Result := not ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 );
+end;
+
+procedure TSDLMouse.SetMousePosition(const Value: TPoint);
+begin
+  SDL_WarpMouse( Value.x, Value.y );
+end;
+
+procedure TSDLMouse.ShowCursor;
+begin
+  SDL_ShowCursor( SDL_ENABLE  );
+end;
+
+function TSDLMouse.UpdateInput(event: TSDL_EVENT): Boolean;
+begin
+  result := false;
+  if ( FEnabled ) then
+  begin
+    case event.type_ of
+      SDL_MOUSEMOTION :
+      begin
+        // handle Mouse Move
+        DoMouseMove( event );
+      end;
+
+      SDL_MOUSEBUTTONDOWN :
+      begin
+        // handle Mouse Down
+        if ( event.button.button = SDL_BUTTON_WHEELUP )
+        or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then
+          DoMouseWheelScroll( event )
+        else
+          DoMouseDown( event );
+      end;
+
+      SDL_MOUSEBUTTONUP :
+      begin
+        // handle Mouse Up
+        if ( event.button.button = SDL_BUTTON_WHEELUP )
+        or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then
+          DoMouseWheelScroll( event )
+        else
+          DoMouseUp( event );
+      end;
+    end;
+  end;
+end;
+
+{ TSDLInputManager }
+constructor TSDLInputManager.Create(InitInputs: TSDLInputTypes);
+begin
+  inherited Create;
+  if itJoystick in InitInputs then
+    FJoystick := TSDLJoysticks.Create;
+
+  if itKeyBoard in InitInputs then
+    FKeyBoard := TSDLKeyBoard.Create;
+    
+  if itMouse in InitInputs then
+    FMouse := TSDLMouse.Create;
+end;
+
+destructor TSDLInputManager.Destroy;
+begin
+  if FJoystick <> nil then
+    FreeAndNil( FJoystick );
+  if FKeyBoard <> nil then
+    FreeAndNil( FKeyBoard );
+  if FMouse <> nil then
+    FreeAndNil( FMouse );
+  inherited;
+end;
+
+procedure TSDLInputManager.Disable( InitInputs : TSDLInputTypes;  JoyStickNumber : Integer );
+begin
+  if itJoystick in InitInputs then
+    FJoystick.JoySticks[ JoyStickNumber ].Enabled := false;
+
+  if itKeyBoard in InitInputs then
+    FKeyBoard.Enabled := false;
+
+  if itMouse in InitInputs then
+    FMouse.Enabled := false;
+end;
+
+procedure TSDLInputManager.Enable( InitInputs: TSDLInputTypes; JoyStickNumber: Integer );
+begin
+  if itJoystick in InitInputs then
+    FJoystick.JoySticks[ JoyStickNumber ].Enabled := true;
+
+  if itKeyBoard in InitInputs then
+    FKeyBoard.Enabled := true;
+    
+  if itMouse in InitInputs then
+    FMouse.Enabled := true;
+end;
+
+function TSDLInputManager.UpdateInputs( event: TSDL_EVENT ): Boolean;
+begin
+  Result := false;
+  if ( FJoystick <> nil ) then
+   Result := FJoystick.UpdateInput( event );
+  if ( FKeyBoard <> nil ) then
+   Result := FKeyBoard.UpdateInput( event );
+  if ( FMouse <> nil ) then
+   Result := FMouse.UpdateInput( event );
+end;
+
+{ TSDLJoyStick }
+procedure TSDLJoyStick.Close;
+begin
+  SDL_JoystickClose( @FJoystick );
+end;
+
+constructor TSDLJoyStick.Create( Index : Integer );
+begin
+  inherited Create;
+  FJoystick := nil;
+  FJoystickIndex := Index;
+end;
+
+destructor TSDLJoyStick.Destroy;
+begin
+  if FJoystick <> nil then
+    Close;
+  inherited;
+end;
+
+procedure TSDLJoyStick.DoAxisMove(Event: TSDL_Event);
+begin
+  if Assigned( FJoyAxisMoveEvent ) then
+  begin
+    FJoyAxisMoveEvent( Event.jaxis.which, Event.jaxis.axis, Event.jaxis.value );
+  end
+end;
+
+procedure TSDLJoyStick.DoBallMove(Event: TSDL_Event);
+var
+  BallPoint : TPoint;
+begin
+  if Assigned( FJoyBallMoveEvent ) then
+  begin
+    BallPoint.x := Event.jball.xrel;
+    BallPoint.y := Event.jball.yrel;
+    FJoyBallMoveEvent( Event.jball.which, Event.jball.ball, BallPoint );
+  end;
+end;
+
+procedure TSDLJoyStick.DoButtonDown(Event: TSDL_Event);
+begin
+  if Assigned( FJoyButtonDownEvent ) then
+  begin
+    if ( Event.jbutton.state = SDL_PRESSED ) then
+      FJoyButtonDownEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state );
+  end;
+end;
+
+procedure TSDLJoyStick.DoButtonUp(Event: TSDL_Event);
+begin
+  if Assigned( FJoyButtonUpEvent ) then
+  begin
+    if ( Event.jbutton.state = SDL_RELEASED ) then
+      FJoyButtonUpEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state );
+  end
+end;
+
+procedure TSDLJoyStick.DoHatMove(Event: TSDL_Event);
+begin
+  if Assigned( FJoyHatMoveEvent ) then
+  begin
+    FJoyHatMoveEvent( Event.jhat.which, Event.jhat.hat, Event.jhat.value );
+  end;
+end;
+
+function TSDLJoyStick.GetName: PChar;
+begin
+  result := FJoystick.name;
+end;
+
+function TSDLJoyStick.GetNumAxes: integer;
+begin
+  result := FJoystick.naxes;
+end;
+
+function TSDLJoyStick.GetNumBalls: integer;
+begin
+  result := FJoystick.nballs;
+end;
+
+function TSDLJoyStick.GetNumButtons: integer;
+begin
+  result := FJoystick.nbuttons;
+end;
+
+function TSDLJoyStick.GetNumHats: integer;
+begin
+  result := FJoystick.nhats;
+end;
+
+procedure TSDLJoyStick.Open;
+begin
+  FJoystick := SDL_JoyStickOpen( FJoystickIndex );
+end;
+
+function TSDLJoyStick.UpdateInput(Event: TSDL_EVENT): Boolean;
+begin
+  Result := false;
+  
+  if ( FEnabled ) then
+  begin
+    case event.type_ of
+      SDL_JOYAXISMOTION :
+      begin
+        DoAxisMove( Event );
+      end;
+
+      SDL_JOYBALLMOTION :
+      begin
+        DoBallMove( Event );
+      end;
+
+      SDL_JOYHATMOTION :
+      begin
+        DoHatMove( Event );
+      end;
+
+      SDL_JOYBUTTONDOWN :
+      begin
+        DoButtonDown( Event );
+      end;
+
+      SDL_JOYBUTTONUP :
+      begin
+        DoButtonUp( Event );
+      end;
+    end;
+  end;
+end;
+
+{ TSDLCustomCursor }
+
+constructor TSDLCustomCursor.Create(const aFileName: string;  aHotPoint: TPoint);
+begin
+  inherited Create;
+  FHotPoint := aHotPoint;
+  LoadFromFile( aFileName );
+end;
+
+function TSDLCustomCursor.ScanForChar(str: string; ch: Char;
+  startPos: Integer; lookFor: Boolean): Integer;
+begin
+  Result := -1;
+  while ( ( ( str[ startPos ] = ch ) <> lookFor ) and ( startPos < Length( str ) ) ) do
+    inc( startPos );
+  if startPos <> Length( str ) then
+    Result := startPos;
+end;
+
+procedure TSDLCustomCursor.SetFileName(const aValue: string);
+begin
+  LoadFromFile( aValue );
+end;
+
+{ TSDLXPMCursor }
+
+destructor TSDLXPMCursor.Destroy;
+begin
+  FreeCursor;
+  inherited;
+end;
+
+procedure TSDLXPMCursor.FreeCursor;
+begin
+  if FCursor <> nil then
+  begin
+    SDL_FreeCursor( FCursor );
+    FFileName := ''; 
+  end;
+end;
+
+procedure TSDLXPMCursor.LoadFromFile(const aFileName: string);
+var
+  xpmFile : Textfile;
+  step : Integer;
+  holdPos : Integer;
+  counter : Integer;
+  dimensions : array[ 1..3 ] of Integer;
+  clr, clrNone, clrBlack, clrWhite : Char;
+  data, mask : array of UInt8;
+  i, col : Integer;
+  LineString : string;
+begin
+  FreeCursor;
+  AssignFile( xpmFile, aFileName );
+  Reset( xpmFile );
+  step := 0;
+  i := -1;
+  clrBlack := 'X';
+  clrWhite := ',';
+  clrNone := ' ';
+  counter := 0;
+  while not ( eof( xpmFile ) ) do
+  begin
+    Readln( xpmFile, LineString );
+    // scan for strings
+    if LineString[ 1 ] = '"' then
+    begin
+      case step of
+        0 : // Get dimensions  (should be width height number-of-colors ???)
+          begin
+            HoldPos := 2;
+            counter := ScanForChar( LineString, ' ', HoldPos, False );
+            counter := ScanForChar( LineString, ' ', counter, True );
+            dimensions[ 1 ] := StrToInt( Copy( LineString, HoldPos, counter - HoldPos ) );
+            counter := ScanForChar( LineString, ' ', counter, False );
+            holdPos := counter;
+            counter := ScanForChar( LineString, ' ', counter, True );
+            dimensions[ 2 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );
+            counter := ScanForChar( LineString, ' ', counter, False );
+            holdPos := counter;
+            counter := ScanForChar( LineString, ' ', counter, True );
+            dimensions[ 3 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );
+            step := 1;
+            SetLength( data, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );
+            SetLength( mask, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );
+            //Log.LogStatus( 'Length = ' + IntToStr( ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 ), 'LoadCursorFromFile' );
+          end;
+        1 : // get the symbols for transparent, black and white
+          begin
+            // get the symbol for the color
+            clr := LineString[ 2 ];
+            // look for the 'c' symbol
+            counter := ScanForChar( LineString, 'c', 3, True );
+            inc( counter );
+            counter := ScanForChar( LineString, ' ', counter, False );
+            if LowerCase( Copy( LineString, counter, 4 ) ) = 'none' then
+            begin
+              clrNone := clr;
+            end;
+            if LowerCase( Copy( LineString, counter, 7 ) ) = '#ffffff' then
+            begin
+              clrWhite := clr;
+            end;
+            if LowerCase( Copy( LineString, counter, 7 ) ) = '#000000' then
+            begin
+              clrBlack := clr;
+            end;
+            dec( dimensions[ 3 ] );
+            if dimensions[ 3 ] = 0 then
+            begin
+              step := 2;
+              counter := 0;
+            end;
+          end;
+        2 : // get cursor information -- modified from the SDL
+          // documentation of SDL_CreateCursor.
+          begin
+            for col := 1 to dimensions[1] do
+            begin
+              if ( ( col mod 8 ) <> 1 ) then
+              begin
+                data[ i ] := data[ i ] shl 1;
+                mask[ i ] := mask[ i ] shl 1;
+              end
+              else
+              begin
+                inc( i );
+                data[ i ] := 0;
+                mask[ i ] := 0;
+              end;
+              if LineString[ col ] = clrWhite then
+              begin
+                mask[ i ] := mask[ i ] or $01;
+              end
+              else if LineString[ col ] = clrBlack then
+              begin
+                data[ i ] := data[ i ] or $01;
+                mask[ i ] := mask[ i ] or $01;
+              end
+              else if LineString[ col + 1 ] = clrNone then
+              begin
+                //
+              end;
+            end;
+            inc(counter);
+            if counter = dimensions[2] then
+              step := 4;
+          end;
+      end;
+    end;
+  end;
+  CloseFile( xpmFile );
+  FCursor := SDL_CreateCursor( PUInt8( data ), PUInt8( mask ), dimensions[ 1 ], dimensions[ 2 ], FHotPoint.x, FHotPoint.y );
+end;
+
+procedure TSDLXPMCursor.LoadFromStream(aStream: TStream);
+begin
+  inherited;
+
+end;
+
+procedure TSDLXPMCursor.Show;
+begin
+  inherited;
+  SDL_SetCursor( FCursor );
+end;
+
+{ TSDLCursorList }
+function TSDLCursorList.AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer;
+begin
+  result := inherited AddObject( aName, aObject );
+end;
+
+constructor TSDLCursorList.Create;
+begin
+  inherited;
+  Duplicates := dupIgnore;
+end;
+
+function TSDLCursorList.GetObject(aIndex: Integer): TSDLCustomCursor;
+begin
+  result := TSDLCustomCursor( inherited GetObject( aIndex ) );
+end;
+
+procedure TSDLCursorList.PutObject(aIndex: Integer; aObject: TSDLCustomCursor);
+begin
+  inherited PutObject( aIndex, aObject );
+end;
+
+end.
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas
index 64009176..8ba3946f 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas
@@ -1,216 +1,216 @@
-unit sdlstreams;

-{

-  $Id: sdlstreams.pas,v 1.1 2004/02/05 00:08:20 savage Exp $

-  

-}

-{******************************************************************}

-{                                                                  }

-{       SDL - Simple DirectMedia Layer                             }

-{    Copyright (C) 1997, 1998, 1999, 2000, 2001  Sam Lantinga      }

-{                                                                  }

-{ Portions created by Chris Bruner are                             }

-{ Copyright (C) 2002 Chris Bruner.                                 }

-{                                                                  }

-{ Contributor(s)                                                   }

-{ --------------                                                   }

-{                                                                  }

-{                                                                  }

-{ Obtained through:                                                }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )            }

-{                                                                  }

-{ You may retrieve the latest version of this file at the Project  }

-{ JEDI home page, located at http://delphi-jedi.org                }

-{                                                                  }

-{ 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/NPL/NPL-1_1Final.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.                        }

-{                                                                  }

-{ Description                                                      }

-{ -----------                                                      }

-{  Shows how to use OpenGL to do 2D and 3D with the SDL libraries  }

-{                                                                  }

-{                                                                  }

-{ Requires                                                         }

-{ --------                                                         }

-{   SDL runtime libary somewhere in your path                      }

-{   The Latest SDL runtime can be found on http://www.libsdl.org   }

-{                                                                  }

-{ Programming Notes                                                }

-{ -----------------                                                }

-{                                                                  }

-{                                                                  }

-{                                                                  }

-{                                                                  }

-{                                                                  }

-{ Revision History                                                 }

-{ ----------------                                                 }

-{   January  11 2002 - CB : Software embraced and extended by      }

-{                           Chris Bruner of Crystal Software       }

-{                           (Canada) Inc.                          }

-{                                                                  }

-{  February  11 2002 - DL : Added FreePascal support as suggested  }

-{                        by "QuePasha Pepe" <mrkroket@hotmail.com> }

-{                                                                  }

-{******************************************************************}

-{

-  $Log: sdlstreams.pas,v $

-  Revision 1.1  2004/02/05 00:08:20  savage

-  Module 1.0 release

-

-  

-}

-

-{$i jedi-sdl.inc}

-

-interface

-

-uses

-  Classes,

-  SysUtils,

-  sdl,

-  sdlutils;

-

-{$IFDEF FPC}

-type

-  EinvalidContainer=class(Exception); 

- {$ENDIF}

-  

-function LoadSDLBMPFromStream( Stream : TStream ) : PSDL_Surface;

-procedure SaveSDLBMPToStream( SDL_Surface : PSDL_Surface; stream : TStream );

-function SDL_Swap16( D : UInt16 ) : Uint16;

-function SDL_Swap32( D : UInt32 ) : Uint32;

-function SDLStreamSetup( stream : TStream ) : PSDL_RWops;

-// this only closes the SDL_RWops part of the stream, not the stream itself

-procedure SDLStreamCloseRWops( SDL_RWops : PSDL_RWops );

-

-implementation

-

-function SDL_Swap16( D : UInt16 ) : Uint16;

-begin

-  Result := ( D shl 8 ) or ( D shr 8 );

-end;

-

-function SDL_Swap32( D : UInt32 ) : Uint32;

-begin

-  Result := ( ( D shl 24 ) or ( ( D shl 8 ) and $00FF0000 ) or ( ( D shr 8 ) and $0000FF00 ) or ( D shr 24 ) );

-end;

-

-(*function SDL_Swap64(D : UInt64) : Uint64;

-var hi,lo : Uint32;

-begin

-        // Separate into high and low 32-bit resultues and swap them

-        lo := Uint32(D and $0FFFFFFFF); // bloody pascal is too tight in it's type checking!

-        D := D shr 32;

-        hi = Uint32((D and $FFFFFFFF));

-        result = SDL_Swap32(lo);

-        result := result shl 32;

-        result := result or SDL_Swap32(hi);

-end;

-*)

-

-function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;

-var

-  stream : TStream;

-  origin : Word;

-begin

-  stream := TStream( context.unknown );

-  if ( stream = nil ) then

-    raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );

-  case whence of

-    0 : origin := soFromBeginning; //	Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.

-    1 : origin := soFromCurrent; //	Offset is from the current position in the resource. Seek moves to Position + Offset.

-    2 : origin := soFromEnd;

-  else

-    origin := soFromBeginning; // just in case

-  end;

-  Result := stream.Seek( offset, origin );

-end;

-

-function SDLStreamWrite( context : PSDL_RWops; Ptr : Pointer;

-  size : Integer; num : Integer ) : Integer; cdecl;

-var

-  stream : TStream;

-begin

-  stream := TStream( context.unknown );

-  if ( stream = nil ) then

-    raise EInvalidContainer.Create( 'SDLStreamWrite on nil' );

-  try

-    Result := stream.Write( Ptr^, Size * num ) div size;

-  except

-    Result := -1;

-  end;

-end;

-

-function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum

-  : Integer ) : Integer; cdecl;

-var

-  stream : TStream;

-begin

-  stream := TStream( context.unknown );

-  if ( stream = nil ) then

-    raise EInvalidContainer.Create( 'SDLStreamRead on nil' );

-  try

-    Result := stream.read( Ptr^, Size * maxnum ) div size;

-  except

-    Result := -1;

-  end;

-end;

-

-function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;

-var

-  stream : TStream;

-begin

-  stream := TStream( context.unknown );

-  if ( stream = nil ) then

-    raise EInvalidContainer.Create( 'SDLStreamClose on nil' );

-  stream.Free;

-  Result := 1;

-end;

-

-function SDLStreamSetup( stream : TStream ) : PSDL_RWops;

-begin

-  result := SDL_AllocRW;

-  if ( result = nil ) then

-    raise EInvalidContainer.Create( 'could not create SDLStream on nil' );

-  result.unknown := TUnknown( stream );

-  result.seek := SDLStreamSeek;

-  result.read := SDLStreamRead;

-  result.write := SDLStreamWrite;

-  result.close := SDLStreamClose;

-  Result.type_ := 2; // TUnknown

-end;

-

-// this only closes the SDL part of the stream, not the context

-

-procedure SDLStreamCloseRWops( SDL_RWops : PSDL_RWops );

-begin

-  SDL_FreeRW( SDL_RWops );

-end;

-

-function LoadSDLBMPFromStream( stream : TStream ) : PSDL_Surface;

-var

-  SDL_RWops : PSDL_RWops;

-begin

-  SDL_RWops := SDLStreamSetup( stream );

-  result := SDL_LoadBMP_RW( SDL_RWops, 0 );

-  SDLStreamCloseRWops( SDL_RWops );

-end;

-

-procedure SaveSDLBMPToStream( SDL_Surface : PSDL_Surface; stream : TStream );

-var

-  SDL_RWops : PSDL_RWops;

-begin

-  SDL_RWops := SDLStreamSetup( stream );

-  SDL_SaveBMP_RW( SDL_Surface, SDL_RWops, 0 );

-  SDLStreamCloseRWops( SDL_RWops );

-end;

-

-end.

-

+unit sdlstreams;
+{
+  $Id: sdlstreams.pas,v 1.1 2004/02/05 00:08:20 savage Exp $
+  
+}
+{******************************************************************}
+{                                                                  }
+{       SDL - Simple DirectMedia Layer                             }
+{    Copyright (C) 1997, 1998, 1999, 2000, 2001  Sam Lantinga      }
+{                                                                  }
+{ Portions created by Chris Bruner are                             }
+{ Copyright (C) 2002 Chris Bruner.                                 }
+{                                                                  }
+{ Contributor(s)                                                   }
+{ --------------                                                   }
+{                                                                  }
+{                                                                  }
+{ Obtained through:                                                }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )            }
+{                                                                  }
+{ You may retrieve the latest version of this file at the Project  }
+{ JEDI home page, located at http://delphi-jedi.org                }
+{                                                                  }
+{ 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/NPL/NPL-1_1Final.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.                        }
+{                                                                  }
+{ Description                                                      }
+{ -----------                                                      }
+{  Shows how to use OpenGL to do 2D and 3D with the SDL libraries  }
+{                                                                  }
+{                                                                  }
+{ Requires                                                         }
+{ --------                                                         }
+{   SDL runtime libary somewhere in your path                      }
+{   The Latest SDL runtime can be found on http://www.libsdl.org   }
+{                                                                  }
+{ Programming Notes                                                }
+{ -----------------                                                }
+{                                                                  }
+{                                                                  }
+{                                                                  }
+{                                                                  }
+{                                                                  }
+{ Revision History                                                 }
+{ ----------------                                                 }
+{   January  11 2002 - CB : Software embraced and extended by      }
+{                           Chris Bruner of Crystal Software       }
+{                           (Canada) Inc.                          }
+{                                                                  }
+{  February  11 2002 - DL : Added FreePascal support as suggested  }
+{                        by "QuePasha Pepe" <mrkroket@hotmail.com> }
+{                                                                  }
+{******************************************************************}
+{
+  $Log: sdlstreams.pas,v $
+  Revision 1.1  2004/02/05 00:08:20  savage
+  Module 1.0 release
+
+  
+}
+
+{$i jedi-sdl.inc}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  sdl,
+  sdlutils;
+
+{$IFDEF FPC}
+type
+  EinvalidContainer=class(Exception); 
+ {$ENDIF}
+  
+function LoadSDLBMPFromStream( Stream : TStream ) : PSDL_Surface;
+procedure SaveSDLBMPToStream( SDL_Surface : PSDL_Surface; stream : TStream );
+function SDL_Swap16( D : UInt16 ) : Uint16;
+function SDL_Swap32( D : UInt32 ) : Uint32;
+function SDLStreamSetup( stream : TStream ) : PSDL_RWops;
+// this only closes the SDL_RWops part of the stream, not the stream itself
+procedure SDLStreamCloseRWops( SDL_RWops : PSDL_RWops );
+
+implementation
+
+function SDL_Swap16( D : UInt16 ) : Uint16;
+begin
+  Result := ( D shl 8 ) or ( D shr 8 );
+end;
+
+function SDL_Swap32( D : UInt32 ) : Uint32;
+begin
+  Result := ( ( D shl 24 ) or ( ( D shl 8 ) and $00FF0000 ) or ( ( D shr 8 ) and $0000FF00 ) or ( D shr 24 ) );
+end;
+
+(*function SDL_Swap64(D : UInt64) : Uint64;
+var hi,lo : Uint32;
+begin
+        // Separate into high and low 32-bit resultues and swap them
+        lo := Uint32(D and $0FFFFFFFF); // bloody pascal is too tight in it's type checking!
+        D := D shr 32;
+        hi = Uint32((D and $FFFFFFFF));
+        result = SDL_Swap32(lo);
+        result := result shl 32;
+        result := result or SDL_Swap32(hi);
+end;
+*)
+
+function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;
+var
+  stream : TStream;
+  origin : Word;
+begin
+  stream := TStream( context.unknown );
+  if ( stream = nil ) then
+    raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );
+  case whence of
+    0 : origin := soFromBeginning; //	Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.
+    1 : origin := soFromCurrent; //	Offset is from the current position in the resource. Seek moves to Position + Offset.
+    2 : origin := soFromEnd;
+  else
+    origin := soFromBeginning; // just in case
+  end;
+  Result := stream.Seek( offset, origin );
+end;
+
+function SDLStreamWrite( context : PSDL_RWops; Ptr : Pointer;
+  size : Integer; num : Integer ) : Integer; cdecl;
+var
+  stream : TStream;
+begin
+  stream := TStream( context.unknown );
+  if ( stream = nil ) then
+    raise EInvalidContainer.Create( 'SDLStreamWrite on nil' );
+  try
+    Result := stream.Write( Ptr^, Size * num ) div size;
+  except
+    Result := -1;
+  end;
+end;
+
+function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum
+  : Integer ) : Integer; cdecl;
+var
+  stream : TStream;
+begin
+  stream := TStream( context.unknown );
+  if ( stream = nil ) then
+    raise EInvalidContainer.Create( 'SDLStreamRead on nil' );
+  try
+    Result := stream.read( Ptr^, Size * maxnum ) div size;
+  except
+    Result := -1;
+  end;
+end;
+
+function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;
+var
+  stream : TStream;
+begin
+  stream := TStream( context.unknown );
+  if ( stream = nil ) then
+    raise EInvalidContainer.Create( 'SDLStreamClose on nil' );
+  stream.Free;
+  Result := 1;
+end;
+
+function SDLStreamSetup( stream : TStream ) : PSDL_RWops;
+begin
+  result := SDL_AllocRW;
+  if ( result = nil ) then
+    raise EInvalidContainer.Create( 'could not create SDLStream on nil' );
+  result.unknown := TUnknown( stream );
+  result.seek := SDLStreamSeek;
+  result.read := SDLStreamRead;
+  result.write := SDLStreamWrite;
+  result.close := SDLStreamClose;
+  Result.type_ := 2; // TUnknown
+end;
+
+// this only closes the SDL part of the stream, not the context
+
+procedure SDLStreamCloseRWops( SDL_RWops : PSDL_RWops );
+begin
+  SDL_FreeRW( SDL_RWops );
+end;
+
+function LoadSDLBMPFromStream( stream : TStream ) : PSDL_Surface;
+var
+  SDL_RWops : PSDL_RWops;
+begin
+  SDL_RWops := SDLStreamSetup( stream );
+  result := SDL_LoadBMP_RW( SDL_RWops, 0 );
+  SDLStreamCloseRWops( SDL_RWops );
+end;
+
+procedure SaveSDLBMPToStream( SDL_Surface : PSDL_Surface; stream : TStream );
+var
+  SDL_RWops : PSDL_RWops;
+begin
+  SDL_RWops := SDLStreamSetup( stream );
+  SDL_SaveBMP_RW( SDL_Surface, SDL_RWops, 0 );
+  SDLStreamCloseRWops( SDL_RWops );
+end;
+
+end.
+
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas
index 8e00dd6f..a479b493 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas
@@ -1,197 +1,197 @@
-unit sdlticks;

-{

-  $Id: sdlticks.pas,v 1.2 2006/11/08 08:22:48 savage Exp $

-

-}

-{******************************************************************************}

-{                                                                              }

-{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }

-{                   SDL GetTicks Class Wrapper                                 }

-{                                                                              }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Portions created by Dominique Louis are                                      }

-{ Copyright (C) 2004 - 2100 Dominique Louis.                                   }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{   SDL Window Wrapper                                                         }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   SDL.dll on Windows platforms                                               }

-{   libSDL-1.1.so.0 on Linux platform                                          }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{                                                                              }

-{   September   23 2004 - DL : Initial Creation                                }

-{

-  $Log: sdlticks.pas,v $

-  Revision 1.2  2006/11/08 08:22:48  savage

-  updates tp sdlgameinterface and sdlticks functions.

-

-  Revision 1.1  2004/09/30 22:35:47  savage

-  Changes, enhancements and additions as required to get SoAoS working.

-

-}

-{******************************************************************************}

-

-interface

-

-uses

-  sdl;

-

-type

-  TSDLTicks = class

-  private

-    FStartTime : UInt32;

-    FTicksPerSecond : UInt32;

-    FElapsedLastTime : UInt32;

-    FFPSLastTime : UInt32;

-    FLockFPSLastTime : UInt32;

-  public

-    constructor Create;

-    destructor Destroy; override; // destructor

-

-    {*****************************************************************************

-     Init

-     If the hi-res timer is present, the tick rate is stored and the function

-     returns true. Otherwise, the function returns false, and the timer should

-     not be used.

-    *****************************************************************************}

-    function Init : boolean;

-

-    {***************************************************************************

-     GetGetElapsedSeconds

-     Returns the Elapsed time, since the function was last called.

-    ***************************************************************************}

-    function GetElapsedSeconds : Single;

-

-    {***************************************************************************

-     GetFPS

-     Returns the average frames per second.

-     If this is not called every frame, the client should track the number

-     of frames itself, and reset the value after this is called.

-    ***************************************************************************}

-    function GetFPS : single;

-

-    {***************************************************************************

-     LockFPS

-     Used to lock the frame rate to a set amount. This will block until enough

-     time has passed to ensure that the fps won't go over the requested amount.

-     Note that this can only keep the fps from going above the specified level;

-     it can still drop below it. It is assumed that if used, this function will

-     be called every frame. The value returned is the instantaneous fps, which

-     will be less than or equal to the targetFPS.

-    ***************************************************************************}

-    procedure LockFPS( targetFPS : Byte );

-  end;

-

-implementation

-

-{ TSDLTicks }

-constructor TSDLTicks.Create;

-begin

-  inherited;

-  FTicksPerSecond := 1000;

-end;

-

-destructor TSDLTicks.Destroy;

-begin

-  inherited;

-end;

-

-function TSDLTicks.GetElapsedSeconds : Single;

-var

-  currentTime       : Cardinal;

-begin

-  currentTime := SDL_GetTicks;

-

-  result := ( currentTime - FElapsedLastTime ) / FTicksPerSecond;

-

-  // reset the timer

-  FElapsedLastTime := currentTime;

-end;

-

-function TSDLTicks.GetFPS : Single;

-var

-  currentTime, FrameTime : UInt32;

-  fps               : single;

-begin

-  currentTime := SDL_GetTicks;

-

-  FrameTime := ( currentTime - FFPSLastTime );

-

-  if FrameTime = 0 then

-    FrameTime := 1;

-

-  fps := FTicksPerSecond / FrameTime;

-

-  // reset the timer

-  FFPSLastTime := currentTime;

-  result := fps;

-end;

-

-function TSDLTicks.Init : boolean;

-begin

-  FStartTime := SDL_GetTicks;

-  FElapsedLastTime := FStartTime;

-  FFPSLastTime := FStartTime;

-  FLockFPSLastTime := FStartTime;

-  result := true;

-end;

-

-procedure TSDLTicks.LockFPS( targetFPS : Byte );

-var

-  currentTime       : UInt32;

-  targetTime        : single;

-begin

-  if ( targetFPS = 0 ) then

-    targetFPS := 1;

-

-  targetTime := FTicksPerSecond / targetFPS;

-

-  // delay to maintain a constant frame rate

-  repeat

-    currentTime := SDL_GetTicks;

-  until ( ( currentTime - FLockFPSLastTime ) > targetTime );

-

-  // reset the timer

-  FLockFPSLastTime := currentTime;

-end;

-

-end.

-

+unit sdlticks;
+{
+  $Id: sdlticks.pas,v 1.2 2006/11/08 08:22:48 savage Exp $
+
+}
+{******************************************************************************}
+{                                                                              }
+{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }
+{                   SDL GetTicks Class Wrapper                                 }
+{                                                                              }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Portions created by Dominique Louis are                                      }
+{ Copyright (C) 2004 - 2100 Dominique Louis.                                   }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{   SDL Window Wrapper                                                         }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   SDL.dll on Windows platforms                                               }
+{   libSDL-1.1.so.0 on Linux platform                                          }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{                                                                              }
+{   September   23 2004 - DL : Initial Creation                                }
+{
+  $Log: sdlticks.pas,v $
+  Revision 1.2  2006/11/08 08:22:48  savage
+  updates tp sdlgameinterface and sdlticks functions.
+
+  Revision 1.1  2004/09/30 22:35:47  savage
+  Changes, enhancements and additions as required to get SoAoS working.
+
+}
+{******************************************************************************}
+
+interface
+
+uses
+  sdl;
+
+type
+  TSDLTicks = class
+  private
+    FStartTime : UInt32;
+    FTicksPerSecond : UInt32;
+    FElapsedLastTime : UInt32;
+    FFPSLastTime : UInt32;
+    FLockFPSLastTime : UInt32;
+  public
+    constructor Create;
+    destructor Destroy; override; // destructor
+
+    {*****************************************************************************
+     Init
+     If the hi-res timer is present, the tick rate is stored and the function
+     returns true. Otherwise, the function returns false, and the timer should
+     not be used.
+    *****************************************************************************}
+    function Init : boolean;
+
+    {***************************************************************************
+     GetGetElapsedSeconds
+     Returns the Elapsed time, since the function was last called.
+    ***************************************************************************}
+    function GetElapsedSeconds : Single;
+
+    {***************************************************************************
+     GetFPS
+     Returns the average frames per second.
+     If this is not called every frame, the client should track the number
+     of frames itself, and reset the value after this is called.
+    ***************************************************************************}
+    function GetFPS : single;
+
+    {***************************************************************************
+     LockFPS
+     Used to lock the frame rate to a set amount. This will block until enough
+     time has passed to ensure that the fps won't go over the requested amount.
+     Note that this can only keep the fps from going above the specified level;
+     it can still drop below it. It is assumed that if used, this function will
+     be called every frame. The value returned is the instantaneous fps, which
+     will be less than or equal to the targetFPS.
+    ***************************************************************************}
+    procedure LockFPS( targetFPS : Byte );
+  end;
+
+implementation
+
+{ TSDLTicks }
+constructor TSDLTicks.Create;
+begin
+  inherited;
+  FTicksPerSecond := 1000;
+end;
+
+destructor TSDLTicks.Destroy;
+begin
+  inherited;
+end;
+
+function TSDLTicks.GetElapsedSeconds : Single;
+var
+  currentTime       : Cardinal;
+begin
+  currentTime := SDL_GetTicks;
+
+  result := ( currentTime - FElapsedLastTime ) / FTicksPerSecond;
+
+  // reset the timer
+  FElapsedLastTime := currentTime;
+end;
+
+function TSDLTicks.GetFPS : Single;
+var
+  currentTime, FrameTime : UInt32;
+  fps               : single;
+begin
+  currentTime := SDL_GetTicks;
+
+  FrameTime := ( currentTime - FFPSLastTime );
+
+  if FrameTime = 0 then
+    FrameTime := 1;
+
+  fps := FTicksPerSecond / FrameTime;
+
+  // reset the timer
+  FFPSLastTime := currentTime;
+  result := fps;
+end;
+
+function TSDLTicks.Init : boolean;
+begin
+  FStartTime := SDL_GetTicks;
+  FElapsedLastTime := FStartTime;
+  FFPSLastTime := FStartTime;
+  FLockFPSLastTime := FStartTime;
+  result := true;
+end;
+
+procedure TSDLTicks.LockFPS( targetFPS : Byte );
+var
+  currentTime       : UInt32;
+  targetTime        : single;
+begin
+  if ( targetFPS = 0 ) then
+    targetFPS := 1;
+
+  targetTime := FTicksPerSecond / targetFPS;
+
+  // delay to maintain a constant frame rate
+  repeat
+    currentTime := SDL_GetTicks;
+  until ( ( currentTime - FLockFPSLastTime ) > targetTime );
+
+  // reset the timer
+  FLockFPSLastTime := currentTime;
+end;
+
+end.
+
  
\ No newline at end of file
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas
index 7fbed878..e01f3cdb 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas
@@ -1,4363 +1,4363 @@
-unit sdlutils;

-{

-  $Id: sdlutils.pas,v 1.5 2006/11/19 18:56:44 savage Exp $

-

-}

-{******************************************************************************}

-{                                                                              }

-{       Borland Delphi SDL - Simple DirectMedia Layer                          }

-{                SDL Utility functions                                         }

-{                                                                              }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Tom Jones <tigertomjones@gmx.de>                                             }

-{                                                                              }

-{ Portions created by Tom Jones are                                            }

-{ Copyright (C) 2000 - 2001 Tom Jones.                                         }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }

-{ Róbert Kisnémeth <mikrobi@freemail.hu>                                       }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{   Helper functions...                                                        }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   SDL.dll on Windows platforms                                               }

-{   libSDL-1.1.so.0 on Linux platform                                          }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{               2000 - TJ : Initial creation                                   }

-{                                                                              }

-{   July   13   2001 - DL : Added PutPixel and GetPixel routines.              }

-{                                                                              }

-{   Sept   14   2001 - RK : Added flipping routines.                           }

-{                                                                              }

-{   Sept   19   2001 - RK : Added PutPixel & line drawing & blitting with ADD  }

-{                           effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel }

-{                           Added PSDLRect()                                   }

-{   Sept   22   2001 - DL : Removed need for Windows.pas by defining types here}

-{                           Also removed by poor attempt or a dialog box       }

-{                                                                              }

-{   Sept   25   2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine,   }

-{                           SubSurface, MonoSurface & TexturedSurface          }

-{                                                                              }

-{   Sept   26   2001 - DL : Made change so that it refers to native Pascal     }

-{                           types rather that Windows types. This makes it more}

-{                           portable to Linix.                                 }

-{                                                                              }

-{   Sept   27   2001 - RK : SDLUtils now can be compiled with FreePascal       }

-{                                                                              }

-{   Oct    27   2001 - JF : Added ScrollY function                             }

-{                                                                              }

-{   Jan    21   2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface          }

-{                                                                              }

-{   Mar    28   2002 - JF : Added SDL_RotateSurface                            }

-{                                                                              }

-{   May    13   2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub         }

-{                                                                              }

-{   May    27   2002 - YS : GradientFillRect function                          }

-{                                                                              }

-{   May    30   2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit               }

-{                           & SDL_50Scanline2xBlit                             }

-{                                                                              }

-{  June    12   2002 - RK : Added SDL_PixelTestSurfaceVsRect                   }

-{                                                                              }

-{  June    12   2002 - JF : Updated SDL_PixelTestSurfaceVsRect                 }

-{                                                                              }

-{ November  9   2002 - JF : Added Jason's boolean Surface functions            }

-{                                                                              }

-{ December 10   2002 - DE : Added Dean's SDL_ClipLine function                 }

-{                                                                              }

-{    April 26   2003 - SS : Incorporated JF's changes to SDL_ClipLine          }

-{                           Fixed SDL_ClipLine bug for non-zero cliprect x, y  }

-{                           Added overloaded SDL_DrawLine for dashed lines     }

-{                                                                              }

-{******************************************************************************}

-{

-  $Log: sdlutils.pas,v $

-  Revision 1.5  2006/11/19 18:56:44  savage

-  Removed Hints and Warnings.

-

-  Revision 1.4  2004/06/02 19:38:53  savage

-  Changes to SDL_GradientFillRect as suggested by

-  Ángel Eduardo García Hernández.  Many thanks.

-

-  Revision 1.3  2004/05/29 23:11:54  savage

-  Changes to SDL_ScaleSurfaceRect as suggested by

-  Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks.

-

-  Revision 1.2  2004/02/14 00:23:39  savage

-  As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.

-

-  Revision 1.1  2004/02/05 00:08:20  savage

-  Module 1.0 release

-

-

-}

-

-interface

-

-{$I jedi-sdl.inc}

-

-uses

-{$IFDEF UNIX}

-  Types,

-{$IFNDEF DARWIN}

-  Xlib,

-{$ENDIF}

-{$ENDIF}

-  SysUtils,

-  sdl;

-

-type

-  TGradientStyle = ( gsHorizontal, gsVertical );

-

-// Pixel procedures

-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :

-  PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean;

-

-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;

-

-procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :

-  Uint32 );

-

-procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :

-  cardinal );

-

-procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :

-  cardinal );

-

-// Line procedures

-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal ); overload;

-

-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal; DashLength, DashSpace : byte ); overload;

-

-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-

-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-

-// Surface procedures

-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );

-

-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;

-  TextureRect : PSDL_Rect );

-

-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );

-

-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );

-

-// Flip procedures

-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );

-

-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );

-

-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;

-

-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload;

-

-function SDLRect( aRect : TRect ) : TSDL_Rect; overload;

-

-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,

-  Width, Height : integer ) : PSDL_Surface;

-

-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );

-

-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );

-

-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :

-  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );

-

-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :

-  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );

-

-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;

-

-// Fill Rect routine

-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );

-

-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );

-

-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );

-

-// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface!

-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );

-

-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );

-

-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );

-

-//

-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :

-  PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :

-  boolean;

-

-// Jason's boolean Surface functions

-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-

-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-

-function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;

-

-implementation

-

-uses

-  Math;

-

-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :

-  PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean;

-var

-  Src_Rect1, Src_Rect2 : TSDL_Rect;

-  right1, bottom1 : integer;

-  right2, bottom2 : integer;

-  Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;

-  Mod1, Mod2   : cardinal;

-  Addr1, Addr2 : PtrUInt;

-  BPP          : cardinal;

-  Pitch1, Pitch2 : cardinal;

-  TransparentColor1, TransparentColor2 : cardinal;

-  tx, ty       : cardinal;

-// StartTick    : cardinal; // Auto Removed, Unused Variable

-  Color1, Color2 : cardinal;

-begin

-  Result := false;

-  if SrcRect1 = nil then

-  begin

-    with Src_Rect1 do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface1.w;

-      h := SrcSurface1.h;

-    end;

-  end

-  else

-    Src_Rect1 := SrcRect1^;

-  if SrcRect2 = nil then

-  begin

-    with Src_Rect2 do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface2.w;

-      h := SrcSurface2.h;

-    end;

-  end

-  else

-    Src_Rect2 := SrcRect2^;

-  with Src_Rect1 do

-  begin

-    Right1 := Left1 + w;

-    Bottom1 := Top1 + h;

-  end;

-  with Src_Rect2 do

-  begin

-    Right2 := Left2 + w;

-    Bottom2 := Top2 + h;

-  end;

-  if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <=

-    Top2 ) then

-    exit;

-  if Left1 <= Left2 then

-  begin

-    // 1. left, 2. right

-    Scan1Start := Src_Rect1.x + Left2 - Left1;

-    Scan2Start := Src_Rect2.x;

-    ScanWidth := Right1 - Left2;

-    with Src_Rect2 do

-      if ScanWidth > w then

-        ScanWidth := w;

-  end

-  else

-  begin

-    // 1. right, 2. left

-    Scan1Start := Src_Rect1.x;

-    Scan2Start := Src_Rect2.x + Left1 - Left2;

-    ScanWidth := Right2 - Left1;

-    with Src_Rect1 do

-      if ScanWidth > w then

-        ScanWidth := w;

-  end;

-  with SrcSurface1^ do

-  begin

-    Pitch1 := Pitch;

-    Addr1 := PtrUInt( Pixels );

-    inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );

-    with format^ do

-    begin

-      BPP := BytesPerPixel;

-      TransparentColor1 := colorkey;

-    end;

-  end;

-  with SrcSurface2^ do

-  begin

-    TransparentColor2 := format.colorkey;

-    Pitch2 := Pitch;

-    Addr2 := PtrUInt( Pixels );

-    inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) );

-  end;

-  Mod1 := Pitch1 - ( ScanWidth * BPP );

-  Mod2 := Pitch2 - ( ScanWidth * BPP );

-  inc( Addr1, BPP * Scan1Start );

-  inc( Addr2, BPP * Scan2Start );

-  if Top1 <= Top2 then

-  begin

-    // 1. up, 2. down

-    ScanHeight := Bottom1 - Top2;

-    if ScanHeight > Src_Rect2.h then

-      ScanHeight := Src_Rect2.h;

-    inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );

-  end

-  else

-  begin

-    // 1. down, 2. up

-    ScanHeight := Bottom2 - Top1;

-    if ScanHeight > Src_Rect1.h then

-      ScanHeight := Src_Rect1.h;

-    inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) );

-  end;

-  case BPP of

-    1 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <>

-            TransparentColor2 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1 );

-          inc( Addr2 );

-        end;

-        inc( Addr1, Mod1 );

-        inc( Addr2, Mod2 );

-      end;

-    2 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <>

-            TransparentColor2 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 2 );

-          inc( Addr2, 2 );

-        end;

-        inc( Addr1, Mod1 );

-        inc( Addr2, Mod2 );

-      end;

-    3 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          Color1 := PLongWord( Addr1 )^ and $00FFFFFF;

-          Color2 := PLongWord( Addr2 )^ and $00FFFFFF;

-          if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 )

-            then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 3 );

-          inc( Addr2, 3 );

-        end;

-        inc( Addr1, Mod1 );

-        inc( Addr2, Mod2 );

-      end;

-    4 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <>

-            TransparentColor2 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 4 );

-          inc( Addr2, 4 );

-        end;

-        inc( Addr1, Mod1 );

-        inc( Addr2, Mod2 );

-      end;

-  end;

-end;

-

-procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :

-  cardinal );

-var

-  SrcColor     : cardinal;

-  Addr         : PtrUInt;

-  R, G, B      : cardinal;

-begin

-  if Color = 0 then

-    exit;

-  with DstSurface^ do

-  begin

-    Addr := PtrUInt( Pixels ) + y * Pitch + x * format.BytesPerPixel;

-    SrcColor := PUInt32( Addr )^;

-    case format.BitsPerPixel of

-      8 :

-        begin

-          R := SrcColor and $E0 + Color and $E0;

-          G := SrcColor and $1C + Color and $1C;

-          B := SrcColor and $03 + Color and $03;

-          if R > $E0 then

-            R := $E0;

-          if G > $1C then

-            G := $1C;

-          if B > $03 then

-            B := $03;

-          PUInt8( Addr )^ := R or G or B;

-        end;

-      15 :

-        begin

-          R := SrcColor and $7C00 + Color and $7C00;

-          G := SrcColor and $03E0 + Color and $03E0;

-          B := SrcColor and $001F + Color and $001F;

-          if R > $7C00 then

-            R := $7C00;

-          if G > $03E0 then

-            G := $03E0;

-          if B > $001F then

-            B := $001F;

-          PUInt16( Addr )^ := R or G or B;

-        end;

-      16 :

-        begin

-          R := SrcColor and $F800 + Color and $F800;

-          G := SrcColor and $07C0 + Color and $07C0;

-          B := SrcColor and $001F + Color and $001F;

-          if R > $F800 then

-            R := $F800;

-          if G > $07C0 then

-            G := $07C0;

-          if B > $001F then

-            B := $001F;

-          PUInt16( Addr )^ := R or G or B;

-        end;

-      24 :

-        begin

-          R := SrcColor and $00FF0000 + Color and $00FF0000;

-          G := SrcColor and $0000FF00 + Color and $0000FF00;

-          B := SrcColor and $000000FF + Color and $000000FF;

-          if R > $FF0000 then

-            R := $FF0000;

-          if G > $00FF00 then

-            G := $00FF00;

-          if B > $0000FF then

-            B := $0000FF;

-          PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;

-        end;

-      32 :

-        begin

-          R := SrcColor and $00FF0000 + Color and $00FF0000;

-          G := SrcColor and $0000FF00 + Color and $0000FF00;

-          B := SrcColor and $000000FF + Color and $000000FF;

-          if R > $FF0000 then

-            R := $FF0000;

-          if G > $00FF00 then

-            G := $00FF00;

-          if B > $0000FF then

-            B := $0000FF;

-          PUInt32( Addr )^ := R or G or B;

-        end;

-    end;

-  end;

-end;

-

-procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :

-  cardinal );

-var

-  SrcColor     : cardinal;

-  Addr         : PtrUInt;

-  R, G, B      : cardinal;

-begin

-  if Color = 0 then

-    exit;

-  with DstSurface^ do

-  begin

-    Addr := PtrUInt( Pixels ) + y * Pitch + x * format.BytesPerPixel;

-    SrcColor := PUInt32( Addr )^;

-    case format.BitsPerPixel of

-      8 :

-        begin

-          R := SrcColor and $E0 - Color and $E0;

-          G := SrcColor and $1C - Color and $1C;

-          B := SrcColor and $03 - Color and $03;

-          if R > $E0 then

-            R := 0;

-          if G > $1C then

-            G := 0;

-          if B > $03 then

-            B := 0;

-          PUInt8( Addr )^ := R or G or B;

-        end;

-      15 :

-        begin

-          R := SrcColor and $7C00 - Color and $7C00;

-          G := SrcColor and $03E0 - Color and $03E0;

-          B := SrcColor and $001F - Color and $001F;

-          if R > $7C00 then

-            R := 0;

-          if G > $03E0 then

-            G := 0;

-          if B > $001F then

-            B := 0;

-          PUInt16( Addr )^ := R or G or B;

-        end;

-      16 :

-        begin

-          R := SrcColor and $F800 - Color and $F800;

-          G := SrcColor and $07C0 - Color and $07C0;

-          B := SrcColor and $001F - Color and $001F;

-          if R > $F800 then

-            R := 0;

-          if G > $07C0 then

-            G := 0;

-          if B > $001F then

-            B := 0;

-          PUInt16( Addr )^ := R or G or B;

-        end;

-      24 :

-        begin

-          R := SrcColor and $00FF0000 - Color and $00FF0000;

-          G := SrcColor and $0000FF00 - Color and $0000FF00;

-          B := SrcColor and $000000FF - Color and $000000FF;

-          if R > $FF0000 then

-            R := 0;

-          if G > $00FF00 then

-            G := 0;

-          if B > $0000FF then

-            B := 0;

-          PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;

-        end;

-      32 :

-        begin

-          R := SrcColor and $00FF0000 - Color and $00FF0000;

-          G := SrcColor and $0000FF00 - Color and $0000FF00;

-          B := SrcColor and $000000FF - Color and $000000FF;

-          if R > $FF0000 then

-            R := 0;

-          if G > $00FF00 then

-            G := 0;

-          if B > $0000FF then

-            B := 0;

-          PUInt32( Addr )^ := R or G or B;

-        end;

-    end;

-  end;

-end;

-// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces.

-// In 8 bit color depth mode the procedure works with the default packed

-//  palette (RRRGGGBB). It handles all clipping.

-

-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;

-  Src, Dest    : TSDL_Rect;

-  Diff         : integer;

-  SrcAddr, DestAddr : PtrUInt;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits         : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt8( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt8( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel1 and $E0 + Pixel2 and $E0;

-                G := Pixel1 and $1C + Pixel2 and $1C;

-                B := Pixel1 and $03 + Pixel2 and $03;

-                if R > $E0 then

-                  R := $E0;

-                if G > $1C then

-                  G := $1C;

-                if B > $03 then

-                  B := $03;

-                PUInt8( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt8( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    15 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel1 and $7C00 + Pixel2 and $7C00;

-                G := Pixel1 and $03E0 + Pixel2 and $03E0;

-                B := Pixel1 and $001F + Pixel2 and $001F;

-                if R > $7C00 then

-                  R := $7C00;

-                if G > $03E0 then

-                  G := $03E0;

-                if B > $001F then

-                  B := $001F;

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    16 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel1 and $F800 + Pixel2 and $F800;

-                G := Pixel1 and $07E0 + Pixel2 and $07E0;

-                B := Pixel1 and $001F + Pixel2 and $001F;

-                if R > $F800 then

-                  R := $F800;

-                if G > $07E0 then

-                  G := $07E0;

-                if B > $001F then

-                  B := $001F;

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    24 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel1 and $FF0000 + Pixel2 and $FF0000;

-                G := Pixel1 and $00FF00 + Pixel2 and $00FF00;

-                B := Pixel1 and $0000FF + Pixel2 and $0000FF;

-                if R > $FF0000 then

-                  R := $FF0000;

-                if G > $00FF00 then

-                  G := $00FF00;

-                if B > $0000FF then

-                  B := $0000FF;

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );

-              end

-              else

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;

-            end;

-            inc( SrcAddr, 3 );

-            inc( DestAddr, 3 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    32 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel1 and $FF0000 + Pixel2 and $FF0000;

-                G := Pixel1 and $00FF00 + Pixel2 and $00FF00;

-                B := Pixel1 and $0000FF + Pixel2 and $0000FF;

-                if R > $FF0000 then

-                  R := $FF0000;

-                if G > $00FF00 then

-                  G := $00FF00;

-                if B > $0000FF then

-                  B := $0000FF;

-                PUInt32( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt32( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 4 );

-            inc( DestAddr, 4 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;

-  Src, Dest    : TSDL_Rect;

-  Diff         : integer;

-  SrcAddr, DestAddr : PtrUInt;

-//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi)

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits         : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := DestSurface.Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt8( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt8( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel2 and $E0 - Pixel1 and $E0;

-                G := Pixel2 and $1C - Pixel1 and $1C;

-                B := Pixel2 and $03 - Pixel1 and $03;

-                if R > $E0 then

-                  R := 0;

-                if G > $1C then

-                  G := 0;

-                if B > $03 then

-                  B := 0;

-                PUInt8( DestAddr )^ := R or G or B;

-              end;

-            end;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    15 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel2 and $7C00 - Pixel1 and $7C00;

-                G := Pixel2 and $03E0 - Pixel1 and $03E0;

-                B := Pixel2 and $001F - Pixel1 and $001F;

-                if R > $7C00 then

-                  R := 0;

-                if G > $03E0 then

-                  G := 0;

-                if B > $001F then

-                  B := 0;

-                PUInt16( DestAddr )^ := R or G or B;

-              end;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    16 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel2 and $F800 - Pixel1 and $F800;

-                G := Pixel2 and $07E0 - Pixel1 and $07E0;

-                B := Pixel2 and $001F - Pixel1 and $001F;

-                if R > $F800 then

-                  R := 0;

-                if G > $07E0 then

-                  G := 0;

-                if B > $001F then

-                  B := 0;

-                PUInt16( DestAddr )^ := R or G or B;

-              end;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    24 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel2 and $FF0000 - Pixel1 and $FF0000;

-                G := Pixel2 and $00FF00 - Pixel1 and $00FF00;

-                B := Pixel2 and $0000FF - Pixel1 and $0000FF;

-                if R > $FF0000 then

-                  R := 0;

-                if G > $00FF00 then

-                  G := 0;

-                if B > $0000FF then

-                  B := 0;

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );

-              end;

-            end;

-            inc( SrcAddr, 3 );

-            inc( DestAddr, 3 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    32 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                R := Pixel2 and $FF0000 - Pixel1 and $FF0000;

-                G := Pixel2 and $00FF00 - Pixel1 and $00FF00;

-                B := Pixel2 and $0000FF - Pixel1 and $0000FF;

-                if R > $FF0000 then

-                  R := 0;

-                if G > $00FF00 then

-                  G := 0;

-                if B > $0000FF then

-                  B := 0;

-                PUInt32( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt32( DestAddr )^ := Pixel2;

-            end;

-            inc( SrcAddr, 4 );

-            inc( DestAddr, 4 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );

-var

-  Src, Dest    : TSDL_Rect;

-  Diff         : integer;

-  SrcAddr, DestAddr : PtrUInt;

-//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi)

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  TransparentColor, SrcColor : cardinal;

-  BPP          : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    BPP := DestSurface.Format.BytesPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case BPP of

-    1 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            SrcColor := PUInt8( SrcAddr )^;

-            if SrcColor <> TransparentColor then

-              PUInt8( DestAddr )^ := SrcColor;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    2 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            SrcColor := PUInt16( SrcAddr )^;

-            if SrcColor <> TransparentColor then

-              PUInt16( DestAddr )^ := SrcColor;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    3 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;

-            if SrcColor <> TransparentColor then

-              PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or SrcColor;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    4 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            SrcColor := PUInt32( SrcAddr )^;

-            if SrcColor <> TransparentColor then

-              PUInt32( DestAddr )^ := SrcColor;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-// TextureRect.w and TextureRect.h are not used.

-// The TextureSurface's size MUST larger than the drawing rectangle!!!

-

-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;

-  TextureRect : PSDL_Rect );

-var

-  Src, Dest    : TSDL_Rect;

-  Diff         : integer;

-  SrcAddr, DestAddr, TextAddr : PtrUInt;

-//{*_ebx, *}{*_esi, *}{*_edi, _esp*}: cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi)

-  WorkX, WorkY : word;

-  SrcMod, DestMod, TextMod : cardinal;

-SrcColor, TransparentColor{*, TextureColor*} : cardinal; // Auto Removed, Unused Variable (TextureColor)

-  BPP          : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    BPP := DestSurface.Format.BitsPerPixel;

-  end;

-  with Texture^ do

-  begin

-    TextAddr := PtrUInt( Pixels ) + UInt32( TextureRect.y ) * Pitch +

-      UInt32( TextureRect.x ) * Format.BytesPerPixel;

-    TextMod := Pitch - Src.w * Format.BytesPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  SDL_LockSurface( Texture );

-  WorkY := Src.h;

-  case BPP of

-    1 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            SrcColor := PUInt8( SrcAddr )^;

-            if SrcColor <> TransparentColor then

-              PUInt8( DestAddr )^ := PUint8( TextAddr )^;

-            inc( SrcAddr );

-            inc( DestAddr );

-            inc( TextAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          inc( TextAddr, TextMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    2 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            SrcColor := PUInt16( SrcAddr )^;

-            if SrcColor <> TransparentColor then

-              PUInt16( DestAddr )^ := PUInt16( TextAddr )^;

-            inc( SrcAddr );

-            inc( DestAddr );

-            inc( TextAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          inc( TextAddr, TextMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    3 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;

-            if SrcColor <> TransparentColor then

-              PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or ( PUInt32( TextAddr )^ and $FFFFFF );

-            inc( SrcAddr );

-            inc( DestAddr );

-            inc( TextAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          inc( TextAddr, TextMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    4 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            SrcColor := PUInt32( SrcAddr )^;

-            if SrcColor <> TransparentColor then

-              PUInt32( DestAddr )^ := PUInt32( TextAddr )^;

-            inc( SrcAddr );

-            inc( DestAddr );

-            inc( TextAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          inc( TextAddr, TextMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-  SDL_UnlockSurface( Texture );

-end;

-

-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );

-var

-  xc, yc       : cardinal;

-  rx, wx, ry, wy, ry16 : cardinal;

-  color        : cardinal;

-  modx, mody   : cardinal;

-begin

-  // Warning! No checks for surface pointers!!!

-  if srcrect = nil then

-    srcrect := @SrcSurface.clip_rect;

-  if dstrect = nil then

-    dstrect := @DstSurface.clip_rect;

-  if SDL_MustLock( SrcSurface ) then

-    SDL_LockSurface( SrcSurface );

-  if SDL_MustLock( DstSurface ) then

-    SDL_LockSurface( DstSurface );

-  modx := trunc( ( srcrect.w / dstrect.w ) * 65536 );

-  mody := trunc( ( srcrect.h / dstrect.h ) * 65536 );

-  //rx := srcrect.x * 65536;

-  ry := srcrect.y * 65536;

-  wy := dstrect.y;

-  for yc := 0 to dstrect.h - 1 do

-  begin

-    rx := srcrect.x * 65536;

-    wx := dstrect.x;

-    ry16 := ry shr 16;

-    for xc := 0 to dstrect.w - 1 do

-    begin

-      color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 );

-      SDL_PutPixel( DstSurface, wx, wy, color );

-      rx := rx + modx;

-      inc( wx );

-    end;

-    ry := ry + mody;

-    inc( wy );

-  end;

-  if SDL_MustLock( SrcSurface ) then

-    SDL_UnlockSurface( SrcSurface );

-  if SDL_MustLock( DstSurface ) then

-    SDL_UnlockSurface( DstSurface );

-end;

-// Re-map a rectangular area into an area defined by four vertices

-// Converted from C to Pascal by KiCHY

-

-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );

-const

-  SHIFTS       = 15; // Extend ints to limit round-off error (try 2 - 20)

-  THRESH       = 1 shl SHIFTS; // Threshold for pixel size value

-  procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal );

-  var

-    tm, lm, rm, bm, m : TPoint;

-    mx, my     : cardinal;

-    cr         : cardinal;

-  begin

-    // Does the destination area specify a single pixel?

-    if ( ( abs( ul.x - ur.x ) < THRESH ) and

-      ( abs( ul.x - lr.x ) < THRESH ) and

-      ( abs( ul.x - ll.x ) < THRESH ) and

-      ( abs( ul.y - ur.y ) < THRESH ) and

-      ( abs( ul.y - lr.y ) < THRESH ) and

-      ( abs( ul.y - ll.y ) < THRESH ) ) then

-    begin // Yes

-      cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) );

-      SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr );

-    end

-    else

-    begin // No

-      // Quarter the source and the destination, and then recurse

-      tm.x := ( ul.x + ur.x ) shr 1;

-      tm.y := ( ul.y + ur.y ) shr 1;

-      bm.x := ( ll.x + lr.x ) shr 1;

-      bm.y := ( ll.y + lr.y ) shr 1;

-      lm.x := ( ul.x + ll.x ) shr 1;

-      lm.y := ( ul.y + ll.y ) shr 1;

-      rm.x := ( ur.x + lr.x ) shr 1;

-      rm.y := ( ur.y + lr.y ) shr 1;

-      m.x := ( tm.x + bm.x ) shr 1;

-      m.y := ( tm.y + bm.y ) shr 1;

-      mx := ( x1 + x2 ) shr 1;

-      my := ( y1 + y2 ) shr 1;

-      CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my );

-      CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my );

-      CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 );

-      CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 );

-    end;

-  end;

-var

-  _UL, _UR, _LR, _LL : TPoint;

-  Rect_x, Rect_y, Rect_w, Rect_h : integer;

-begin

-  if SDL_MustLock( SrcSurface ) then

-    SDL_LockSurface( SrcSurface );

-  if SDL_MustLock( DstSurface ) then

-    SDL_LockSurface( DstSurface );

-  if SrcRect = nil then

-  begin

-    Rect_x := 0;

-    Rect_y := 0;

-    Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS;

-    Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS;

-  end

-  else

-  begin

-    Rect_x := SrcRect.x;

-    Rect_y := SrcRect.y;

-    Rect_w := ( SrcRect.w - 1 ) shl SHIFTS;

-    Rect_h := ( SrcRect.h - 1 ) shl SHIFTS;

-  end;

-  // Shift all values to help reduce round-off error.

-  _ul.x := ul.x shl SHIFTS;

-  _ul.y := ul.y shl SHIFTS;

-  _ur.x := ur.x shl SHIFTS;

-  _ur.y := ur.y shl SHIFTS;

-  _lr.x := lr.x shl SHIFTS;

-  _lr.y := lr.y shl SHIFTS;

-  _ll.x := ll.x shl SHIFTS;

-  _ll.y := ll.y shl SHIFTS;

-  CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h );

-  if SDL_MustLock( SrcSurface ) then

-    SDL_UnlockSurface( SrcSurface );

-  if SDL_MustLock( DstSurface ) then

-    SDL_UnlockSurface( DstSurface );

-end;

-

-// Draw a line between x1,y1 and x2,y2 to the given surface

-// NOTE: The surface must be locked before calling this!

-

-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-var

-  dx, dy, sdx, sdy, x, y, px, py : integer;

-begin

-  dx := x2 - x1;

-  dy := y2 - y1;

-  if dx < 0 then

-    sdx := -1

-  else

-    sdx := 1;

-  if dy < 0 then

-    sdy := -1

-  else

-    sdy := 1;

-  dx := sdx * dx + 1;

-  dy := sdy * dy + 1;

-  x := 0;

-  y := 0;

-  px := x1;

-  py := y1;

-  if dx >= dy then

-  begin

-    for x := 0 to dx - 1 do

-    begin

-      SDL_PutPixel( DstSurface, px, py, Color );

-      y := y + dy;

-      if y >= dx then

-      begin

-        y := y - dx;

-        py := py + sdy;

-      end;

-      px := px + sdx;

-    end;

-  end

-  else

-  begin

-    for y := 0 to dy - 1 do

-    begin

-      SDL_PutPixel( DstSurface, px, py, Color );

-      x := x + dx;

-      if x >= dy then

-      begin

-        x := x - dy;

-        px := px + sdx;

-      end;

-      py := py + sdy;

-    end;

-  end;

-end;

-

-// Draw a dashed line between x1,y1 and x2,y2 to the given surface

-// NOTE: The surface must be locked before calling this!

-

-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal; DashLength, DashSpace : byte ); overload;

-var

-  dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean;

-begin

-  counter := 0;

-  drawdash := true; //begin line drawing with dash

-

-  //Avoid invalid user-passed dash parameters

-  if ( DashLength < 1 )

-    then

-    DashLength := 1;

-  if ( DashSpace < 1 )

-    then

-    DashSpace := 0;

-

-  dx := x2 - x1;

-  dy := y2 - y1;

-  if dx < 0 then

-    sdx := -1

-  else

-    sdx := 1;

-  if dy < 0 then

-    sdy := -1

-  else

-    sdy := 1;

-  dx := sdx * dx + 1;

-  dy := sdy * dy + 1;

-  x := 0;

-  y := 0;

-  px := x1;

-  py := y1;

-  if dx >= dy then

-  begin

-    for x := 0 to dx - 1 do

-    begin

-

-      //Alternate drawing dashes, or leaving spaces

-      if drawdash then

-      begin

-        SDL_PutPixel( DstSurface, px, py, Color );

-        inc( counter );

-        if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then

-        begin

-          drawdash := false;

-          counter := 0;

-        end;

-      end

-      else //space

-      begin

-        inc( counter );

-        if counter > DashSpace - 1 then

-        begin

-          drawdash := true;

-          counter := 0;

-        end;

-      end;

-

-      y := y + dy;

-      if y >= dx then

-      begin

-        y := y - dx;

-        py := py + sdy;

-      end;

-      px := px + sdx;

-    end;

-  end

-  else

-  begin

-    for y := 0 to dy - 1 do

-    begin

-

-      //Alternate drawing dashes, or leaving spaces

-      if drawdash then

-      begin

-        SDL_PutPixel( DstSurface, px, py, Color );

-        inc( counter );

-        if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then

-        begin

-          drawdash := false;

-          counter := 0;

-        end;

-      end

-      else //space

-      begin

-        inc( counter );

-        if counter > DashSpace - 1 then

-        begin

-          drawdash := true;

-          counter := 0;

-        end;

-      end;

-

-      x := x + dx;

-      if x >= dy then

-      begin

-        x := x - dy;

-        px := px + sdx;

-      end;

-      py := py + sdy;

-    end;

-  end;

-end;

-

-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-var

-  dx, dy, sdx, sdy, x, y, px, py : integer;

-begin

-  dx := x2 - x1;

-  dy := y2 - y1;

-  if dx < 0 then

-    sdx := -1

-  else

-    sdx := 1;

-  if dy < 0 then

-    sdy := -1

-  else

-    sdy := 1;

-  dx := sdx * dx + 1;

-  dy := sdy * dy + 1;

-  x := 0;

-  y := 0;

-  px := x1;

-  py := y1;

-  if dx >= dy then

-  begin

-    for x := 0 to dx - 1 do

-    begin

-      SDL_AddPixel( DstSurface, px, py, Color );

-      y := y + dy;

-      if y >= dx then

-      begin

-        y := y - dx;

-        py := py + sdy;

-      end;

-      px := px + sdx;

-    end;

-  end

-  else

-  begin

-    for y := 0 to dy - 1 do

-    begin

-      SDL_AddPixel( DstSurface, px, py, Color );

-      x := x + dx;

-      if x >= dy then

-      begin

-        x := x - dy;

-        px := px + sdx;

-      end;

-      py := py + sdy;

-    end;

-  end;

-end;

-

-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :

-  cardinal );

-var

-  dx, dy, sdx, sdy, x, y, px, py : integer;

-begin

-  dx := x2 - x1;

-  dy := y2 - y1;

-  if dx < 0 then

-    sdx := -1

-  else

-    sdx := 1;

-  if dy < 0 then

-    sdy := -1

-  else

-    sdy := 1;

-  dx := sdx * dx + 1;

-  dy := sdy * dy + 1;

-  x := 0;

-  y := 0;

-  px := x1;

-  py := y1;

-  if dx >= dy then

-  begin

-    for x := 0 to dx - 1 do

-    begin

-      SDL_SubPixel( DstSurface, px, py, Color );

-      y := y + dy;

-      if y >= dx then

-      begin

-        y := y - dx;

-        py := py + sdy;

-      end;

-      px := px + sdx;

-    end;

-  end

-  else

-  begin

-    for y := 0 to dy - 1 do

-    begin

-      SDL_SubPixel( DstSurface, px, py, Color );

-      x := x + dx;

-      if x >= dy then

-      begin

-        x := x - dy;

-        px := px + sdx;

-      end;

-      py := py + sdy;

-    end;

-  end;

-end;

-

-// flips a rectangle vertically on given surface

-

-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );

-var

-  TmpRect      : TSDL_Rect;

-  Locked       : boolean;

-  y, FlipLength, RowLength : integer;

-  Row1, Row2   : Pointer;

-  OneRow       : TByteArray; // Optimize it if you wish

-begin

-  if DstSurface <> nil then

-  begin

-    if Rect = nil then

-    begin // if Rect=nil then we flip the whole surface

-      TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );

-      Rect := @TmpRect;

-    end;

-    FlipLength := Rect^.h shr 1 - 1;

-    RowLength := Rect^.w * DstSurface^.format.BytesPerPixel;

-    if SDL_MustLock( DstSurface ) then

-    begin

-      Locked := true;

-      SDL_LockSurface( DstSurface );

-    end

-    else

-      Locked := false;

-    Row1 := pointer( PtrUInt( DstSurface^.Pixels ) + UInt32( Rect^.y ) *

-      DstSurface^.Pitch );

-    Row2 := pointer( PtrUInt( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 )

-      * DstSurface^.Pitch );

-    for y := 0 to FlipLength do

-    begin

-      Move( Row1^, OneRow, RowLength );

-      Move( Row2^, Row1^, RowLength );

-      Move( OneRow, Row2^, RowLength );

-      inc( PtrUInt( Row1 ), DstSurface^.Pitch );

-      dec( PtrUInt( Row2 ), DstSurface^.Pitch );

-    end;

-    if Locked then

-      SDL_UnlockSurface( DstSurface );

-  end;

-end;

-

-// flips a rectangle horizontally on given surface

-

-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );

-type

-  T24bit = packed array[ 0..2 ] of byte;

-  T24bitArray = packed array[ 0..8191 ] of T24bit;

-  P24bitArray = ^T24bitArray;

-  TLongWordArray = array[ 0..8191 ] of LongWord;

-  PLongWordArray = ^TLongWordArray;

-var

-  TmpRect      : TSDL_Rect;

-  Row8bit      : PByteArray;

-  Row16bit     : PWordArray;

-  Row24bit     : P24bitArray;

-  Row32bit     : PLongWordArray;

-  y, x, RightSide, FlipLength : integer;

-  Pixel        : cardinal;

-  Pixel24      : T24bit;

-  Locked       : boolean;

-begin

-  if DstSurface <> nil then

-  begin

-    if Rect = nil then

-    begin

-      TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );

-      Rect := @TmpRect;

-    end;

-    FlipLength := Rect^.w shr 1 - 1;

-    if SDL_MustLock( DstSurface ) then

-    begin

-      Locked := true;

-      SDL_LockSurface( DstSurface );

-    end

-    else

-      Locked := false;

-    case DstSurface^.format.BytesPerPixel of

-      1 :

-        begin

-          Row8Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *

-            DstSurface^.pitch );

-          for y := 1 to Rect^.h do

-          begin

-            RightSide := Rect^.w - 1;

-            for x := 0 to FlipLength do

-            begin

-              Pixel := Row8Bit^[ x ];

-              Row8Bit^[ x ] := Row8Bit^[ RightSide ];

-              Row8Bit^[ RightSide ] := Pixel;

-              dec( RightSide );

-            end;

-            inc( PtrUInt( Row8Bit ), DstSurface^.pitch );

-          end;

-        end;

-      2 :

-        begin

-          Row16Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *

-            DstSurface^.pitch );

-          for y := 1 to Rect^.h do

-          begin

-            RightSide := Rect^.w - 1;

-            for x := 0 to FlipLength do

-            begin

-              Pixel := Row16Bit^[ x ];

-              Row16Bit^[ x ] := Row16Bit^[ RightSide ];

-              Row16Bit^[ RightSide ] := Pixel;

-              dec( RightSide );

-            end;

-            inc( PtrUInt( Row16Bit ), DstSurface^.pitch );

-          end;

-        end;

-      3 :

-        begin

-          Row24Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *

-            DstSurface^.pitch );

-          for y := 1 to Rect^.h do

-          begin

-            RightSide := Rect^.w - 1;

-            for x := 0 to FlipLength do

-            begin

-              Pixel24 := Row24Bit^[ x ];

-              Row24Bit^[ x ] := Row24Bit^[ RightSide ];

-              Row24Bit^[ RightSide ] := Pixel24;

-              dec( RightSide );

-            end;

-            inc( PtrUInt( Row24Bit ), DstSurface^.pitch );

-          end;

-        end;

-      4 :

-        begin

-          Row32Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *

-            DstSurface^.pitch );

-          for y := 1 to Rect^.h do

-          begin

-            RightSide := Rect^.w - 1;

-            for x := 0 to FlipLength do

-            begin

-              Pixel := Row32Bit^[ x ];

-              Row32Bit^[ x ] := Row32Bit^[ RightSide ];

-              Row32Bit^[ RightSide ] := Pixel;

-              dec( RightSide );

-            end;

-            inc( PtrUInt( Row32Bit ), DstSurface^.pitch );

-          end;

-        end;

-    end;

-    if Locked then

-      SDL_UnlockSurface( DstSurface );

-  end;

-end;

-

-// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer.

-// But you MUST free it after you don't need it anymore!!!

-

-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;

-var

-  Rect         : PSDL_Rect;

-begin

-  New( Rect );

-  with Rect^ do

-  begin

-    x := aLeft;

-    y := aTop;

-    w := aWidth;

-    h := aHeight;

-  end;

-  Result := Rect;

-end;

-

-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect;

-begin

-  with result do

-  begin

-    x := aLeft;

-    y := aTop;

-    w := aWidth;

-    h := aHeight;

-  end;

-end;

-

-function SDLRect( aRect : TRect ) : TSDL_Rect;

-begin

-  with aRect do

-    result := SDLRect( Left, Top, Right - Left, Bottom - Top );

-end;

-

-procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw,

-  depth : integer );

-var

-  dx, dy, e, d, dx2 : integer;

-  src_pitch, dst_pitch : uint16;

-  src_pixels, dst_pixels : PUint8;

-begin

-  if ( yw >= dst_surface^.h ) then

-    exit;

-  dx := ( x2 - x1 );

-  dy := ( y2 - y1 );

-  dy := dy shl 1;

-  e := dy - dx;

-  dx2 := dx shl 1;

-  src_pitch := Surface^.pitch;

-  dst_pitch := dst_surface^.pitch;

-  src_pixels := PUint8( PtrUInt( Surface^.pixels ) + yr * src_pitch + y1 * depth );

-  dst_pixels := PUint8( PtrUInt( dst_surface^.pixels ) + yw * dst_pitch + x1 *

-    depth );

-  for d := 0 to dx - 1 do

-  begin

-    move( src_pixels^, dst_pixels^, depth );

-    while ( e >= 0 ) do

-    begin

-      inc( src_pixels, depth );

-      e := e - dx2;

-    end;

-    inc( dst_pixels, depth );

-    e := e + dy;

-  end;

-end;

-

-function sign( x : integer ) : integer;

-begin

-  if x > 0 then

-    result := 1

-  else

-    result := -1;

-end;

-

-// Stretches a part of a surface

-

-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,

-  Width, Height : integer ) : PSDL_Surface;

-var

-  dst_surface  : PSDL_Surface;

-  dx, dy, e, d, dx2, srcx2, srcy2 : integer;

-  destx1, desty1 : integer;

-begin

-  srcx2 := srcx1 + SrcW;

-  srcy2 := srcy1 + SrcH;

-  result := nil;

-  destx1 := 0;

-  desty1 := 0;

-  dx := abs( integer( Height - desty1 ) );

-  dy := abs( integer( SrcY2 - SrcY1 ) );

-  e := ( dy shl 1 ) - dx;

-  dx2 := dx shl 1;

-  dy := dy shl 1;

-  dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height -

-    desty1,

-    SrcSurface^.Format^.BitsPerPixel,

-    SrcSurface^.Format^.RMask,

-    SrcSurface^.Format^.GMask,

-    SrcSurface^.Format^.BMask,

-    SrcSurface^.Format^.AMask );

-  if ( dst_surface^.format^.BytesPerPixel = 1 ) then

-    SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 );

-  SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey );

-  if ( SDL_MustLock( dst_surface ) ) then

-    if ( SDL_LockSurface( dst_surface ) < 0 ) then

-      exit;

-  for d := 0 to dx - 1 do

-  begin

-    SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1,

-      SrcSurface^.format^.BytesPerPixel );

-    while e >= 0 do

-    begin

-      inc( SrcY1 );

-      e := e - dx2;

-    end;

-    inc( desty1 );

-    e := e + dy;

-  end;

-  if SDL_MUSTLOCK( dst_surface ) then

-    SDL_UnlockSurface( dst_surface );

-  result := dst_surface;

-end;

-

-procedure SDL_MoveLine( Surface : PSDL_Surface; x1, x2, y1, xofs, depth : integer );

-var

-  src_pixels, dst_pixels : PUint8;

-  i            : integer;

-begin

-  src_pixels := PUint8( PtrUInt( Surface^.pixels ) + Surface^.w * y1 * depth + x2 *

-    depth );

-  dst_pixels := PUint8( PtrUInt( Surface^.pixels ) + Surface^.w * y1 * depth + ( x2

-    + xofs ) * depth );

-  for i := x2 downto x1 do

-  begin

-    move( src_pixels^, dst_pixels^, depth );

-    dec( src_pixels );

-    dec( dst_pixels );

-  end;

-end;

-{ Return the pixel value at (x, y)

-NOTE: The surface must be locked before calling this! }

-

-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;

-var

-  bpp          : UInt32;

-  p            : PInteger;

-begin

-  bpp := SrcSurface.format.BytesPerPixel;

-  // Here p is the address to the pixel we want to retrieve

-  p := Pointer( PtrUInt( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) *

-    bpp );

-  case bpp of

-    1 : result := PUint8( p )^;

-    2 : result := PUint16( p )^;

-    3 :

-      if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then

-        result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or

-          PUInt8Array( p )[ 2 ]

-      else

-        result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or

-          PUInt8Array( p )[ 2 ] shl 16;

-    4 : result := PUint32( p )^;

-  else

-    result := 0; // shouldn't happen, but avoids warnings

-  end;

-end;

-{ Set the pixel at (x, y) to the given value

-  NOTE: The surface must be locked before calling this! }

-

-procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :

-  Uint32 );

-var

-  bpp          : UInt32;

-  p            : PInteger;

-begin

-  bpp := DstSurface.format.BytesPerPixel;

-  p := Pointer( PtrUInt( DstSurface.pixels ) + UInt32( y ) * DstSurface.pitch + UInt32( x )

-    * bpp );

-  case bpp of

-    1 : PUint8( p )^ := pixel;

-    2 : PUint16( p )^ := pixel;

-    3 :

-      if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then

-      begin

-        PUInt8Array( p )[ 0 ] := ( pixel shr 16 ) and $FF;

-        PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;

-        PUInt8Array( p )[ 2 ] := pixel and $FF;

-      end

-      else

-      begin

-        PUInt8Array( p )[ 0 ] := pixel and $FF;

-        PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;

-        PUInt8Array( p )[ 2 ] := ( pixel shr 16 ) and $FF;

-      end;

-    4 :

-      PUint32( p )^ := pixel;

-  end;

-end;

-

-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );

-var

-  r1, r2       : TSDL_Rect;

-  //buffer: PSDL_Surface;

-  YPos         : Integer;

-begin

-  if ( DstSurface <> nil ) and ( DifY <> 0 ) then

-  begin

-    //if DifY > 0 then // going up

-    //begin

-    ypos := 0;

-    r1.x := 0;

-    r2.x := 0;

-    r1.w := DstSurface.w;

-    r2.w := DstSurface.w;

-    r1.h := DifY;

-    r2.h := DifY;

-    while ypos < DstSurface.h do

-    begin

-      r1.y := ypos;

-      r2.y := ypos + DifY;

-      SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 );

-      ypos := ypos + DifY;

-    end;

-    //end

-    //else

-    //begin // Going Down

-    //end;

-  end;

-end;

-

-{procedure SDL_ScrollY(Surface: PSDL_Surface; DifY: integer);

-var

-  r1, r2: TSDL_Rect;

-  buffer: PSDL_Surface;

-begin

-  if (Surface <> nil) and (Dify <> 0) then

-  begin

-    buffer := SDL_CreateRGBSurface(SDL_HWSURFACE, (Surface^.w - DifY) * 2,

-      Surface^.h * 2,

-      Surface^.Format^.BitsPerPixel, 0, 0, 0, 0);

-    if buffer <> nil then

-    begin

-      if (buffer^.format^.BytesPerPixel = 1) then

-        SDL_SetColors(buffer, @Surface^.format^.palette^.colors^[0], 0, 256);

-      r1 := SDLRect(0, DifY, buffer^.w, buffer^.h);

-      r2 := SDLRect(0, 0, buffer^.w, buffer^.h);

-      SDL_BlitSurface(Surface, @r1, buffer, @r2);

-      SDL_BlitSurface(buffer, @r2, Surface, @r2);

-      SDL_FreeSurface(buffer);

-    end;

-  end;

-end;}

-

-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );

-var

-  r1, r2       : TSDL_Rect;

-  buffer       : PSDL_Surface;

-begin

-  if ( DstSurface <> nil ) and ( DifX <> 0 ) then

-  begin

-    buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2,

-      DstSurface^.h * 2,

-      DstSurface^.Format^.BitsPerPixel,

-      DstSurface^.Format^.RMask,

-      DstSurface^.Format^.GMask,

-      DstSurface^.Format^.BMask,

-      DstSurface^.Format^.AMask );

-    if buffer <> nil then

-    begin

-      if ( buffer^.format^.BytesPerPixel = 1 ) then

-        SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 );

-      r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h );

-      r2 := SDLRect( 0, 0, buffer^.w, buffer^.h );

-      SDL_BlitSurface( DstSurface, @r1, buffer, @r2 );

-      SDL_BlitSurface( buffer, @r2, DstSurface, @r2 );

-      SDL_FreeSurface( buffer );

-    end;

-  end;

-end;

-

-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :

-  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );

-var

-  aSin, aCos   : Single;

-  MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer;

-  Colour, TempTransparentColour : UInt32;

-  MAXX, MAXY   : Integer;

-begin

-  // Rotate the surface to the target surface.

-  TempTransparentColour := SrcSurface.format.colorkey;

-  {if srcRect.w > srcRect.h then

-  begin

-    Width := srcRect.w;

-    Height := srcRect.w;

-  end

-  else

-  begin

-    Width := srcRect.h;

-    Height := srcRect.h;

-  end; }

-

-  maxx := DstSurface.w;

-  maxy := DstSurface.h;

-  aCos := cos( Angle );

-  aSin := sin( Angle );

-

-  Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) );

-  Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) );

-

-  OX := Width div 2;

-  OY := Height div 2; ;

-  MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2;

-  MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2;

-  ROX := ( -( srcRect.w div 2 ) ) + Offsetx;

-  ROY := ( -( srcRect.h div 2 ) ) + OffsetY;

-  Tx := ox + round( ROX * aSin - ROY * aCos );

-  Ty := oy + round( ROY * aSin + ROX * aCos );

-  SX := 0;

-  for DX := DestX - TX to DestX - TX + ( width ) do

-  begin

-    Inc( SX );

-    SY := 0;

-    for DY := DestY - TY to DestY - TY + ( Height ) do

-    begin

-      RX := SX - OX;

-      RY := SY - OY;

-      NX := round( mx + RX * aSin + RY * aCos ); //

-      NY := round( my + RY * aSin - RX * aCos ); //

-      // Used for testing only

-     //SDL_PutPixel(DestSurface.SDLSurfacePointer,DX,DY,0);

-      if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then

-      begin

-        if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then

-        begin

-          if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then

-          begin

-            Colour := SDL_GetPixel( SrcSurface, NX, NY );

-            if Colour <> TempTransparentColour then

-            begin

-              SDL_PutPixel( DstSurface, DX, DY, Colour );

-            end;

-          end;

-        end;

-      end;

-      inc( SY );

-    end;

-  end;

-end;

-

-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :

-  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );

-begin

-  SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) );

-end;

-

-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;

-var

-  RealRect     : TSDL_Rect;

-  OutOfRange   : Boolean;

-begin

-  OutOfRange := false;

-  if dstrect = nil then

-  begin

-    RealRect.x := 0;

-    RealRect.y := 0;

-    RealRect.w := DstSurface.w;

-    RealRect.h := DstSurface.h;

-  end

-  else

-  begin

-    if dstrect.x < DstSurface.w then

-    begin

-      RealRect.x := dstrect.x;

-    end

-    else if dstrect.x < 0 then

-    begin

-      realrect.x := 0;

-    end

-    else

-    begin

-      OutOfRange := True;

-    end;

-    if dstrect.y < DstSurface.h then

-    begin

-      RealRect.y := dstrect.y;

-    end

-    else if dstrect.y < 0 then

-    begin

-      realrect.y := 0;

-    end

-    else

-    begin

-      OutOfRange := True;

-    end;

-    if OutOfRange = False then

-    begin

-      if realrect.x + dstrect.w <= DstSurface.w then

-      begin

-        RealRect.w := dstrect.w;

-      end

-      else

-      begin

-        RealRect.w := dstrect.w - realrect.x;

-      end;

-      if realrect.y + dstrect.h <= DstSurface.h then

-      begin

-        RealRect.h := dstrect.h;

-      end

-      else

-      begin

-        RealRect.h := dstrect.h - realrect.y;

-      end;

-    end;

-  end;

-  if OutOfRange = False then

-  begin

-    result := realrect;

-  end

-  else

-  begin

-    realrect.w := 0;

-    realrect.h := 0;

-    realrect.x := 0;

-    realrect.y := 0;

-    result := realrect;

-  end;

-end;

-

-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );

-var

-  RealRect     : TSDL_Rect;

-  Addr         : pointer;

-  ModX, BPP    : cardinal;

-  x, y, R, G, B, SrcColor : cardinal;

-begin

-  RealRect := ValidateSurfaceRect( DstSurface, DstRect );

-  if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then

-  begin

-    SDL_LockSurface( DstSurface );

-    BPP := DstSurface.format.BytesPerPixel;

-    with DstSurface^ do

-    begin

-      Addr := pointer( PtrUInt( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );

-      ModX := Pitch - UInt32( RealRect.w ) * BPP;

-    end;

-    case DstSurface.format.BitsPerPixel of

-      8 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $E0 + Color and $E0;

-              G := SrcColor and $1C + Color and $1C;

-              B := SrcColor and $03 + Color and $03;

-              if R > $E0 then

-                R := $E0;

-              if G > $1C then

-                G := $1C;

-              if B > $03 then

-                B := $03;

-              PUInt8( Addr )^ := R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-      15 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $7C00 + Color and $7C00;

-              G := SrcColor and $03E0 + Color and $03E0;

-              B := SrcColor and $001F + Color and $001F;

-              if R > $7C00 then

-                R := $7C00;

-              if G > $03E0 then

-                G := $03E0;

-              if B > $001F then

-                B := $001F;

-              PUInt16( Addr )^ := R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-      16 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $F800 + Color and $F800;

-              G := SrcColor and $07C0 + Color and $07C0;

-              B := SrcColor and $001F + Color and $001F;

-              if R > $F800 then

-                R := $F800;

-              if G > $07C0 then

-                G := $07C0;

-              if B > $001F then

-                B := $001F;

-              PUInt16( Addr )^ := R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-      24 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $00FF0000 + Color and $00FF0000;

-              G := SrcColor and $0000FF00 + Color and $0000FF00;

-              B := SrcColor and $000000FF + Color and $000000FF;

-              if R > $FF0000 then

-                R := $FF0000;

-              if G > $00FF00 then

-                G := $00FF00;

-              if B > $0000FF then

-                B := $0000FF;

-              PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-      32 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $00FF0000 + Color and $00FF0000;

-              G := SrcColor and $0000FF00 + Color and $0000FF00;

-              B := SrcColor and $000000FF + Color and $000000FF;

-              if R > $FF0000 then

-                R := $FF0000;

-              if G > $00FF00 then

-                G := $00FF00;

-              if B > $0000FF then

-                B := $0000FF;

-              PUInt32( Addr )^ := R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-    end;

-    SDL_UnlockSurface( DstSurface );

-  end;

-end;

-

-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );

-var

-  RealRect     : TSDL_Rect;

-  Addr         : pointer;

-  ModX, BPP    : cardinal;

-  x, y, R, G, B, SrcColor : cardinal;

-begin

-  RealRect := ValidateSurfaceRect( DstSurface, DstRect );

-  if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then

-  begin

-    SDL_LockSurface( DstSurface );

-    BPP := DstSurface.format.BytesPerPixel;

-    with DstSurface^ do

-    begin

-      Addr := pointer( PtrUInt( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );

-      ModX := Pitch - UInt32( RealRect.w ) * BPP;

-    end;

-    case DstSurface.format.BitsPerPixel of

-      8 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $E0 - Color and $E0;

-              G := SrcColor and $1C - Color and $1C;

-              B := SrcColor and $03 - Color and $03;

-              if R > $E0 then

-                R := 0;

-              if G > $1C then

-                G := 0;

-              if B > $03 then

-                B := 0;

-              PUInt8( Addr )^ := R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-      15 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $7C00 - Color and $7C00;

-              G := SrcColor and $03E0 - Color and $03E0;

-              B := SrcColor and $001F - Color and $001F;

-              if R > $7C00 then

-                R := 0;

-              if G > $03E0 then

-                G := 0;

-              if B > $001F then

-                B := 0;

-              PUInt16( Addr )^ := R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-      16 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $F800 - Color and $F800;

-              G := SrcColor and $07C0 - Color and $07C0;

-              B := SrcColor and $001F - Color and $001F;

-              if R > $F800 then

-                R := 0;

-              if G > $07C0 then

-                G := 0;

-              if B > $001F then

-                B := 0;

-              PUInt16( Addr )^ := R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-      24 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $00FF0000 - Color and $00FF0000;

-              G := SrcColor and $0000FF00 - Color and $0000FF00;

-              B := SrcColor and $000000FF - Color and $000000FF;

-              if R > $FF0000 then

-                R := 0;

-              if G > $00FF00 then

-                G := 0;

-              if B > $0000FF then

-                B := 0;

-              PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-      32 :

-        begin

-          for y := 0 to RealRect.h - 1 do

-          begin

-            for x := 0 to RealRect.w - 1 do

-            begin

-              SrcColor := PUInt32( Addr )^;

-              R := SrcColor and $00FF0000 - Color and $00FF0000;

-              G := SrcColor and $0000FF00 - Color and $0000FF00;

-              B := SrcColor and $000000FF - Color and $000000FF;

-              if R > $FF0000 then

-                R := 0;

-              if G > $00FF00 then

-                G := 0;

-              if B > $0000FF then

-                B := 0;

-              PUInt32( Addr )^ := R or G or B;

-              inc( PtrUInt( Addr ), BPP );

-            end;

-            inc( PtrUInt( Addr ), ModX );

-          end;

-        end;

-    end;

-    SDL_UnlockSurface( DstSurface );

-  end;

-end;

-

-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );

-var

-  FBC          : array[ 0..255 ] of Cardinal;

-  // temp vars

-  i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer;

-

-  TempStepV, TempStepH : Single;

-  TempLeft, TempTop, TempHeight, TempWidth : integer;

-  TempRect     : TSDL_Rect;

-

-begin

-  // calc FBC

-  YR := StartColor.r;

-  YG := StartColor.g;

-  YB := StartColor.b;

-  SR := YR;

-  SG := YG;

-  SB := YB;

-  DR := EndColor.r - SR;

-  DG := EndColor.g - SG;

-  DB := EndColor.b - SB;

-

-  for i := 0 to 255 do

-  begin

-    FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB );

-    YR := SR + round( DR / 255 * i );

-    YG := SG + round( DG / 255 * i );

-    YB := SB + round( DB / 255 * i );

-  end;

-

-  //  if aStyle = 1 then begin

-  TempStepH := Rect.w / 255;

-  TempStepV := Rect.h / 255;

-  TempHeight := Trunc( TempStepV + 1 );

-  TempWidth := Trunc( TempStepH + 1 );

-  TempTop := 0;

-  TempLeft := 0;

-  TempRect.x := Rect.x;

-  TempRect.y := Rect.y;

-  TempRect.h := Rect.h;

-  TempRect.w := Rect.w;

-

-  case Style of

-    gsHorizontal :

-      begin

-        TempRect.h := TempHeight;

-        for i := 0 to 255 do

-        begin

-          TempRect.y := Rect.y + TempTop;

-          SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );

-          TempTop := Trunc( TempStepV * i );

-        end;

-      end;

-    gsVertical :

-      begin

-        TempRect.w := TempWidth;

-        for i := 0 to 255 do

-        begin

-          TempRect.x := Rect.x + TempLeft;

-          SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );

-          TempLeft := Trunc( TempStepH * i );

-        end;

-      end;

-  end;

-end;

-

-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );

-var

-  ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt;

-  SrcPitch, DestPitch, x, y : UInt32;

-begin

-  if ( Src = nil ) or ( Dest = nil ) then

-    exit;

-  if ( Src.w shl 1 ) < Dest.w then

-    exit;

-  if ( Src.h shl 1 ) < Dest.h then

-    exit;

-

-  if SDL_MustLock( Src ) then

-    SDL_LockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_LockSurface( Dest );

-

-  ReadRow := PtrUInt( Src.Pixels );

-  WriteRow := PtrUInt( Dest.Pixels );

-

-  SrcPitch := Src.pitch;

-  DestPitch := Dest.pitch;

-

-  case Src.format.BytesPerPixel of

-    1 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;

-          PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;

-          PUInt8( WriteAddr + DestPitch )^ := PUInt8( ReadAddr )^;

-          PUInt8( WriteAddr + DestPitch + 1 )^ := PUInt8( ReadAddr )^;

-          inc( ReadAddr );

-          inc( WriteAddr, 2 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    2 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;

-          PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;

-          PUInt16( WriteAddr + DestPitch )^ := PUInt16( ReadAddr )^;

-          PUInt16( WriteAddr + DestPitch + 2 )^ := PUInt16( ReadAddr )^;

-          inc( ReadAddr, 2 );

-          inc( WriteAddr, 4 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    3 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );

-          PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );

-          PUInt32( WriteAddr + DestPitch )^ := ( PUInt32( WriteAddr + DestPitch )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );

-          PUInt32( WriteAddr + DestPitch + 3 )^ := ( PUInt32( WriteAddr + DestPitch + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );

-          inc( ReadAddr, 3 );

-          inc( WriteAddr, 6 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    4 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;

-          PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;

-          PUInt32( WriteAddr + DestPitch )^ := PUInt32( ReadAddr )^;

-          PUInt32( WriteAddr + DestPitch + 4 )^ := PUInt32( ReadAddr )^;

-          inc( ReadAddr, 4 );

-          inc( WriteAddr, 8 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-  end;

-

-  if SDL_MustLock( Src ) then

-    SDL_UnlockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_UnlockSurface( Dest );

-end;

-

-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );

-var

-  ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt;

-  SrcPitch, DestPitch, x, y : UInt32;

-begin

-  if ( Src = nil ) or ( Dest = nil ) then

-    exit;

-  if ( Src.w shl 1 ) < Dest.w then

-    exit;

-  if ( Src.h shl 1 ) < Dest.h then

-    exit;

-

-  if SDL_MustLock( Src ) then

-    SDL_LockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_LockSurface( Dest );

-

-  ReadRow := PtrUInt( Src.Pixels );

-  WriteRow := PtrUInt( Dest.Pixels );

-

-  SrcPitch := Src.pitch;

-  DestPitch := Dest.pitch;

-

-  case Src.format.BytesPerPixel of

-    1 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;

-          PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;

-          inc( ReadAddr );

-          inc( WriteAddr, 2 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    2 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;

-          PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;

-          inc( ReadAddr, 2 );

-          inc( WriteAddr, 4 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    3 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );

-          PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );

-          inc( ReadAddr, 3 );

-          inc( WriteAddr, 6 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    4 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;

-          PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;

-          inc( ReadAddr, 4 );

-          inc( WriteAddr, 8 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-  end;

-

-  if SDL_MustLock( Src ) then

-    SDL_UnlockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_UnlockSurface( Dest );

-end;

-

-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );

-var

-  ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt;

-  SrcPitch, DestPitch, x, y, Color : UInt32;

-begin

-  if ( Src = nil ) or ( Dest = nil ) then

-    exit;

-  if ( Src.w shl 1 ) < Dest.w then

-    exit;

-  if ( Src.h shl 1 ) < Dest.h then

-    exit;

-

-  if SDL_MustLock( Src ) then

-    SDL_LockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_LockSurface( Dest );

-

-  ReadRow := PtrUInt( Src.Pixels );

-  WriteRow := PtrUInt( Dest.Pixels );

-

-  SrcPitch := Src.pitch;

-  DestPitch := Dest.pitch;

-

-  case Src.format.BitsPerPixel of

-    8 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          Color := PUInt8( ReadAddr )^;

-          PUInt8( WriteAddr )^ := Color;

-          PUInt8( WriteAddr + 1 )^ := Color;

-          Color := ( Color shr 1 ) and $6D; {%01101101}

-          PUInt8( WriteAddr + DestPitch )^ := Color;

-          PUInt8( WriteAddr + DestPitch + 1 )^ := Color;

-          inc( ReadAddr );

-          inc( WriteAddr, 2 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    15 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          Color := PUInt16( ReadAddr )^;

-          PUInt16( WriteAddr )^ := Color;

-          PUInt16( WriteAddr + 2 )^ := Color;

-          Color := ( Color shr 1 ) and $3DEF; {%0011110111101111}

-          PUInt16( WriteAddr + DestPitch )^ := Color;

-          PUInt16( WriteAddr + DestPitch + 2 )^ := Color;

-          inc( ReadAddr, 2 );

-          inc( WriteAddr, 4 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    16 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          Color := PUInt16( ReadAddr )^;

-          PUInt16( WriteAddr )^ := Color;

-          PUInt16( WriteAddr + 2 )^ := Color;

-          Color := ( Color shr 1 ) and $7BEF; {%0111101111101111}

-          PUInt16( WriteAddr + DestPitch )^ := Color;

-          PUInt16( WriteAddr + DestPitch + 2 )^ := Color;

-          inc( ReadAddr, 2 );

-          inc( WriteAddr, 4 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    24 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          Color := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );

-          PUInt32( WriteAddr )^ := Color;

-          PUInt32( WriteAddr + 3 )^ := Color;

-          Color := ( Color shr 1 ) and $007F7F7F; {%011111110111111101111111}

-          PUInt32( WriteAddr + DestPitch )^ := Color;

-          PUInt32( WriteAddr + DestPitch + 3 )^ := Color;

-          inc( ReadAddr, 3 );

-          inc( WriteAddr, 6 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-    32 : for y := 1 to Src.h do

-      begin

-        ReadAddr := ReadRow;

-        WriteAddr := WriteRow;

-        for x := 1 to Src.w do

-        begin

-          Color := PUInt32( ReadAddr )^;

-          PUInt32( WriteAddr )^ := Color;

-          PUInt32( WriteAddr + 4 )^ := Color;

-          Color := ( Color shr 1 ) and $7F7F7F7F;

-          PUInt32( WriteAddr + DestPitch )^ := Color;

-          PUInt32( WriteAddr + DestPitch + 4 )^ := Color;

-          inc( ReadAddr, 4 );

-          inc( WriteAddr, 8 );

-        end;

-        inc( PtrUInt( ReadRow ), SrcPitch );

-        inc( PtrUInt( WriteRow ), DestPitch * 2 );

-      end;

-  end;

-

-  if SDL_MustLock( Src ) then

-    SDL_UnlockSurface( Src );

-  if SDL_MustLock( Dest ) then

-    SDL_UnlockSurface( Dest );

-end;

-

-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :

-  PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :

-  boolean;

-var

-  Src_Rect1, Src_Rect2 : TSDL_Rect;

-  right1, bottom1 : integer;

-  right2, bottom2 : integer;

-  Scan1Start, {Scan2Start,} ScanWidth, ScanHeight : cardinal;

-  Mod1         : cardinal;

-  Addr1        : PtrUInt;

-  BPP          : cardinal;

-  Pitch1       : cardinal;

-  TransparentColor1 : cardinal;

-  tx, ty       : cardinal;

-// StartTick    : cardinal; // Auto Removed, Unused Variable

-  Color1       : cardinal;

-begin

-  Result := false;

-  if SrcRect1 = nil then

-  begin

-    with Src_Rect1 do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface1.w;

-      h := SrcSurface1.h;

-    end;

-  end

-  else

-    Src_Rect1 := SrcRect1^;

-

-  Src_Rect2 := SrcRect2^;

-  with Src_Rect1 do

-  begin

-    Right1 := Left1 + w;

-    Bottom1 := Top1 + h;

-  end;

-  with Src_Rect2 do

-  begin

-    Right2 := Left2 + w;

-    Bottom2 := Top2 + h;

-  end;

-  if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= Top2 ) then

-    exit;

-  if Left1 <= Left2 then

-  begin

-    // 1. left, 2. right

-    Scan1Start := Src_Rect1.x + Left2 - Left1;

-    //Scan2Start := Src_Rect2.x;

-    ScanWidth := Right1 - Left2;

-    with Src_Rect2 do

-      if ScanWidth > w then

-        ScanWidth := w;

-  end

-  else

-  begin

-    // 1. right, 2. left

-    Scan1Start := Src_Rect1.x;

-    //Scan2Start := Src_Rect2.x + Left1 - Left2;

-    ScanWidth := Right2 - Left1;

-    with Src_Rect1 do

-      if ScanWidth > w then

-        ScanWidth := w;

-  end;

-  with SrcSurface1^ do

-  begin

-    Pitch1 := Pitch;

-    Addr1 := PtrUInt( Pixels );

-    inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );

-    with format^ do

-    begin

-      BPP := BytesPerPixel;

-      TransparentColor1 := colorkey;

-    end;

-  end;

-

-  Mod1 := Pitch1 - ( ScanWidth * BPP );

-

-  inc( Addr1, BPP * Scan1Start );

-

-  if Top1 <= Top2 then

-  begin

-    // 1. up, 2. down

-    ScanHeight := Bottom1 - Top2;

-    if ScanHeight > Src_Rect2.h then

-      ScanHeight := Src_Rect2.h;

-    inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );

-  end

-  else

-  begin

-    // 1. down, 2. up

-    ScanHeight := Bottom2 - Top1;

-    if ScanHeight > Src_Rect1.h then

-      ScanHeight := Src_Rect1.h;

-

-  end;

-  case BPP of

-    1 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PByte( Addr1 )^ <> TransparentColor1 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1 );

-

-        end;

-        inc( Addr1, Mod1 );

-

-      end;

-    2 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PWord( Addr1 )^ <> TransparentColor1 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 2 );

-

-        end;

-        inc( Addr1, Mod1 );

-

-      end;

-    3 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          Color1 := PLongWord( Addr1 )^ and $00FFFFFF;

-

-          if ( Color1 <> TransparentColor1 )

-            then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 3 );

-

-        end;

-        inc( Addr1, Mod1 );

-

-      end;

-    4 :

-      for ty := 1 to ScanHeight do

-      begin

-        for tx := 1 to ScanWidth do

-        begin

-          if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then

-          begin

-            Result := true;

-            exit;

-          end;

-          inc( Addr1, 4 );

-

-        end;

-        inc( Addr1, Mod1 );

-

-      end;

-  end;

-end;

-

-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B)

-  Src, Dest    : TSDL_Rect;

-  Diff         : integer;

-  SrcAddr, DestAddr : PtrUInt;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits         : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt8( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt8( DestAddr )^;

-              PUInt8( DestAddr )^ := Pixel2 or Pixel1;

-            end;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    15 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-

-              PUInt16( DestAddr )^ := Pixel2 or Pixel1;

-

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    16 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-

-              PUInt16( DestAddr )^ := Pixel2 or Pixel1;

-

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    24 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;

-

-              PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 or Pixel1;

-            end;

-            inc( SrcAddr, 3 );

-            inc( DestAddr, 3 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    32 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^;

-

-              PUInt32( DestAddr )^ := Pixel2 or Pixel1;

-            end;

-            inc( SrcAddr, 4 );

-            inc( DestAddr, 4 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B)

-  Src, Dest    : TSDL_Rect;

-  Diff         : integer;

-  SrcAddr, DestAddr : PtrUInt;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits         : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt8( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt8( DestAddr )^;

-              PUInt8( DestAddr )^ := Pixel2 and Pixel1;

-            end;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    15 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-

-              PUInt16( DestAddr )^ := Pixel2 and Pixel1;

-

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    16 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-

-              PUInt16( DestAddr )^ := Pixel2 and Pixel1;

-

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    24 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;

-

-              PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 and Pixel1;

-            end;

-            inc( SrcAddr, 3 );

-            inc( DestAddr, 3 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    32 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^;

-

-              PUInt32( DestAddr )^ := Pixel2 and Pixel1;

-            end;

-            inc( SrcAddr, 4 );

-            inc( DestAddr, 4 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-

-

-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;

-  Src, Dest    : TSDL_Rect;

-  Diff         : integer;

-  SrcAddr, DestAddr : PtrUInt;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits         : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt8( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt8( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                if Pixel2 and $E0 > Pixel1 and $E0 then

-                  R := Pixel2 and $E0

-                else

-                  R := Pixel1 and $E0;

-                if Pixel2 and $1C > Pixel1 and $1C then

-                  G := Pixel2 and $1C

-                else

-                  G := Pixel1 and $1C;

-                if Pixel2 and $03 > Pixel1 and $03 then

-                  B := Pixel2 and $03

-                else

-                  B := Pixel1 and $03;

-

-                if R > $E0 then

-                  R := $E0;

-                if G > $1C then

-                  G := $1C;

-                if B > $03 then

-                  B := $03;

-                PUInt8( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt8( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    15 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-                if Pixel2 and $7C00 > Pixel1 and $7C00 then

-                  R := Pixel2 and $7C00

-                else

-                  R := Pixel1 and $7C00;

-                if Pixel2 and $03E0 > Pixel1 and $03E0 then

-                  G := Pixel2 and $03E0

-                else

-                  G := Pixel1 and $03E0;

-                if Pixel2 and $001F > Pixel1 and $001F then

-                  B := Pixel2 and $001F

-                else

-                  B := Pixel1 and $001F;

-

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    16 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-                if Pixel2 and $F800 > Pixel1 and $F800 then

-                  R := Pixel2 and $F800

-                else

-                  R := Pixel1 and $F800;

-                if Pixel2 and $07E0 > Pixel1 and $07E0 then

-                  G := Pixel2 and $07E0

-                else

-                  G := Pixel1 and $07E0;

-                if Pixel2 and $001F > Pixel1 and $001F then

-                  B := Pixel2 and $001F

-                else

-                  B := Pixel1 and $001F;

-

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    24 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;

-              if Pixel2 > 0 then

-              begin

-

-                if Pixel2 and $FF0000 > Pixel1 and $FF0000 then

-                  R := Pixel2 and $FF0000

-                else

-                  R := Pixel1 and $FF0000;

-                if Pixel2 and $00FF00 > Pixel1 and $00FF00 then

-                  G := Pixel2 and $00FF00

-                else

-                  G := Pixel1 and $00FF00;

-                if Pixel2 and $0000FF > Pixel1 and $0000FF then

-                  B := Pixel2 and $0000FF

-                else

-                  B := Pixel1 and $0000FF;

-

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );

-              end

-              else

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;

-            end;

-            inc( SrcAddr, 3 );

-            inc( DestAddr, 3 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    32 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-                if Pixel2 and $FF0000 > Pixel1 and $FF0000 then

-                  R := Pixel2 and $FF0000

-                else

-                  R := Pixel1 and $FF0000;

-                if Pixel2 and $00FF00 > Pixel1 and $00FF00 then

-                  G := Pixel2 and $00FF00

-                else

-                  G := Pixel1 and $00FF00;

-                if Pixel2 and $0000FF > Pixel1 and $0000FF then

-                  B := Pixel2 and $0000FF

-                else

-                  B := Pixel1 and $0000FF;

-

-                PUInt32( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt32( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 4 );

-            inc( DestAddr, 4 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-

-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;

-  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );

-var

-  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;

-  Src, Dest    : TSDL_Rect;

-  Diff         : integer;

-  SrcAddr, DestAddr : PtrUInt;

-  WorkX, WorkY : word;

-  SrcMod, DestMod : cardinal;

-  Bits         : cardinal;

-begin

-  if ( SrcSurface = nil ) or ( DestSurface = nil ) then

-    exit; // Remove this to make it faster

-  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then

-    exit; // Remove this to make it faster

-  if SrcRect = nil then

-  begin

-    with Src do

-    begin

-      x := 0;

-      y := 0;

-      w := SrcSurface.w;

-      h := SrcSurface.h;

-    end;

-  end

-  else

-    Src := SrcRect^;

-  if DestRect = nil then

-  begin

-    Dest.x := 0;

-    Dest.y := 0;

-  end

-  else

-    Dest := DestRect^;

-  Dest.w := Src.w;

-  Dest.h := Src.h;

-  with DestSurface.Clip_Rect do

-  begin

-    // Source's right side is greater than the dest.cliprect

-    if Dest.x + Src.w > x + w then

-    begin

-      smallint( Src.w ) := x + w - Dest.x;

-      smallint( Dest.w ) := x + w - Dest.x;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's bottom side is greater than the dest.clip

-    if Dest.y + Src.h > y + h then

-    begin

-      smallint( Src.h ) := y + h - Dest.y;

-      smallint( Dest.h ) := y + h - Dest.y;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-    // Source's left side is less than the dest.clip

-    if Dest.x < x then

-    begin

-      Diff := x - Dest.x;

-      Src.x := Src.x + Diff;

-      smallint( Src.w ) := smallint( Src.w ) - Diff;

-      Dest.x := x;

-      smallint( Dest.w ) := smallint( Dest.w ) - Diff;

-      if smallint( Dest.w ) < 1 then

-        exit;

-    end;

-    // Source's Top side is less than the dest.clip

-    if Dest.y < y then

-    begin

-      Diff := y - Dest.y;

-      Src.y := Src.y + Diff;

-      smallint( Src.h ) := smallint( Src.h ) - Diff;

-      Dest.y := y;

-      smallint( Dest.h ) := smallint( Dest.h ) - Diff;

-      if smallint( Dest.h ) < 1 then

-        exit;

-    end;

-  end;

-  with SrcSurface^ do

-  begin

-    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *

-      Format.BytesPerPixel;

-    SrcMod := Pitch - Src.w * Format.BytesPerPixel;

-    TransparentColor := Format.colorkey;

-  end;

-  with DestSurface^ do

-  begin

-    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *

-      Format.BytesPerPixel;

-    DestMod := Pitch - Dest.w * Format.BytesPerPixel;

-    Bits := Format.BitsPerPixel;

-  end;

-  SDL_LockSurface( SrcSurface );

-  SDL_LockSurface( DestSurface );

-  WorkY := Src.h;

-  case bits of

-    8 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt8( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt8( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-                if Pixel2 and $E0 < Pixel1 and $E0 then

-                  R := Pixel2 and $E0

-                else

-                  R := Pixel1 and $E0;

-                if Pixel2 and $1C < Pixel1 and $1C then

-                  G := Pixel2 and $1C

-                else

-                  G := Pixel1 and $1C;

-                if Pixel2 and $03 < Pixel1 and $03 then

-                  B := Pixel2 and $03

-                else

-                  B := Pixel1 and $03;

-

-                if R > $E0 then

-                  R := $E0;

-                if G > $1C then

-                  G := $1C;

-                if B > $03 then

-                  B := $03;

-                PUInt8( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt8( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr );

-            inc( DestAddr );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    15 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-                if Pixel2 and $7C00 < Pixel1 and $7C00 then

-                  R := Pixel2 and $7C00

-                else

-                  R := Pixel1 and $7C00;

-                if Pixel2 and $03E0 < Pixel1 and $03E0 then

-                  G := Pixel2 and $03E0

-                else

-                  G := Pixel1 and $03E0;

-                if Pixel2 and $001F < Pixel1 and $001F then

-                  B := Pixel2 and $001F

-                else

-                  B := Pixel1 and $001F;

-

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    16 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt16( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt16( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-                if Pixel2 and $F800 < Pixel1 and $F800 then

-                  R := Pixel2 and $F800

-                else

-                  R := Pixel1 and $F800;

-                if Pixel2 and $07E0 < Pixel1 and $07E0 then

-                  G := Pixel2 and $07E0

-                else

-                  G := Pixel1 and $07E0;

-                if Pixel2 and $001F < Pixel1 and $001F then

-                  B := Pixel2 and $001F

-                else

-                  B := Pixel1 and $001F;

-

-                PUInt16( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt16( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 2 );

-            inc( DestAddr, 2 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    24 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;

-              if Pixel2 > 0 then

-              begin

-

-                if Pixel2 and $FF0000 < Pixel1 and $FF0000 then

-                  R := Pixel2 and $FF0000

-                else

-                  R := Pixel1 and $FF0000;

-                if Pixel2 and $00FF00 < Pixel1 and $00FF00 then

-                  G := Pixel2 and $00FF00

-                else

-                  G := Pixel1 and $00FF00;

-                if Pixel2 and $0000FF < Pixel1 and $0000FF then

-                  B := Pixel2 and $0000FF

-                else

-                  B := Pixel1 and $0000FF;

-

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );

-              end

-              else

-                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;

-            end;

-            inc( SrcAddr, 3 );

-            inc( DestAddr, 3 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-    32 :

-      begin

-        repeat

-          WorkX := Src.w;

-          repeat

-            Pixel1 := PUInt32( SrcAddr )^;

-            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then

-            begin

-              Pixel2 := PUInt32( DestAddr )^;

-              if Pixel2 > 0 then

-              begin

-

-                if Pixel2 and $FF0000 < Pixel1 and $FF0000 then

-                  R := Pixel2 and $FF0000

-                else

-                  R := Pixel1 and $FF0000;

-                if Pixel2 and $00FF00 < Pixel1 and $00FF00 then

-                  G := Pixel2 and $00FF00

-                else

-                  G := Pixel1 and $00FF00;

-                if Pixel2 and $0000FF < Pixel1 and $0000FF then

-                  B := Pixel2 and $0000FF

-                else

-                  B := Pixel1 and $0000FF;

-

-                PUInt32( DestAddr )^ := R or G or B;

-              end

-              else

-                PUInt32( DestAddr )^ := Pixel1;

-            end;

-            inc( SrcAddr, 4 );

-            inc( DestAddr, 4 );

-            dec( WorkX );

-          until WorkX = 0;

-          inc( SrcAddr, SrcMod );

-          inc( DestAddr, DestMod );

-          dec( WorkY );

-        until WorkY = 0;

-      end;

-  end;

-  SDL_UnlockSurface( SrcSurface );

-  SDL_UnlockSurface( DestSurface );

-end;

-

-// Will clip the x1,x2,y1,x2 params to the ClipRect provided

-

-function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;

-var

-  tflag, flag1, flag2 : word;

-  txy, xedge, yedge : Integer;

-  slope        : single;

-

-  function ClipCode( x, y : Integer ) : word;

-  begin

-    Result := 0;

-    if x < ClipRect.x then

-      Result := 1;

-    if x >= ClipRect.w + ClipRect.x then

-      Result := Result or 2;

-    if y < ClipRect.y then

-      Result := Result or 4;

-    if y >= ClipRect.h + ClipRect.y then

-      Result := Result or 8;

-  end;

-

-begin

-  flag1 := ClipCode( x1, y1 );

-  flag2 := ClipCode( x2, y2 );

-  result := true;

-

-  while true do

-  begin

-    if ( flag1 or flag2 ) = 0 then

-      Exit; // all in

-

-    if ( flag1 and flag2 ) <> 0 then

-    begin

-      result := false;

-      Exit; // all out

-    end;

-

-    if flag2 = 0 then

-    begin

-      txy := x1; x1 := x2; x2 := txy;

-      txy := y1; y1 := y2; y2 := txy;

-      tflag := flag1; flag1 := flag2; flag2 := tflag;

-    end;

-

-    if ( flag2 and 3 ) <> 0 then

-    begin

-      if ( flag2 and 1 ) <> 0 then

-        xedge := ClipRect.x

-      else

-        xedge := ClipRect.w + ClipRect.x - 1; // back 1 pixel otherwise we end up in a loop

-

-      slope := ( y2 - y1 ) / ( x2 - x1 );

-      y2 := y1 + Round( slope * ( xedge - x1 ) );

-      x2 := xedge;

-    end

-    else

-    begin

-      if ( flag2 and 4 ) <> 0 then

-        yedge := ClipRect.y

-      else

-        yedge := ClipRect.h + ClipRect.y - 1; // up 1 pixel otherwise we end up in a loop

-

-      slope := ( x2 - x1 ) / ( y2 - y1 );

-      x2 := x1 + Round( slope * ( yedge - y1 ) );

-      y2 := yedge;

-    end;

-

-    flag2 := ClipCode( x2, y2 );

-  end;

-end;

-

-end.

-

+unit sdlutils;
+{
+  $Id: sdlutils.pas,v 1.5 2006/11/19 18:56:44 savage Exp $
+
+}
+{******************************************************************************}
+{                                                                              }
+{       Borland Delphi SDL - Simple DirectMedia Layer                          }
+{                SDL Utility functions                                         }
+{                                                                              }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Tom Jones <tigertomjones@gmx.de>                                             }
+{                                                                              }
+{ Portions created by Tom Jones are                                            }
+{ Copyright (C) 2000 - 2001 Tom Jones.                                         }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }
+{ Róbert Kisnémeth <mikrobi@freemail.hu>                                       }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{   Helper functions...                                                        }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   SDL.dll on Windows platforms                                               }
+{   libSDL-1.1.so.0 on Linux platform                                          }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{               2000 - TJ : Initial creation                                   }
+{                                                                              }
+{   July   13   2001 - DL : Added PutPixel and GetPixel routines.              }
+{                                                                              }
+{   Sept   14   2001 - RK : Added flipping routines.                           }
+{                                                                              }
+{   Sept   19   2001 - RK : Added PutPixel & line drawing & blitting with ADD  }
+{                           effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel }
+{                           Added PSDLRect()                                   }
+{   Sept   22   2001 - DL : Removed need for Windows.pas by defining types here}
+{                           Also removed by poor attempt or a dialog box       }
+{                                                                              }
+{   Sept   25   2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine,   }
+{                           SubSurface, MonoSurface & TexturedSurface          }
+{                                                                              }
+{   Sept   26   2001 - DL : Made change so that it refers to native Pascal     }
+{                           types rather that Windows types. This makes it more}
+{                           portable to Linix.                                 }
+{                                                                              }
+{   Sept   27   2001 - RK : SDLUtils now can be compiled with FreePascal       }
+{                                                                              }
+{   Oct    27   2001 - JF : Added ScrollY function                             }
+{                                                                              }
+{   Jan    21   2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface          }
+{                                                                              }
+{   Mar    28   2002 - JF : Added SDL_RotateSurface                            }
+{                                                                              }
+{   May    13   2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub         }
+{                                                                              }
+{   May    27   2002 - YS : GradientFillRect function                          }
+{                                                                              }
+{   May    30   2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit               }
+{                           & SDL_50Scanline2xBlit                             }
+{                                                                              }
+{  June    12   2002 - RK : Added SDL_PixelTestSurfaceVsRect                   }
+{                                                                              }
+{  June    12   2002 - JF : Updated SDL_PixelTestSurfaceVsRect                 }
+{                                                                              }
+{ November  9   2002 - JF : Added Jason's boolean Surface functions            }
+{                                                                              }
+{ December 10   2002 - DE : Added Dean's SDL_ClipLine function                 }
+{                                                                              }
+{    April 26   2003 - SS : Incorporated JF's changes to SDL_ClipLine          }
+{                           Fixed SDL_ClipLine bug for non-zero cliprect x, y  }
+{                           Added overloaded SDL_DrawLine for dashed lines     }
+{                                                                              }
+{******************************************************************************}
+{
+  $Log: sdlutils.pas,v $
+  Revision 1.5  2006/11/19 18:56:44  savage
+  Removed Hints and Warnings.
+
+  Revision 1.4  2004/06/02 19:38:53  savage
+  Changes to SDL_GradientFillRect as suggested by
+  Ángel Eduardo García Hernández.  Many thanks.
+
+  Revision 1.3  2004/05/29 23:11:54  savage
+  Changes to SDL_ScaleSurfaceRect as suggested by
+  Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks.
+
+  Revision 1.2  2004/02/14 00:23:39  savage
+  As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
+
+  Revision 1.1  2004/02/05 00:08:20  savage
+  Module 1.0 release
+
+
+}
+
+interface
+
+{$I jedi-sdl.inc}
+
+uses
+{$IFDEF UNIX}
+  Types,
+{$IFNDEF DARWIN}
+  Xlib,
+{$ENDIF}
+{$ENDIF}
+  SysUtils,
+  sdl;
+
+type
+  TGradientStyle = ( gsHorizontal, gsVertical );
+
+// Pixel procedures
+function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
+  PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean;
+
+function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;
+
+procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :
+  Uint32 );
+
+procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
+  cardinal );
+
+procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
+  cardinal );
+
+// Line procedures
+procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal ); overload;
+
+procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal; DashLength, DashSpace : byte ); overload;
+
+procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+
+procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+
+// Surface procedures
+procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
+
+procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
+  TextureRect : PSDL_Rect );
+
+procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
+
+procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
+
+// Flip procedures
+procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
+
+procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
+
+function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
+
+function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload;
+
+function SDLRect( aRect : TRect ) : TSDL_Rect; overload;
+
+function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
+  Width, Height : integer ) : PSDL_Surface;
+
+procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
+
+procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
+
+procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
+  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
+
+procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
+  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
+
+function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
+
+// Fill Rect routine
+procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
+
+procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
+
+procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
+
+// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface!
+procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
+
+procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
+
+procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
+
+//
+function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
+  PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
+  boolean;
+
+// Jason's boolean Surface functions
+procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+
+procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+
+function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;
+
+implementation
+
+uses
+  Math;
+
+function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
+  PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean;
+var
+  Src_Rect1, Src_Rect2 : TSDL_Rect;
+  right1, bottom1 : integer;
+  right2, bottom2 : integer;
+  Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;
+  Mod1, Mod2   : cardinal;
+  Addr1, Addr2 : PtrUInt;
+  BPP          : cardinal;
+  Pitch1, Pitch2 : cardinal;
+  TransparentColor1, TransparentColor2 : cardinal;
+  tx, ty       : cardinal;
+// StartTick    : cardinal; // Auto Removed, Unused Variable
+  Color1, Color2 : cardinal;
+begin
+  Result := false;
+  if SrcRect1 = nil then
+  begin
+    with Src_Rect1 do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface1.w;
+      h := SrcSurface1.h;
+    end;
+  end
+  else
+    Src_Rect1 := SrcRect1^;
+  if SrcRect2 = nil then
+  begin
+    with Src_Rect2 do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface2.w;
+      h := SrcSurface2.h;
+    end;
+  end
+  else
+    Src_Rect2 := SrcRect2^;
+  with Src_Rect1 do
+  begin
+    Right1 := Left1 + w;
+    Bottom1 := Top1 + h;
+  end;
+  with Src_Rect2 do
+  begin
+    Right2 := Left2 + w;
+    Bottom2 := Top2 + h;
+  end;
+  if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <=
+    Top2 ) then
+    exit;
+  if Left1 <= Left2 then
+  begin
+    // 1. left, 2. right
+    Scan1Start := Src_Rect1.x + Left2 - Left1;
+    Scan2Start := Src_Rect2.x;
+    ScanWidth := Right1 - Left2;
+    with Src_Rect2 do
+      if ScanWidth > w then
+        ScanWidth := w;
+  end
+  else
+  begin
+    // 1. right, 2. left
+    Scan1Start := Src_Rect1.x;
+    Scan2Start := Src_Rect2.x + Left1 - Left2;
+    ScanWidth := Right2 - Left1;
+    with Src_Rect1 do
+      if ScanWidth > w then
+        ScanWidth := w;
+  end;
+  with SrcSurface1^ do
+  begin
+    Pitch1 := Pitch;
+    Addr1 := PtrUInt( Pixels );
+    inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
+    with format^ do
+    begin
+      BPP := BytesPerPixel;
+      TransparentColor1 := colorkey;
+    end;
+  end;
+  with SrcSurface2^ do
+  begin
+    TransparentColor2 := format.colorkey;
+    Pitch2 := Pitch;
+    Addr2 := PtrUInt( Pixels );
+    inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) );
+  end;
+  Mod1 := Pitch1 - ( ScanWidth * BPP );
+  Mod2 := Pitch2 - ( ScanWidth * BPP );
+  inc( Addr1, BPP * Scan1Start );
+  inc( Addr2, BPP * Scan2Start );
+  if Top1 <= Top2 then
+  begin
+    // 1. up, 2. down
+    ScanHeight := Bottom1 - Top2;
+    if ScanHeight > Src_Rect2.h then
+      ScanHeight := Src_Rect2.h;
+    inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
+  end
+  else
+  begin
+    // 1. down, 2. up
+    ScanHeight := Bottom2 - Top1;
+    if ScanHeight > Src_Rect1.h then
+      ScanHeight := Src_Rect1.h;
+    inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) );
+  end;
+  case BPP of
+    1 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <>
+            TransparentColor2 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1 );
+          inc( Addr2 );
+        end;
+        inc( Addr1, Mod1 );
+        inc( Addr2, Mod2 );
+      end;
+    2 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <>
+            TransparentColor2 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 2 );
+          inc( Addr2, 2 );
+        end;
+        inc( Addr1, Mod1 );
+        inc( Addr2, Mod2 );
+      end;
+    3 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
+          Color2 := PLongWord( Addr2 )^ and $00FFFFFF;
+          if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 )
+            then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 3 );
+          inc( Addr2, 3 );
+        end;
+        inc( Addr1, Mod1 );
+        inc( Addr2, Mod2 );
+      end;
+    4 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <>
+            TransparentColor2 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 4 );
+          inc( Addr2, 4 );
+        end;
+        inc( Addr1, Mod1 );
+        inc( Addr2, Mod2 );
+      end;
+  end;
+end;
+
+procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
+  cardinal );
+var
+  SrcColor     : cardinal;
+  Addr         : PtrUInt;
+  R, G, B      : cardinal;
+begin
+  if Color = 0 then
+    exit;
+  with DstSurface^ do
+  begin
+    Addr := PtrUInt( Pixels ) + y * Pitch + x * format.BytesPerPixel;
+    SrcColor := PUInt32( Addr )^;
+    case format.BitsPerPixel of
+      8 :
+        begin
+          R := SrcColor and $E0 + Color and $E0;
+          G := SrcColor and $1C + Color and $1C;
+          B := SrcColor and $03 + Color and $03;
+          if R > $E0 then
+            R := $E0;
+          if G > $1C then
+            G := $1C;
+          if B > $03 then
+            B := $03;
+          PUInt8( Addr )^ := R or G or B;
+        end;
+      15 :
+        begin
+          R := SrcColor and $7C00 + Color and $7C00;
+          G := SrcColor and $03E0 + Color and $03E0;
+          B := SrcColor and $001F + Color and $001F;
+          if R > $7C00 then
+            R := $7C00;
+          if G > $03E0 then
+            G := $03E0;
+          if B > $001F then
+            B := $001F;
+          PUInt16( Addr )^ := R or G or B;
+        end;
+      16 :
+        begin
+          R := SrcColor and $F800 + Color and $F800;
+          G := SrcColor and $07C0 + Color and $07C0;
+          B := SrcColor and $001F + Color and $001F;
+          if R > $F800 then
+            R := $F800;
+          if G > $07C0 then
+            G := $07C0;
+          if B > $001F then
+            B := $001F;
+          PUInt16( Addr )^ := R or G or B;
+        end;
+      24 :
+        begin
+          R := SrcColor and $00FF0000 + Color and $00FF0000;
+          G := SrcColor and $0000FF00 + Color and $0000FF00;
+          B := SrcColor and $000000FF + Color and $000000FF;
+          if R > $FF0000 then
+            R := $FF0000;
+          if G > $00FF00 then
+            G := $00FF00;
+          if B > $0000FF then
+            B := $0000FF;
+          PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
+        end;
+      32 :
+        begin
+          R := SrcColor and $00FF0000 + Color and $00FF0000;
+          G := SrcColor and $0000FF00 + Color and $0000FF00;
+          B := SrcColor and $000000FF + Color and $000000FF;
+          if R > $FF0000 then
+            R := $FF0000;
+          if G > $00FF00 then
+            G := $00FF00;
+          if B > $0000FF then
+            B := $0000FF;
+          PUInt32( Addr )^ := R or G or B;
+        end;
+    end;
+  end;
+end;
+
+procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
+  cardinal );
+var
+  SrcColor     : cardinal;
+  Addr         : PtrUInt;
+  R, G, B      : cardinal;
+begin
+  if Color = 0 then
+    exit;
+  with DstSurface^ do
+  begin
+    Addr := PtrUInt( Pixels ) + y * Pitch + x * format.BytesPerPixel;
+    SrcColor := PUInt32( Addr )^;
+    case format.BitsPerPixel of
+      8 :
+        begin
+          R := SrcColor and $E0 - Color and $E0;
+          G := SrcColor and $1C - Color and $1C;
+          B := SrcColor and $03 - Color and $03;
+          if R > $E0 then
+            R := 0;
+          if G > $1C then
+            G := 0;
+          if B > $03 then
+            B := 0;
+          PUInt8( Addr )^ := R or G or B;
+        end;
+      15 :
+        begin
+          R := SrcColor and $7C00 - Color and $7C00;
+          G := SrcColor and $03E0 - Color and $03E0;
+          B := SrcColor and $001F - Color and $001F;
+          if R > $7C00 then
+            R := 0;
+          if G > $03E0 then
+            G := 0;
+          if B > $001F then
+            B := 0;
+          PUInt16( Addr )^ := R or G or B;
+        end;
+      16 :
+        begin
+          R := SrcColor and $F800 - Color and $F800;
+          G := SrcColor and $07C0 - Color and $07C0;
+          B := SrcColor and $001F - Color and $001F;
+          if R > $F800 then
+            R := 0;
+          if G > $07C0 then
+            G := 0;
+          if B > $001F then
+            B := 0;
+          PUInt16( Addr )^ := R or G or B;
+        end;
+      24 :
+        begin
+          R := SrcColor and $00FF0000 - Color and $00FF0000;
+          G := SrcColor and $0000FF00 - Color and $0000FF00;
+          B := SrcColor and $000000FF - Color and $000000FF;
+          if R > $FF0000 then
+            R := 0;
+          if G > $00FF00 then
+            G := 0;
+          if B > $0000FF then
+            B := 0;
+          PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
+        end;
+      32 :
+        begin
+          R := SrcColor and $00FF0000 - Color and $00FF0000;
+          G := SrcColor and $0000FF00 - Color and $0000FF00;
+          B := SrcColor and $000000FF - Color and $000000FF;
+          if R > $FF0000 then
+            R := 0;
+          if G > $00FF00 then
+            G := 0;
+          if B > $0000FF then
+            B := 0;
+          PUInt32( Addr )^ := R or G or B;
+        end;
+    end;
+  end;
+end;
+// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces.
+// In 8 bit color depth mode the procedure works with the default packed
+//  palette (RRRGGGBB). It handles all clipping.
+
+procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
+  Src, Dest    : TSDL_Rect;
+  Diff         : integer;
+  SrcAddr, DestAddr : PtrUInt;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits         : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt8( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt8( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel1 and $E0 + Pixel2 and $E0;
+                G := Pixel1 and $1C + Pixel2 and $1C;
+                B := Pixel1 and $03 + Pixel2 and $03;
+                if R > $E0 then
+                  R := $E0;
+                if G > $1C then
+                  G := $1C;
+                if B > $03 then
+                  B := $03;
+                PUInt8( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt8( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    15 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel1 and $7C00 + Pixel2 and $7C00;
+                G := Pixel1 and $03E0 + Pixel2 and $03E0;
+                B := Pixel1 and $001F + Pixel2 and $001F;
+                if R > $7C00 then
+                  R := $7C00;
+                if G > $03E0 then
+                  G := $03E0;
+                if B > $001F then
+                  B := $001F;
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    16 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel1 and $F800 + Pixel2 and $F800;
+                G := Pixel1 and $07E0 + Pixel2 and $07E0;
+                B := Pixel1 and $001F + Pixel2 and $001F;
+                if R > $F800 then
+                  R := $F800;
+                if G > $07E0 then
+                  G := $07E0;
+                if B > $001F then
+                  B := $001F;
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    24 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel1 and $FF0000 + Pixel2 and $FF0000;
+                G := Pixel1 and $00FF00 + Pixel2 and $00FF00;
+                B := Pixel1 and $0000FF + Pixel2 and $0000FF;
+                if R > $FF0000 then
+                  R := $FF0000;
+                if G > $00FF00 then
+                  G := $00FF00;
+                if B > $0000FF then
+                  B := $0000FF;
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
+              end
+              else
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
+            end;
+            inc( SrcAddr, 3 );
+            inc( DestAddr, 3 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    32 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel1 and $FF0000 + Pixel2 and $FF0000;
+                G := Pixel1 and $00FF00 + Pixel2 and $00FF00;
+                B := Pixel1 and $0000FF + Pixel2 and $0000FF;
+                if R > $FF0000 then
+                  R := $FF0000;
+                if G > $00FF00 then
+                  G := $00FF00;
+                if B > $0000FF then
+                  B := $0000FF;
+                PUInt32( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt32( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 4 );
+            inc( DestAddr, 4 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
+  Src, Dest    : TSDL_Rect;
+  Diff         : integer;
+  SrcAddr, DestAddr : PtrUInt;
+//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi)
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits         : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := DestSurface.Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt8( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt8( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel2 and $E0 - Pixel1 and $E0;
+                G := Pixel2 and $1C - Pixel1 and $1C;
+                B := Pixel2 and $03 - Pixel1 and $03;
+                if R > $E0 then
+                  R := 0;
+                if G > $1C then
+                  G := 0;
+                if B > $03 then
+                  B := 0;
+                PUInt8( DestAddr )^ := R or G or B;
+              end;
+            end;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    15 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel2 and $7C00 - Pixel1 and $7C00;
+                G := Pixel2 and $03E0 - Pixel1 and $03E0;
+                B := Pixel2 and $001F - Pixel1 and $001F;
+                if R > $7C00 then
+                  R := 0;
+                if G > $03E0 then
+                  G := 0;
+                if B > $001F then
+                  B := 0;
+                PUInt16( DestAddr )^ := R or G or B;
+              end;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    16 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel2 and $F800 - Pixel1 and $F800;
+                G := Pixel2 and $07E0 - Pixel1 and $07E0;
+                B := Pixel2 and $001F - Pixel1 and $001F;
+                if R > $F800 then
+                  R := 0;
+                if G > $07E0 then
+                  G := 0;
+                if B > $001F then
+                  B := 0;
+                PUInt16( DestAddr )^ := R or G or B;
+              end;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    24 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel2 and $FF0000 - Pixel1 and $FF0000;
+                G := Pixel2 and $00FF00 - Pixel1 and $00FF00;
+                B := Pixel2 and $0000FF - Pixel1 and $0000FF;
+                if R > $FF0000 then
+                  R := 0;
+                if G > $00FF00 then
+                  G := 0;
+                if B > $0000FF then
+                  B := 0;
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
+              end;
+            end;
+            inc( SrcAddr, 3 );
+            inc( DestAddr, 3 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    32 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                R := Pixel2 and $FF0000 - Pixel1 and $FF0000;
+                G := Pixel2 and $00FF00 - Pixel1 and $00FF00;
+                B := Pixel2 and $0000FF - Pixel1 and $0000FF;
+                if R > $FF0000 then
+                  R := 0;
+                if G > $00FF00 then
+                  G := 0;
+                if B > $0000FF then
+                  B := 0;
+                PUInt32( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt32( DestAddr )^ := Pixel2;
+            end;
+            inc( SrcAddr, 4 );
+            inc( DestAddr, 4 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
+var
+  Src, Dest    : TSDL_Rect;
+  Diff         : integer;
+  SrcAddr, DestAddr : PtrUInt;
+//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi)
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  TransparentColor, SrcColor : cardinal;
+  BPP          : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    BPP := DestSurface.Format.BytesPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case BPP of
+    1 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            SrcColor := PUInt8( SrcAddr )^;
+            if SrcColor <> TransparentColor then
+              PUInt8( DestAddr )^ := SrcColor;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    2 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            SrcColor := PUInt16( SrcAddr )^;
+            if SrcColor <> TransparentColor then
+              PUInt16( DestAddr )^ := SrcColor;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    3 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;
+            if SrcColor <> TransparentColor then
+              PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or SrcColor;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    4 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            SrcColor := PUInt32( SrcAddr )^;
+            if SrcColor <> TransparentColor then
+              PUInt32( DestAddr )^ := SrcColor;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+// TextureRect.w and TextureRect.h are not used.
+// The TextureSurface's size MUST larger than the drawing rectangle!!!
+
+procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
+  TextureRect : PSDL_Rect );
+var
+  Src, Dest    : TSDL_Rect;
+  Diff         : integer;
+  SrcAddr, DestAddr, TextAddr : PtrUInt;
+//{*_ebx, *}{*_esi, *}{*_edi, _esp*}: cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi)
+  WorkX, WorkY : word;
+  SrcMod, DestMod, TextMod : cardinal;
+SrcColor, TransparentColor{*, TextureColor*} : cardinal; // Auto Removed, Unused Variable (TextureColor)
+  BPP          : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    BPP := DestSurface.Format.BitsPerPixel;
+  end;
+  with Texture^ do
+  begin
+    TextAddr := PtrUInt( Pixels ) + UInt32( TextureRect.y ) * Pitch +
+      UInt32( TextureRect.x ) * Format.BytesPerPixel;
+    TextMod := Pitch - Src.w * Format.BytesPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  SDL_LockSurface( Texture );
+  WorkY := Src.h;
+  case BPP of
+    1 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            SrcColor := PUInt8( SrcAddr )^;
+            if SrcColor <> TransparentColor then
+              PUInt8( DestAddr )^ := PUint8( TextAddr )^;
+            inc( SrcAddr );
+            inc( DestAddr );
+            inc( TextAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          inc( TextAddr, TextMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    2 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            SrcColor := PUInt16( SrcAddr )^;
+            if SrcColor <> TransparentColor then
+              PUInt16( DestAddr )^ := PUInt16( TextAddr )^;
+            inc( SrcAddr );
+            inc( DestAddr );
+            inc( TextAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          inc( TextAddr, TextMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    3 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;
+            if SrcColor <> TransparentColor then
+              PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or ( PUInt32( TextAddr )^ and $FFFFFF );
+            inc( SrcAddr );
+            inc( DestAddr );
+            inc( TextAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          inc( TextAddr, TextMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    4 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            SrcColor := PUInt32( SrcAddr )^;
+            if SrcColor <> TransparentColor then
+              PUInt32( DestAddr )^ := PUInt32( TextAddr )^;
+            inc( SrcAddr );
+            inc( DestAddr );
+            inc( TextAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          inc( TextAddr, TextMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+  SDL_UnlockSurface( Texture );
+end;
+
+procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
+var
+  xc, yc       : cardinal;
+  rx, wx, ry, wy, ry16 : cardinal;
+  color        : cardinal;
+  modx, mody   : cardinal;
+begin
+  // Warning! No checks for surface pointers!!!
+  if srcrect = nil then
+    srcrect := @SrcSurface.clip_rect;
+  if dstrect = nil then
+    dstrect := @DstSurface.clip_rect;
+  if SDL_MustLock( SrcSurface ) then
+    SDL_LockSurface( SrcSurface );
+  if SDL_MustLock( DstSurface ) then
+    SDL_LockSurface( DstSurface );
+  modx := trunc( ( srcrect.w / dstrect.w ) * 65536 );
+  mody := trunc( ( srcrect.h / dstrect.h ) * 65536 );
+  //rx := srcrect.x * 65536;
+  ry := srcrect.y * 65536;
+  wy := dstrect.y;
+  for yc := 0 to dstrect.h - 1 do
+  begin
+    rx := srcrect.x * 65536;
+    wx := dstrect.x;
+    ry16 := ry shr 16;
+    for xc := 0 to dstrect.w - 1 do
+    begin
+      color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 );
+      SDL_PutPixel( DstSurface, wx, wy, color );
+      rx := rx + modx;
+      inc( wx );
+    end;
+    ry := ry + mody;
+    inc( wy );
+  end;
+  if SDL_MustLock( SrcSurface ) then
+    SDL_UnlockSurface( SrcSurface );
+  if SDL_MustLock( DstSurface ) then
+    SDL_UnlockSurface( DstSurface );
+end;
+// Re-map a rectangular area into an area defined by four vertices
+// Converted from C to Pascal by KiCHY
+
+procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
+const
+  SHIFTS       = 15; // Extend ints to limit round-off error (try 2 - 20)
+  THRESH       = 1 shl SHIFTS; // Threshold for pixel size value
+  procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal );
+  var
+    tm, lm, rm, bm, m : TPoint;
+    mx, my     : cardinal;
+    cr         : cardinal;
+  begin
+    // Does the destination area specify a single pixel?
+    if ( ( abs( ul.x - ur.x ) < THRESH ) and
+      ( abs( ul.x - lr.x ) < THRESH ) and
+      ( abs( ul.x - ll.x ) < THRESH ) and
+      ( abs( ul.y - ur.y ) < THRESH ) and
+      ( abs( ul.y - lr.y ) < THRESH ) and
+      ( abs( ul.y - ll.y ) < THRESH ) ) then
+    begin // Yes
+      cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) );
+      SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr );
+    end
+    else
+    begin // No
+      // Quarter the source and the destination, and then recurse
+      tm.x := ( ul.x + ur.x ) shr 1;
+      tm.y := ( ul.y + ur.y ) shr 1;
+      bm.x := ( ll.x + lr.x ) shr 1;
+      bm.y := ( ll.y + lr.y ) shr 1;
+      lm.x := ( ul.x + ll.x ) shr 1;
+      lm.y := ( ul.y + ll.y ) shr 1;
+      rm.x := ( ur.x + lr.x ) shr 1;
+      rm.y := ( ur.y + lr.y ) shr 1;
+      m.x := ( tm.x + bm.x ) shr 1;
+      m.y := ( tm.y + bm.y ) shr 1;
+      mx := ( x1 + x2 ) shr 1;
+      my := ( y1 + y2 ) shr 1;
+      CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my );
+      CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my );
+      CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 );
+      CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 );
+    end;
+  end;
+var
+  _UL, _UR, _LR, _LL : TPoint;
+  Rect_x, Rect_y, Rect_w, Rect_h : integer;
+begin
+  if SDL_MustLock( SrcSurface ) then
+    SDL_LockSurface( SrcSurface );
+  if SDL_MustLock( DstSurface ) then
+    SDL_LockSurface( DstSurface );
+  if SrcRect = nil then
+  begin
+    Rect_x := 0;
+    Rect_y := 0;
+    Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS;
+    Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS;
+  end
+  else
+  begin
+    Rect_x := SrcRect.x;
+    Rect_y := SrcRect.y;
+    Rect_w := ( SrcRect.w - 1 ) shl SHIFTS;
+    Rect_h := ( SrcRect.h - 1 ) shl SHIFTS;
+  end;
+  // Shift all values to help reduce round-off error.
+  _ul.x := ul.x shl SHIFTS;
+  _ul.y := ul.y shl SHIFTS;
+  _ur.x := ur.x shl SHIFTS;
+  _ur.y := ur.y shl SHIFTS;
+  _lr.x := lr.x shl SHIFTS;
+  _lr.y := lr.y shl SHIFTS;
+  _ll.x := ll.x shl SHIFTS;
+  _ll.y := ll.y shl SHIFTS;
+  CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h );
+  if SDL_MustLock( SrcSurface ) then
+    SDL_UnlockSurface( SrcSurface );
+  if SDL_MustLock( DstSurface ) then
+    SDL_UnlockSurface( DstSurface );
+end;
+
+// Draw a line between x1,y1 and x2,y2 to the given surface
+// NOTE: The surface must be locked before calling this!
+
+procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+var
+  dx, dy, sdx, sdy, x, y, px, py : integer;
+begin
+  dx := x2 - x1;
+  dy := y2 - y1;
+  if dx < 0 then
+    sdx := -1
+  else
+    sdx := 1;
+  if dy < 0 then
+    sdy := -1
+  else
+    sdy := 1;
+  dx := sdx * dx + 1;
+  dy := sdy * dy + 1;
+  x := 0;
+  y := 0;
+  px := x1;
+  py := y1;
+  if dx >= dy then
+  begin
+    for x := 0 to dx - 1 do
+    begin
+      SDL_PutPixel( DstSurface, px, py, Color );
+      y := y + dy;
+      if y >= dx then
+      begin
+        y := y - dx;
+        py := py + sdy;
+      end;
+      px := px + sdx;
+    end;
+  end
+  else
+  begin
+    for y := 0 to dy - 1 do
+    begin
+      SDL_PutPixel( DstSurface, px, py, Color );
+      x := x + dx;
+      if x >= dy then
+      begin
+        x := x - dy;
+        px := px + sdx;
+      end;
+      py := py + sdy;
+    end;
+  end;
+end;
+
+// Draw a dashed line between x1,y1 and x2,y2 to the given surface
+// NOTE: The surface must be locked before calling this!
+
+procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal; DashLength, DashSpace : byte ); overload;
+var
+  dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean;
+begin
+  counter := 0;
+  drawdash := true; //begin line drawing with dash
+
+  //Avoid invalid user-passed dash parameters
+  if ( DashLength < 1 )
+    then
+    DashLength := 1;
+  if ( DashSpace < 1 )
+    then
+    DashSpace := 0;
+
+  dx := x2 - x1;
+  dy := y2 - y1;
+  if dx < 0 then
+    sdx := -1
+  else
+    sdx := 1;
+  if dy < 0 then
+    sdy := -1
+  else
+    sdy := 1;
+  dx := sdx * dx + 1;
+  dy := sdy * dy + 1;
+  x := 0;
+  y := 0;
+  px := x1;
+  py := y1;
+  if dx >= dy then
+  begin
+    for x := 0 to dx - 1 do
+    begin
+
+      //Alternate drawing dashes, or leaving spaces
+      if drawdash then
+      begin
+        SDL_PutPixel( DstSurface, px, py, Color );
+        inc( counter );
+        if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then
+        begin
+          drawdash := false;
+          counter := 0;
+        end;
+      end
+      else //space
+      begin
+        inc( counter );
+        if counter > DashSpace - 1 then
+        begin
+          drawdash := true;
+          counter := 0;
+        end;
+      end;
+
+      y := y + dy;
+      if y >= dx then
+      begin
+        y := y - dx;
+        py := py + sdy;
+      end;
+      px := px + sdx;
+    end;
+  end
+  else
+  begin
+    for y := 0 to dy - 1 do
+    begin
+
+      //Alternate drawing dashes, or leaving spaces
+      if drawdash then
+      begin
+        SDL_PutPixel( DstSurface, px, py, Color );
+        inc( counter );
+        if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then
+        begin
+          drawdash := false;
+          counter := 0;
+        end;
+      end
+      else //space
+      begin
+        inc( counter );
+        if counter > DashSpace - 1 then
+        begin
+          drawdash := true;
+          counter := 0;
+        end;
+      end;
+
+      x := x + dx;
+      if x >= dy then
+      begin
+        x := x - dy;
+        px := px + sdx;
+      end;
+      py := py + sdy;
+    end;
+  end;
+end;
+
+procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+var
+  dx, dy, sdx, sdy, x, y, px, py : integer;
+begin
+  dx := x2 - x1;
+  dy := y2 - y1;
+  if dx < 0 then
+    sdx := -1
+  else
+    sdx := 1;
+  if dy < 0 then
+    sdy := -1
+  else
+    sdy := 1;
+  dx := sdx * dx + 1;
+  dy := sdy * dy + 1;
+  x := 0;
+  y := 0;
+  px := x1;
+  py := y1;
+  if dx >= dy then
+  begin
+    for x := 0 to dx - 1 do
+    begin
+      SDL_AddPixel( DstSurface, px, py, Color );
+      y := y + dy;
+      if y >= dx then
+      begin
+        y := y - dx;
+        py := py + sdy;
+      end;
+      px := px + sdx;
+    end;
+  end
+  else
+  begin
+    for y := 0 to dy - 1 do
+    begin
+      SDL_AddPixel( DstSurface, px, py, Color );
+      x := x + dx;
+      if x >= dy then
+      begin
+        x := x - dy;
+        px := px + sdx;
+      end;
+      py := py + sdy;
+    end;
+  end;
+end;
+
+procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
+  cardinal );
+var
+  dx, dy, sdx, sdy, x, y, px, py : integer;
+begin
+  dx := x2 - x1;
+  dy := y2 - y1;
+  if dx < 0 then
+    sdx := -1
+  else
+    sdx := 1;
+  if dy < 0 then
+    sdy := -1
+  else
+    sdy := 1;
+  dx := sdx * dx + 1;
+  dy := sdy * dy + 1;
+  x := 0;
+  y := 0;
+  px := x1;
+  py := y1;
+  if dx >= dy then
+  begin
+    for x := 0 to dx - 1 do
+    begin
+      SDL_SubPixel( DstSurface, px, py, Color );
+      y := y + dy;
+      if y >= dx then
+      begin
+        y := y - dx;
+        py := py + sdy;
+      end;
+      px := px + sdx;
+    end;
+  end
+  else
+  begin
+    for y := 0 to dy - 1 do
+    begin
+      SDL_SubPixel( DstSurface, px, py, Color );
+      x := x + dx;
+      if x >= dy then
+      begin
+        x := x - dy;
+        px := px + sdx;
+      end;
+      py := py + sdy;
+    end;
+  end;
+end;
+
+// flips a rectangle vertically on given surface
+
+procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
+var
+  TmpRect      : TSDL_Rect;
+  Locked       : boolean;
+  y, FlipLength, RowLength : integer;
+  Row1, Row2   : Pointer;
+  OneRow       : TByteArray; // Optimize it if you wish
+begin
+  if DstSurface <> nil then
+  begin
+    if Rect = nil then
+    begin // if Rect=nil then we flip the whole surface
+      TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
+      Rect := @TmpRect;
+    end;
+    FlipLength := Rect^.h shr 1 - 1;
+    RowLength := Rect^.w * DstSurface^.format.BytesPerPixel;
+    if SDL_MustLock( DstSurface ) then
+    begin
+      Locked := true;
+      SDL_LockSurface( DstSurface );
+    end
+    else
+      Locked := false;
+    Row1 := pointer( PtrUInt( DstSurface^.Pixels ) + UInt32( Rect^.y ) *
+      DstSurface^.Pitch );
+    Row2 := pointer( PtrUInt( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 )
+      * DstSurface^.Pitch );
+    for y := 0 to FlipLength do
+    begin
+      Move( Row1^, OneRow, RowLength );
+      Move( Row2^, Row1^, RowLength );
+      Move( OneRow, Row2^, RowLength );
+      inc( PtrUInt( Row1 ), DstSurface^.Pitch );
+      dec( PtrUInt( Row2 ), DstSurface^.Pitch );
+    end;
+    if Locked then
+      SDL_UnlockSurface( DstSurface );
+  end;
+end;
+
+// flips a rectangle horizontally on given surface
+
+procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
+type
+  T24bit = packed array[ 0..2 ] of byte;
+  T24bitArray = packed array[ 0..8191 ] of T24bit;
+  P24bitArray = ^T24bitArray;
+  TLongWordArray = array[ 0..8191 ] of LongWord;
+  PLongWordArray = ^TLongWordArray;
+var
+  TmpRect      : TSDL_Rect;
+  Row8bit      : PByteArray;
+  Row16bit     : PWordArray;
+  Row24bit     : P24bitArray;
+  Row32bit     : PLongWordArray;
+  y, x, RightSide, FlipLength : integer;
+  Pixel        : cardinal;
+  Pixel24      : T24bit;
+  Locked       : boolean;
+begin
+  if DstSurface <> nil then
+  begin
+    if Rect = nil then
+    begin
+      TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
+      Rect := @TmpRect;
+    end;
+    FlipLength := Rect^.w shr 1 - 1;
+    if SDL_MustLock( DstSurface ) then
+    begin
+      Locked := true;
+      SDL_LockSurface( DstSurface );
+    end
+    else
+      Locked := false;
+    case DstSurface^.format.BytesPerPixel of
+      1 :
+        begin
+          Row8Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *
+            DstSurface^.pitch );
+          for y := 1 to Rect^.h do
+          begin
+            RightSide := Rect^.w - 1;
+            for x := 0 to FlipLength do
+            begin
+              Pixel := Row8Bit^[ x ];
+              Row8Bit^[ x ] := Row8Bit^[ RightSide ];
+              Row8Bit^[ RightSide ] := Pixel;
+              dec( RightSide );
+            end;
+            inc( PtrUInt( Row8Bit ), DstSurface^.pitch );
+          end;
+        end;
+      2 :
+        begin
+          Row16Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *
+            DstSurface^.pitch );
+          for y := 1 to Rect^.h do
+          begin
+            RightSide := Rect^.w - 1;
+            for x := 0 to FlipLength do
+            begin
+              Pixel := Row16Bit^[ x ];
+              Row16Bit^[ x ] := Row16Bit^[ RightSide ];
+              Row16Bit^[ RightSide ] := Pixel;
+              dec( RightSide );
+            end;
+            inc( PtrUInt( Row16Bit ), DstSurface^.pitch );
+          end;
+        end;
+      3 :
+        begin
+          Row24Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *
+            DstSurface^.pitch );
+          for y := 1 to Rect^.h do
+          begin
+            RightSide := Rect^.w - 1;
+            for x := 0 to FlipLength do
+            begin
+              Pixel24 := Row24Bit^[ x ];
+              Row24Bit^[ x ] := Row24Bit^[ RightSide ];
+              Row24Bit^[ RightSide ] := Pixel24;
+              dec( RightSide );
+            end;
+            inc( PtrUInt( Row24Bit ), DstSurface^.pitch );
+          end;
+        end;
+      4 :
+        begin
+          Row32Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *
+            DstSurface^.pitch );
+          for y := 1 to Rect^.h do
+          begin
+            RightSide := Rect^.w - 1;
+            for x := 0 to FlipLength do
+            begin
+              Pixel := Row32Bit^[ x ];
+              Row32Bit^[ x ] := Row32Bit^[ RightSide ];
+              Row32Bit^[ RightSide ] := Pixel;
+              dec( RightSide );
+            end;
+            inc( PtrUInt( Row32Bit ), DstSurface^.pitch );
+          end;
+        end;
+    end;
+    if Locked then
+      SDL_UnlockSurface( DstSurface );
+  end;
+end;
+
+// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer.
+// But you MUST free it after you don't need it anymore!!!
+
+function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
+var
+  Rect         : PSDL_Rect;
+begin
+  New( Rect );
+  with Rect^ do
+  begin
+    x := aLeft;
+    y := aTop;
+    w := aWidth;
+    h := aHeight;
+  end;
+  Result := Rect;
+end;
+
+function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect;
+begin
+  with result do
+  begin
+    x := aLeft;
+    y := aTop;
+    w := aWidth;
+    h := aHeight;
+  end;
+end;
+
+function SDLRect( aRect : TRect ) : TSDL_Rect;
+begin
+  with aRect do
+    result := SDLRect( Left, Top, Right - Left, Bottom - Top );
+end;
+
+procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw,
+  depth : integer );
+var
+  dx, dy, e, d, dx2 : integer;
+  src_pitch, dst_pitch : uint16;
+  src_pixels, dst_pixels : PUint8;
+begin
+  if ( yw >= dst_surface^.h ) then
+    exit;
+  dx := ( x2 - x1 );
+  dy := ( y2 - y1 );
+  dy := dy shl 1;
+  e := dy - dx;
+  dx2 := dx shl 1;
+  src_pitch := Surface^.pitch;
+  dst_pitch := dst_surface^.pitch;
+  src_pixels := PUint8( PtrUInt( Surface^.pixels ) + yr * src_pitch + y1 * depth );
+  dst_pixels := PUint8( PtrUInt( dst_surface^.pixels ) + yw * dst_pitch + x1 *
+    depth );
+  for d := 0 to dx - 1 do
+  begin
+    move( src_pixels^, dst_pixels^, depth );
+    while ( e >= 0 ) do
+    begin
+      inc( src_pixels, depth );
+      e := e - dx2;
+    end;
+    inc( dst_pixels, depth );
+    e := e + dy;
+  end;
+end;
+
+function sign( x : integer ) : integer;
+begin
+  if x > 0 then
+    result := 1
+  else
+    result := -1;
+end;
+
+// Stretches a part of a surface
+
+function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
+  Width, Height : integer ) : PSDL_Surface;
+var
+  dst_surface  : PSDL_Surface;
+  dx, dy, e, d, dx2, srcx2, srcy2 : integer;
+  destx1, desty1 : integer;
+begin
+  srcx2 := srcx1 + SrcW;
+  srcy2 := srcy1 + SrcH;
+  result := nil;
+  destx1 := 0;
+  desty1 := 0;
+  dx := abs( integer( Height - desty1 ) );
+  dy := abs( integer( SrcY2 - SrcY1 ) );
+  e := ( dy shl 1 ) - dx;
+  dx2 := dx shl 1;
+  dy := dy shl 1;
+  dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height -
+    desty1,
+    SrcSurface^.Format^.BitsPerPixel,
+    SrcSurface^.Format^.RMask,
+    SrcSurface^.Format^.GMask,
+    SrcSurface^.Format^.BMask,
+    SrcSurface^.Format^.AMask );
+  if ( dst_surface^.format^.BytesPerPixel = 1 ) then
+    SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
+  SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey );
+  if ( SDL_MustLock( dst_surface ) ) then
+    if ( SDL_LockSurface( dst_surface ) < 0 ) then
+      exit;
+  for d := 0 to dx - 1 do
+  begin
+    SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1,
+      SrcSurface^.format^.BytesPerPixel );
+    while e >= 0 do
+    begin
+      inc( SrcY1 );
+      e := e - dx2;
+    end;
+    inc( desty1 );
+    e := e + dy;
+  end;
+  if SDL_MUSTLOCK( dst_surface ) then
+    SDL_UnlockSurface( dst_surface );
+  result := dst_surface;
+end;
+
+procedure SDL_MoveLine( Surface : PSDL_Surface; x1, x2, y1, xofs, depth : integer );
+var
+  src_pixels, dst_pixels : PUint8;
+  i            : integer;
+begin
+  src_pixels := PUint8( PtrUInt( Surface^.pixels ) + Surface^.w * y1 * depth + x2 *
+    depth );
+  dst_pixels := PUint8( PtrUInt( Surface^.pixels ) + Surface^.w * y1 * depth + ( x2
+    + xofs ) * depth );
+  for i := x2 downto x1 do
+  begin
+    move( src_pixels^, dst_pixels^, depth );
+    dec( src_pixels );
+    dec( dst_pixels );
+  end;
+end;
+{ Return the pixel value at (x, y)
+NOTE: The surface must be locked before calling this! }
+
+function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;
+var
+  bpp          : UInt32;
+  p            : PInteger;
+begin
+  bpp := SrcSurface.format.BytesPerPixel;
+  // Here p is the address to the pixel we want to retrieve
+  p := Pointer( PtrUInt( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) *
+    bpp );
+  case bpp of
+    1 : result := PUint8( p )^;
+    2 : result := PUint16( p )^;
+    3 :
+      if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
+        result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or
+          PUInt8Array( p )[ 2 ]
+      else
+        result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or
+          PUInt8Array( p )[ 2 ] shl 16;
+    4 : result := PUint32( p )^;
+  else
+    result := 0; // shouldn't happen, but avoids warnings
+  end;
+end;
+{ Set the pixel at (x, y) to the given value
+  NOTE: The surface must be locked before calling this! }
+
+procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :
+  Uint32 );
+var
+  bpp          : UInt32;
+  p            : PInteger;
+begin
+  bpp := DstSurface.format.BytesPerPixel;
+  p := Pointer( PtrUInt( DstSurface.pixels ) + UInt32( y ) * DstSurface.pitch + UInt32( x )
+    * bpp );
+  case bpp of
+    1 : PUint8( p )^ := pixel;
+    2 : PUint16( p )^ := pixel;
+    3 :
+      if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
+      begin
+        PUInt8Array( p )[ 0 ] := ( pixel shr 16 ) and $FF;
+        PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;
+        PUInt8Array( p )[ 2 ] := pixel and $FF;
+      end
+      else
+      begin
+        PUInt8Array( p )[ 0 ] := pixel and $FF;
+        PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;
+        PUInt8Array( p )[ 2 ] := ( pixel shr 16 ) and $FF;
+      end;
+    4 :
+      PUint32( p )^ := pixel;
+  end;
+end;
+
+procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
+var
+  r1, r2       : TSDL_Rect;
+  //buffer: PSDL_Surface;
+  YPos         : Integer;
+begin
+  if ( DstSurface <> nil ) and ( DifY <> 0 ) then
+  begin
+    //if DifY > 0 then // going up
+    //begin
+    ypos := 0;
+    r1.x := 0;
+    r2.x := 0;
+    r1.w := DstSurface.w;
+    r2.w := DstSurface.w;
+    r1.h := DifY;
+    r2.h := DifY;
+    while ypos < DstSurface.h do
+    begin
+      r1.y := ypos;
+      r2.y := ypos + DifY;
+      SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 );
+      ypos := ypos + DifY;
+    end;
+    //end
+    //else
+    //begin // Going Down
+    //end;
+  end;
+end;
+
+{procedure SDL_ScrollY(Surface: PSDL_Surface; DifY: integer);
+var
+  r1, r2: TSDL_Rect;
+  buffer: PSDL_Surface;
+begin
+  if (Surface <> nil) and (Dify <> 0) then
+  begin
+    buffer := SDL_CreateRGBSurface(SDL_HWSURFACE, (Surface^.w - DifY) * 2,
+      Surface^.h * 2,
+      Surface^.Format^.BitsPerPixel, 0, 0, 0, 0);
+    if buffer <> nil then
+    begin
+      if (buffer^.format^.BytesPerPixel = 1) then
+        SDL_SetColors(buffer, @Surface^.format^.palette^.colors^[0], 0, 256);
+      r1 := SDLRect(0, DifY, buffer^.w, buffer^.h);
+      r2 := SDLRect(0, 0, buffer^.w, buffer^.h);
+      SDL_BlitSurface(Surface, @r1, buffer, @r2);
+      SDL_BlitSurface(buffer, @r2, Surface, @r2);
+      SDL_FreeSurface(buffer);
+    end;
+  end;
+end;}
+
+procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
+var
+  r1, r2       : TSDL_Rect;
+  buffer       : PSDL_Surface;
+begin
+  if ( DstSurface <> nil ) and ( DifX <> 0 ) then
+  begin
+    buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2,
+      DstSurface^.h * 2,
+      DstSurface^.Format^.BitsPerPixel,
+      DstSurface^.Format^.RMask,
+      DstSurface^.Format^.GMask,
+      DstSurface^.Format^.BMask,
+      DstSurface^.Format^.AMask );
+    if buffer <> nil then
+    begin
+      if ( buffer^.format^.BytesPerPixel = 1 ) then
+        SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
+      r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h );
+      r2 := SDLRect( 0, 0, buffer^.w, buffer^.h );
+      SDL_BlitSurface( DstSurface, @r1, buffer, @r2 );
+      SDL_BlitSurface( buffer, @r2, DstSurface, @r2 );
+      SDL_FreeSurface( buffer );
+    end;
+  end;
+end;
+
+procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
+  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
+var
+  aSin, aCos   : Single;
+  MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer;
+  Colour, TempTransparentColour : UInt32;
+  MAXX, MAXY   : Integer;
+begin
+  // Rotate the surface to the target surface.
+  TempTransparentColour := SrcSurface.format.colorkey;
+  {if srcRect.w > srcRect.h then
+  begin
+    Width := srcRect.w;
+    Height := srcRect.w;
+  end
+  else
+  begin
+    Width := srcRect.h;
+    Height := srcRect.h;
+  end; }
+
+  maxx := DstSurface.w;
+  maxy := DstSurface.h;
+  aCos := cos( Angle );
+  aSin := sin( Angle );
+
+  Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) );
+  Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) );
+
+  OX := Width div 2;
+  OY := Height div 2; ;
+  MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2;
+  MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2;
+  ROX := ( -( srcRect.w div 2 ) ) + Offsetx;
+  ROY := ( -( srcRect.h div 2 ) ) + OffsetY;
+  Tx := ox + round( ROX * aSin - ROY * aCos );
+  Ty := oy + round( ROY * aSin + ROX * aCos );
+  SX := 0;
+  for DX := DestX - TX to DestX - TX + ( width ) do
+  begin
+    Inc( SX );
+    SY := 0;
+    for DY := DestY - TY to DestY - TY + ( Height ) do
+    begin
+      RX := SX - OX;
+      RY := SY - OY;
+      NX := round( mx + RX * aSin + RY * aCos ); //
+      NY := round( my + RY * aSin - RX * aCos ); //
+      // Used for testing only
+     //SDL_PutPixel(DestSurface.SDLSurfacePointer,DX,DY,0);
+      if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then
+      begin
+        if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then
+        begin
+          if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then
+          begin
+            Colour := SDL_GetPixel( SrcSurface, NX, NY );
+            if Colour <> TempTransparentColour then
+            begin
+              SDL_PutPixel( DstSurface, DX, DY, Colour );
+            end;
+          end;
+        end;
+      end;
+      inc( SY );
+    end;
+  end;
+end;
+
+procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
+  PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
+begin
+  SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) );
+end;
+
+function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
+var
+  RealRect     : TSDL_Rect;
+  OutOfRange   : Boolean;
+begin
+  OutOfRange := false;
+  if dstrect = nil then
+  begin
+    RealRect.x := 0;
+    RealRect.y := 0;
+    RealRect.w := DstSurface.w;
+    RealRect.h := DstSurface.h;
+  end
+  else
+  begin
+    if dstrect.x < DstSurface.w then
+    begin
+      RealRect.x := dstrect.x;
+    end
+    else if dstrect.x < 0 then
+    begin
+      realrect.x := 0;
+    end
+    else
+    begin
+      OutOfRange := True;
+    end;
+    if dstrect.y < DstSurface.h then
+    begin
+      RealRect.y := dstrect.y;
+    end
+    else if dstrect.y < 0 then
+    begin
+      realrect.y := 0;
+    end
+    else
+    begin
+      OutOfRange := True;
+    end;
+    if OutOfRange = False then
+    begin
+      if realrect.x + dstrect.w <= DstSurface.w then
+      begin
+        RealRect.w := dstrect.w;
+      end
+      else
+      begin
+        RealRect.w := dstrect.w - realrect.x;
+      end;
+      if realrect.y + dstrect.h <= DstSurface.h then
+      begin
+        RealRect.h := dstrect.h;
+      end
+      else
+      begin
+        RealRect.h := dstrect.h - realrect.y;
+      end;
+    end;
+  end;
+  if OutOfRange = False then
+  begin
+    result := realrect;
+  end
+  else
+  begin
+    realrect.w := 0;
+    realrect.h := 0;
+    realrect.x := 0;
+    realrect.y := 0;
+    result := realrect;
+  end;
+end;
+
+procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
+var
+  RealRect     : TSDL_Rect;
+  Addr         : pointer;
+  ModX, BPP    : cardinal;
+  x, y, R, G, B, SrcColor : cardinal;
+begin
+  RealRect := ValidateSurfaceRect( DstSurface, DstRect );
+  if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
+  begin
+    SDL_LockSurface( DstSurface );
+    BPP := DstSurface.format.BytesPerPixel;
+    with DstSurface^ do
+    begin
+      Addr := pointer( PtrUInt( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
+      ModX := Pitch - UInt32( RealRect.w ) * BPP;
+    end;
+    case DstSurface.format.BitsPerPixel of
+      8 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $E0 + Color and $E0;
+              G := SrcColor and $1C + Color and $1C;
+              B := SrcColor and $03 + Color and $03;
+              if R > $E0 then
+                R := $E0;
+              if G > $1C then
+                G := $1C;
+              if B > $03 then
+                B := $03;
+              PUInt8( Addr )^ := R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+      15 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $7C00 + Color and $7C00;
+              G := SrcColor and $03E0 + Color and $03E0;
+              B := SrcColor and $001F + Color and $001F;
+              if R > $7C00 then
+                R := $7C00;
+              if G > $03E0 then
+                G := $03E0;
+              if B > $001F then
+                B := $001F;
+              PUInt16( Addr )^ := R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+      16 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $F800 + Color and $F800;
+              G := SrcColor and $07C0 + Color and $07C0;
+              B := SrcColor and $001F + Color and $001F;
+              if R > $F800 then
+                R := $F800;
+              if G > $07C0 then
+                G := $07C0;
+              if B > $001F then
+                B := $001F;
+              PUInt16( Addr )^ := R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+      24 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $00FF0000 + Color and $00FF0000;
+              G := SrcColor and $0000FF00 + Color and $0000FF00;
+              B := SrcColor and $000000FF + Color and $000000FF;
+              if R > $FF0000 then
+                R := $FF0000;
+              if G > $00FF00 then
+                G := $00FF00;
+              if B > $0000FF then
+                B := $0000FF;
+              PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+      32 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $00FF0000 + Color and $00FF0000;
+              G := SrcColor and $0000FF00 + Color and $0000FF00;
+              B := SrcColor and $000000FF + Color and $000000FF;
+              if R > $FF0000 then
+                R := $FF0000;
+              if G > $00FF00 then
+                G := $00FF00;
+              if B > $0000FF then
+                B := $0000FF;
+              PUInt32( Addr )^ := R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+    end;
+    SDL_UnlockSurface( DstSurface );
+  end;
+end;
+
+procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
+var
+  RealRect     : TSDL_Rect;
+  Addr         : pointer;
+  ModX, BPP    : cardinal;
+  x, y, R, G, B, SrcColor : cardinal;
+begin
+  RealRect := ValidateSurfaceRect( DstSurface, DstRect );
+  if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
+  begin
+    SDL_LockSurface( DstSurface );
+    BPP := DstSurface.format.BytesPerPixel;
+    with DstSurface^ do
+    begin
+      Addr := pointer( PtrUInt( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
+      ModX := Pitch - UInt32( RealRect.w ) * BPP;
+    end;
+    case DstSurface.format.BitsPerPixel of
+      8 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $E0 - Color and $E0;
+              G := SrcColor and $1C - Color and $1C;
+              B := SrcColor and $03 - Color and $03;
+              if R > $E0 then
+                R := 0;
+              if G > $1C then
+                G := 0;
+              if B > $03 then
+                B := 0;
+              PUInt8( Addr )^ := R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+      15 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $7C00 - Color and $7C00;
+              G := SrcColor and $03E0 - Color and $03E0;
+              B := SrcColor and $001F - Color and $001F;
+              if R > $7C00 then
+                R := 0;
+              if G > $03E0 then
+                G := 0;
+              if B > $001F then
+                B := 0;
+              PUInt16( Addr )^ := R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+      16 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $F800 - Color and $F800;
+              G := SrcColor and $07C0 - Color and $07C0;
+              B := SrcColor and $001F - Color and $001F;
+              if R > $F800 then
+                R := 0;
+              if G > $07C0 then
+                G := 0;
+              if B > $001F then
+                B := 0;
+              PUInt16( Addr )^ := R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+      24 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $00FF0000 - Color and $00FF0000;
+              G := SrcColor and $0000FF00 - Color and $0000FF00;
+              B := SrcColor and $000000FF - Color and $000000FF;
+              if R > $FF0000 then
+                R := 0;
+              if G > $00FF00 then
+                G := 0;
+              if B > $0000FF then
+                B := 0;
+              PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+      32 :
+        begin
+          for y := 0 to RealRect.h - 1 do
+          begin
+            for x := 0 to RealRect.w - 1 do
+            begin
+              SrcColor := PUInt32( Addr )^;
+              R := SrcColor and $00FF0000 - Color and $00FF0000;
+              G := SrcColor and $0000FF00 - Color and $0000FF00;
+              B := SrcColor and $000000FF - Color and $000000FF;
+              if R > $FF0000 then
+                R := 0;
+              if G > $00FF00 then
+                G := 0;
+              if B > $0000FF then
+                B := 0;
+              PUInt32( Addr )^ := R or G or B;
+              inc( PtrUInt( Addr ), BPP );
+            end;
+            inc( PtrUInt( Addr ), ModX );
+          end;
+        end;
+    end;
+    SDL_UnlockSurface( DstSurface );
+  end;
+end;
+
+procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
+var
+  FBC          : array[ 0..255 ] of Cardinal;
+  // temp vars
+  i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer;
+
+  TempStepV, TempStepH : Single;
+  TempLeft, TempTop, TempHeight, TempWidth : integer;
+  TempRect     : TSDL_Rect;
+
+begin
+  // calc FBC
+  YR := StartColor.r;
+  YG := StartColor.g;
+  YB := StartColor.b;
+  SR := YR;
+  SG := YG;
+  SB := YB;
+  DR := EndColor.r - SR;
+  DG := EndColor.g - SG;
+  DB := EndColor.b - SB;
+
+  for i := 0 to 255 do
+  begin
+    FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB );
+    YR := SR + round( DR / 255 * i );
+    YG := SG + round( DG / 255 * i );
+    YB := SB + round( DB / 255 * i );
+  end;
+
+  //  if aStyle = 1 then begin
+  TempStepH := Rect.w / 255;
+  TempStepV := Rect.h / 255;
+  TempHeight := Trunc( TempStepV + 1 );
+  TempWidth := Trunc( TempStepH + 1 );
+  TempTop := 0;
+  TempLeft := 0;
+  TempRect.x := Rect.x;
+  TempRect.y := Rect.y;
+  TempRect.h := Rect.h;
+  TempRect.w := Rect.w;
+
+  case Style of
+    gsHorizontal :
+      begin
+        TempRect.h := TempHeight;
+        for i := 0 to 255 do
+        begin
+          TempRect.y := Rect.y + TempTop;
+          SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
+          TempTop := Trunc( TempStepV * i );
+        end;
+      end;
+    gsVertical :
+      begin
+        TempRect.w := TempWidth;
+        for i := 0 to 255 do
+        begin
+          TempRect.x := Rect.x + TempLeft;
+          SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
+          TempLeft := Trunc( TempStepH * i );
+        end;
+      end;
+  end;
+end;
+
+procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
+var
+  ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt;
+  SrcPitch, DestPitch, x, y : UInt32;
+begin
+  if ( Src = nil ) or ( Dest = nil ) then
+    exit;
+  if ( Src.w shl 1 ) < Dest.w then
+    exit;
+  if ( Src.h shl 1 ) < Dest.h then
+    exit;
+
+  if SDL_MustLock( Src ) then
+    SDL_LockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_LockSurface( Dest );
+
+  ReadRow := PtrUInt( Src.Pixels );
+  WriteRow := PtrUInt( Dest.Pixels );
+
+  SrcPitch := Src.pitch;
+  DestPitch := Dest.pitch;
+
+  case Src.format.BytesPerPixel of
+    1 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;
+          PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;
+          PUInt8( WriteAddr + DestPitch )^ := PUInt8( ReadAddr )^;
+          PUInt8( WriteAddr + DestPitch + 1 )^ := PUInt8( ReadAddr )^;
+          inc( ReadAddr );
+          inc( WriteAddr, 2 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    2 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;
+          PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;
+          PUInt16( WriteAddr + DestPitch )^ := PUInt16( ReadAddr )^;
+          PUInt16( WriteAddr + DestPitch + 2 )^ := PUInt16( ReadAddr )^;
+          inc( ReadAddr, 2 );
+          inc( WriteAddr, 4 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    3 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
+          PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
+          PUInt32( WriteAddr + DestPitch )^ := ( PUInt32( WriteAddr + DestPitch )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
+          PUInt32( WriteAddr + DestPitch + 3 )^ := ( PUInt32( WriteAddr + DestPitch + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
+          inc( ReadAddr, 3 );
+          inc( WriteAddr, 6 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    4 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;
+          PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;
+          PUInt32( WriteAddr + DestPitch )^ := PUInt32( ReadAddr )^;
+          PUInt32( WriteAddr + DestPitch + 4 )^ := PUInt32( ReadAddr )^;
+          inc( ReadAddr, 4 );
+          inc( WriteAddr, 8 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+  end;
+
+  if SDL_MustLock( Src ) then
+    SDL_UnlockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_UnlockSurface( Dest );
+end;
+
+procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
+var
+  ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt;
+  SrcPitch, DestPitch, x, y : UInt32;
+begin
+  if ( Src = nil ) or ( Dest = nil ) then
+    exit;
+  if ( Src.w shl 1 ) < Dest.w then
+    exit;
+  if ( Src.h shl 1 ) < Dest.h then
+    exit;
+
+  if SDL_MustLock( Src ) then
+    SDL_LockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_LockSurface( Dest );
+
+  ReadRow := PtrUInt( Src.Pixels );
+  WriteRow := PtrUInt( Dest.Pixels );
+
+  SrcPitch := Src.pitch;
+  DestPitch := Dest.pitch;
+
+  case Src.format.BytesPerPixel of
+    1 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;
+          PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;
+          inc( ReadAddr );
+          inc( WriteAddr, 2 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    2 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;
+          PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;
+          inc( ReadAddr, 2 );
+          inc( WriteAddr, 4 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    3 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
+          PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
+          inc( ReadAddr, 3 );
+          inc( WriteAddr, 6 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    4 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;
+          PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;
+          inc( ReadAddr, 4 );
+          inc( WriteAddr, 8 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+  end;
+
+  if SDL_MustLock( Src ) then
+    SDL_UnlockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_UnlockSurface( Dest );
+end;
+
+procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
+var
+  ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt;
+  SrcPitch, DestPitch, x, y, Color : UInt32;
+begin
+  if ( Src = nil ) or ( Dest = nil ) then
+    exit;
+  if ( Src.w shl 1 ) < Dest.w then
+    exit;
+  if ( Src.h shl 1 ) < Dest.h then
+    exit;
+
+  if SDL_MustLock( Src ) then
+    SDL_LockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_LockSurface( Dest );
+
+  ReadRow := PtrUInt( Src.Pixels );
+  WriteRow := PtrUInt( Dest.Pixels );
+
+  SrcPitch := Src.pitch;
+  DestPitch := Dest.pitch;
+
+  case Src.format.BitsPerPixel of
+    8 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          Color := PUInt8( ReadAddr )^;
+          PUInt8( WriteAddr )^ := Color;
+          PUInt8( WriteAddr + 1 )^ := Color;
+          Color := ( Color shr 1 ) and $6D; {%01101101}
+          PUInt8( WriteAddr + DestPitch )^ := Color;
+          PUInt8( WriteAddr + DestPitch + 1 )^ := Color;
+          inc( ReadAddr );
+          inc( WriteAddr, 2 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    15 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          Color := PUInt16( ReadAddr )^;
+          PUInt16( WriteAddr )^ := Color;
+          PUInt16( WriteAddr + 2 )^ := Color;
+          Color := ( Color shr 1 ) and $3DEF; {%0011110111101111}
+          PUInt16( WriteAddr + DestPitch )^ := Color;
+          PUInt16( WriteAddr + DestPitch + 2 )^ := Color;
+          inc( ReadAddr, 2 );
+          inc( WriteAddr, 4 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    16 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          Color := PUInt16( ReadAddr )^;
+          PUInt16( WriteAddr )^ := Color;
+          PUInt16( WriteAddr + 2 )^ := Color;
+          Color := ( Color shr 1 ) and $7BEF; {%0111101111101111}
+          PUInt16( WriteAddr + DestPitch )^ := Color;
+          PUInt16( WriteAddr + DestPitch + 2 )^ := Color;
+          inc( ReadAddr, 2 );
+          inc( WriteAddr, 4 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    24 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          Color := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
+          PUInt32( WriteAddr )^ := Color;
+          PUInt32( WriteAddr + 3 )^ := Color;
+          Color := ( Color shr 1 ) and $007F7F7F; {%011111110111111101111111}
+          PUInt32( WriteAddr + DestPitch )^ := Color;
+          PUInt32( WriteAddr + DestPitch + 3 )^ := Color;
+          inc( ReadAddr, 3 );
+          inc( WriteAddr, 6 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+    32 : for y := 1 to Src.h do
+      begin
+        ReadAddr := ReadRow;
+        WriteAddr := WriteRow;
+        for x := 1 to Src.w do
+        begin
+          Color := PUInt32( ReadAddr )^;
+          PUInt32( WriteAddr )^ := Color;
+          PUInt32( WriteAddr + 4 )^ := Color;
+          Color := ( Color shr 1 ) and $7F7F7F7F;
+          PUInt32( WriteAddr + DestPitch )^ := Color;
+          PUInt32( WriteAddr + DestPitch + 4 )^ := Color;
+          inc( ReadAddr, 4 );
+          inc( WriteAddr, 8 );
+        end;
+        inc( PtrUInt( ReadRow ), SrcPitch );
+        inc( PtrUInt( WriteRow ), DestPitch * 2 );
+      end;
+  end;
+
+  if SDL_MustLock( Src ) then
+    SDL_UnlockSurface( Src );
+  if SDL_MustLock( Dest ) then
+    SDL_UnlockSurface( Dest );
+end;
+
+function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
+  PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
+  boolean;
+var
+  Src_Rect1, Src_Rect2 : TSDL_Rect;
+  right1, bottom1 : integer;
+  right2, bottom2 : integer;
+  Scan1Start, {Scan2Start,} ScanWidth, ScanHeight : cardinal;
+  Mod1         : cardinal;
+  Addr1        : PtrUInt;
+  BPP          : cardinal;
+  Pitch1       : cardinal;
+  TransparentColor1 : cardinal;
+  tx, ty       : cardinal;
+// StartTick    : cardinal; // Auto Removed, Unused Variable
+  Color1       : cardinal;
+begin
+  Result := false;
+  if SrcRect1 = nil then
+  begin
+    with Src_Rect1 do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface1.w;
+      h := SrcSurface1.h;
+    end;
+  end
+  else
+    Src_Rect1 := SrcRect1^;
+
+  Src_Rect2 := SrcRect2^;
+  with Src_Rect1 do
+  begin
+    Right1 := Left1 + w;
+    Bottom1 := Top1 + h;
+  end;
+  with Src_Rect2 do
+  begin
+    Right2 := Left2 + w;
+    Bottom2 := Top2 + h;
+  end;
+  if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= Top2 ) then
+    exit;
+  if Left1 <= Left2 then
+  begin
+    // 1. left, 2. right
+    Scan1Start := Src_Rect1.x + Left2 - Left1;
+    //Scan2Start := Src_Rect2.x;
+    ScanWidth := Right1 - Left2;
+    with Src_Rect2 do
+      if ScanWidth > w then
+        ScanWidth := w;
+  end
+  else
+  begin
+    // 1. right, 2. left
+    Scan1Start := Src_Rect1.x;
+    //Scan2Start := Src_Rect2.x + Left1 - Left2;
+    ScanWidth := Right2 - Left1;
+    with Src_Rect1 do
+      if ScanWidth > w then
+        ScanWidth := w;
+  end;
+  with SrcSurface1^ do
+  begin
+    Pitch1 := Pitch;
+    Addr1 := PtrUInt( Pixels );
+    inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
+    with format^ do
+    begin
+      BPP := BytesPerPixel;
+      TransparentColor1 := colorkey;
+    end;
+  end;
+
+  Mod1 := Pitch1 - ( ScanWidth * BPP );
+
+  inc( Addr1, BPP * Scan1Start );
+
+  if Top1 <= Top2 then
+  begin
+    // 1. up, 2. down
+    ScanHeight := Bottom1 - Top2;
+    if ScanHeight > Src_Rect2.h then
+      ScanHeight := Src_Rect2.h;
+    inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
+  end
+  else
+  begin
+    // 1. down, 2. up
+    ScanHeight := Bottom2 - Top1;
+    if ScanHeight > Src_Rect1.h then
+      ScanHeight := Src_Rect1.h;
+
+  end;
+  case BPP of
+    1 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PByte( Addr1 )^ <> TransparentColor1 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1 );
+
+        end;
+        inc( Addr1, Mod1 );
+
+      end;
+    2 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PWord( Addr1 )^ <> TransparentColor1 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 2 );
+
+        end;
+        inc( Addr1, Mod1 );
+
+      end;
+    3 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
+
+          if ( Color1 <> TransparentColor1 )
+            then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 3 );
+
+        end;
+        inc( Addr1, Mod1 );
+
+      end;
+    4 :
+      for ty := 1 to ScanHeight do
+      begin
+        for tx := 1 to ScanWidth do
+        begin
+          if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then
+          begin
+            Result := true;
+            exit;
+          end;
+          inc( Addr1, 4 );
+
+        end;
+        inc( Addr1, Mod1 );
+
+      end;
+  end;
+end;
+
+procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B)
+  Src, Dest    : TSDL_Rect;
+  Diff         : integer;
+  SrcAddr, DestAddr : PtrUInt;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits         : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt8( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt8( DestAddr )^;
+              PUInt8( DestAddr )^ := Pixel2 or Pixel1;
+            end;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    15 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+
+              PUInt16( DestAddr )^ := Pixel2 or Pixel1;
+
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    16 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+
+              PUInt16( DestAddr )^ := Pixel2 or Pixel1;
+
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    24 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
+
+              PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 or Pixel1;
+            end;
+            inc( SrcAddr, 3 );
+            inc( DestAddr, 3 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    32 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^;
+
+              PUInt32( DestAddr )^ := Pixel2 or Pixel1;
+            end;
+            inc( SrcAddr, 4 );
+            inc( DestAddr, 4 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B)
+  Src, Dest    : TSDL_Rect;
+  Diff         : integer;
+  SrcAddr, DestAddr : PtrUInt;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits         : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt8( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt8( DestAddr )^;
+              PUInt8( DestAddr )^ := Pixel2 and Pixel1;
+            end;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    15 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+
+              PUInt16( DestAddr )^ := Pixel2 and Pixel1;
+
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    16 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+
+              PUInt16( DestAddr )^ := Pixel2 and Pixel1;
+
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    24 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
+
+              PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 and Pixel1;
+            end;
+            inc( SrcAddr, 3 );
+            inc( DestAddr, 3 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    32 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^;
+
+              PUInt32( DestAddr )^ := Pixel2 and Pixel1;
+            end;
+            inc( SrcAddr, 4 );
+            inc( DestAddr, 4 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+
+
+procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
+  Src, Dest    : TSDL_Rect;
+  Diff         : integer;
+  SrcAddr, DestAddr : PtrUInt;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits         : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt8( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt8( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                if Pixel2 and $E0 > Pixel1 and $E0 then
+                  R := Pixel2 and $E0
+                else
+                  R := Pixel1 and $E0;
+                if Pixel2 and $1C > Pixel1 and $1C then
+                  G := Pixel2 and $1C
+                else
+                  G := Pixel1 and $1C;
+                if Pixel2 and $03 > Pixel1 and $03 then
+                  B := Pixel2 and $03
+                else
+                  B := Pixel1 and $03;
+
+                if R > $E0 then
+                  R := $E0;
+                if G > $1C then
+                  G := $1C;
+                if B > $03 then
+                  B := $03;
+                PUInt8( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt8( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    15 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+                if Pixel2 and $7C00 > Pixel1 and $7C00 then
+                  R := Pixel2 and $7C00
+                else
+                  R := Pixel1 and $7C00;
+                if Pixel2 and $03E0 > Pixel1 and $03E0 then
+                  G := Pixel2 and $03E0
+                else
+                  G := Pixel1 and $03E0;
+                if Pixel2 and $001F > Pixel1 and $001F then
+                  B := Pixel2 and $001F
+                else
+                  B := Pixel1 and $001F;
+
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    16 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+                if Pixel2 and $F800 > Pixel1 and $F800 then
+                  R := Pixel2 and $F800
+                else
+                  R := Pixel1 and $F800;
+                if Pixel2 and $07E0 > Pixel1 and $07E0 then
+                  G := Pixel2 and $07E0
+                else
+                  G := Pixel1 and $07E0;
+                if Pixel2 and $001F > Pixel1 and $001F then
+                  B := Pixel2 and $001F
+                else
+                  B := Pixel1 and $001F;
+
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    24 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
+              if Pixel2 > 0 then
+              begin
+
+                if Pixel2 and $FF0000 > Pixel1 and $FF0000 then
+                  R := Pixel2 and $FF0000
+                else
+                  R := Pixel1 and $FF0000;
+                if Pixel2 and $00FF00 > Pixel1 and $00FF00 then
+                  G := Pixel2 and $00FF00
+                else
+                  G := Pixel1 and $00FF00;
+                if Pixel2 and $0000FF > Pixel1 and $0000FF then
+                  B := Pixel2 and $0000FF
+                else
+                  B := Pixel1 and $0000FF;
+
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
+              end
+              else
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
+            end;
+            inc( SrcAddr, 3 );
+            inc( DestAddr, 3 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    32 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+                if Pixel2 and $FF0000 > Pixel1 and $FF0000 then
+                  R := Pixel2 and $FF0000
+                else
+                  R := Pixel1 and $FF0000;
+                if Pixel2 and $00FF00 > Pixel1 and $00FF00 then
+                  G := Pixel2 and $00FF00
+                else
+                  G := Pixel1 and $00FF00;
+                if Pixel2 and $0000FF > Pixel1 and $0000FF then
+                  B := Pixel2 and $0000FF
+                else
+                  B := Pixel1 and $0000FF;
+
+                PUInt32( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt32( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 4 );
+            inc( DestAddr, 4 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+
+procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
+  DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
+var
+  R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
+  Src, Dest    : TSDL_Rect;
+  Diff         : integer;
+  SrcAddr, DestAddr : PtrUInt;
+  WorkX, WorkY : word;
+  SrcMod, DestMod : cardinal;
+  Bits         : cardinal;
+begin
+  if ( SrcSurface = nil ) or ( DestSurface = nil ) then
+    exit; // Remove this to make it faster
+  if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
+    exit; // Remove this to make it faster
+  if SrcRect = nil then
+  begin
+    with Src do
+    begin
+      x := 0;
+      y := 0;
+      w := SrcSurface.w;
+      h := SrcSurface.h;
+    end;
+  end
+  else
+    Src := SrcRect^;
+  if DestRect = nil then
+  begin
+    Dest.x := 0;
+    Dest.y := 0;
+  end
+  else
+    Dest := DestRect^;
+  Dest.w := Src.w;
+  Dest.h := Src.h;
+  with DestSurface.Clip_Rect do
+  begin
+    // Source's right side is greater than the dest.cliprect
+    if Dest.x + Src.w > x + w then
+    begin
+      smallint( Src.w ) := x + w - Dest.x;
+      smallint( Dest.w ) := x + w - Dest.x;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's bottom side is greater than the dest.clip
+    if Dest.y + Src.h > y + h then
+    begin
+      smallint( Src.h ) := y + h - Dest.y;
+      smallint( Dest.h ) := y + h - Dest.y;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+    // Source's left side is less than the dest.clip
+    if Dest.x < x then
+    begin
+      Diff := x - Dest.x;
+      Src.x := Src.x + Diff;
+      smallint( Src.w ) := smallint( Src.w ) - Diff;
+      Dest.x := x;
+      smallint( Dest.w ) := smallint( Dest.w ) - Diff;
+      if smallint( Dest.w ) < 1 then
+        exit;
+    end;
+    // Source's Top side is less than the dest.clip
+    if Dest.y < y then
+    begin
+      Diff := y - Dest.y;
+      Src.y := Src.y + Diff;
+      smallint( Src.h ) := smallint( Src.h ) - Diff;
+      Dest.y := y;
+      smallint( Dest.h ) := smallint( Dest.h ) - Diff;
+      if smallint( Dest.h ) < 1 then
+        exit;
+    end;
+  end;
+  with SrcSurface^ do
+  begin
+    SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
+      Format.BytesPerPixel;
+    SrcMod := Pitch - Src.w * Format.BytesPerPixel;
+    TransparentColor := Format.colorkey;
+  end;
+  with DestSurface^ do
+  begin
+    DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
+      Format.BytesPerPixel;
+    DestMod := Pitch - Dest.w * Format.BytesPerPixel;
+    Bits := Format.BitsPerPixel;
+  end;
+  SDL_LockSurface( SrcSurface );
+  SDL_LockSurface( DestSurface );
+  WorkY := Src.h;
+  case bits of
+    8 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt8( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt8( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+                if Pixel2 and $E0 < Pixel1 and $E0 then
+                  R := Pixel2 and $E0
+                else
+                  R := Pixel1 and $E0;
+                if Pixel2 and $1C < Pixel1 and $1C then
+                  G := Pixel2 and $1C
+                else
+                  G := Pixel1 and $1C;
+                if Pixel2 and $03 < Pixel1 and $03 then
+                  B := Pixel2 and $03
+                else
+                  B := Pixel1 and $03;
+
+                if R > $E0 then
+                  R := $E0;
+                if G > $1C then
+                  G := $1C;
+                if B > $03 then
+                  B := $03;
+                PUInt8( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt8( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr );
+            inc( DestAddr );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    15 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+                if Pixel2 and $7C00 < Pixel1 and $7C00 then
+                  R := Pixel2 and $7C00
+                else
+                  R := Pixel1 and $7C00;
+                if Pixel2 and $03E0 < Pixel1 and $03E0 then
+                  G := Pixel2 and $03E0
+                else
+                  G := Pixel1 and $03E0;
+                if Pixel2 and $001F < Pixel1 and $001F then
+                  B := Pixel2 and $001F
+                else
+                  B := Pixel1 and $001F;
+
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    16 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt16( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt16( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+                if Pixel2 and $F800 < Pixel1 and $F800 then
+                  R := Pixel2 and $F800
+                else
+                  R := Pixel1 and $F800;
+                if Pixel2 and $07E0 < Pixel1 and $07E0 then
+                  G := Pixel2 and $07E0
+                else
+                  G := Pixel1 and $07E0;
+                if Pixel2 and $001F < Pixel1 and $001F then
+                  B := Pixel2 and $001F
+                else
+                  B := Pixel1 and $001F;
+
+                PUInt16( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt16( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 2 );
+            inc( DestAddr, 2 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    24 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
+              if Pixel2 > 0 then
+              begin
+
+                if Pixel2 and $FF0000 < Pixel1 and $FF0000 then
+                  R := Pixel2 and $FF0000
+                else
+                  R := Pixel1 and $FF0000;
+                if Pixel2 and $00FF00 < Pixel1 and $00FF00 then
+                  G := Pixel2 and $00FF00
+                else
+                  G := Pixel1 and $00FF00;
+                if Pixel2 and $0000FF < Pixel1 and $0000FF then
+                  B := Pixel2 and $0000FF
+                else
+                  B := Pixel1 and $0000FF;
+
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
+              end
+              else
+                PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
+            end;
+            inc( SrcAddr, 3 );
+            inc( DestAddr, 3 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+    32 :
+      begin
+        repeat
+          WorkX := Src.w;
+          repeat
+            Pixel1 := PUInt32( SrcAddr )^;
+            if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
+            begin
+              Pixel2 := PUInt32( DestAddr )^;
+              if Pixel2 > 0 then
+              begin
+
+                if Pixel2 and $FF0000 < Pixel1 and $FF0000 then
+                  R := Pixel2 and $FF0000
+                else
+                  R := Pixel1 and $FF0000;
+                if Pixel2 and $00FF00 < Pixel1 and $00FF00 then
+                  G := Pixel2 and $00FF00
+                else
+                  G := Pixel1 and $00FF00;
+                if Pixel2 and $0000FF < Pixel1 and $0000FF then
+                  B := Pixel2 and $0000FF
+                else
+                  B := Pixel1 and $0000FF;
+
+                PUInt32( DestAddr )^ := R or G or B;
+              end
+              else
+                PUInt32( DestAddr )^ := Pixel1;
+            end;
+            inc( SrcAddr, 4 );
+            inc( DestAddr, 4 );
+            dec( WorkX );
+          until WorkX = 0;
+          inc( SrcAddr, SrcMod );
+          inc( DestAddr, DestMod );
+          dec( WorkY );
+        until WorkY = 0;
+      end;
+  end;
+  SDL_UnlockSurface( SrcSurface );
+  SDL_UnlockSurface( DestSurface );
+end;
+
+// Will clip the x1,x2,y1,x2 params to the ClipRect provided
+
+function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;
+var
+  tflag, flag1, flag2 : word;
+  txy, xedge, yedge : Integer;
+  slope        : single;
+
+  function ClipCode( x, y : Integer ) : word;
+  begin
+    Result := 0;
+    if x < ClipRect.x then
+      Result := 1;
+    if x >= ClipRect.w + ClipRect.x then
+      Result := Result or 2;
+    if y < ClipRect.y then
+      Result := Result or 4;
+    if y >= ClipRect.h + ClipRect.y then
+      Result := Result or 8;
+  end;
+
+begin
+  flag1 := ClipCode( x1, y1 );
+  flag2 := ClipCode( x2, y2 );
+  result := true;
+
+  while true do
+  begin
+    if ( flag1 or flag2 ) = 0 then
+      Exit; // all in
+
+    if ( flag1 and flag2 ) <> 0 then
+    begin
+      result := false;
+      Exit; // all out
+    end;
+
+    if flag2 = 0 then
+    begin
+      txy := x1; x1 := x2; x2 := txy;
+      txy := y1; y1 := y2; y2 := txy;
+      tflag := flag1; flag1 := flag2; flag2 := tflag;
+    end;
+
+    if ( flag2 and 3 ) <> 0 then
+    begin
+      if ( flag2 and 1 ) <> 0 then
+        xedge := ClipRect.x
+      else
+        xedge := ClipRect.w + ClipRect.x - 1; // back 1 pixel otherwise we end up in a loop
+
+      slope := ( y2 - y1 ) / ( x2 - x1 );
+      y2 := y1 + Round( slope * ( xedge - x1 ) );
+      x2 := xedge;
+    end
+    else
+    begin
+      if ( flag2 and 4 ) <> 0 then
+        yedge := ClipRect.y
+      else
+        yedge := ClipRect.h + ClipRect.y - 1; // up 1 pixel otherwise we end up in a loop
+
+      slope := ( x2 - x1 ) / ( y2 - y1 );
+      x2 := x1 + Round( slope * ( yedge - y1 ) );
+      y2 := yedge;
+    end;
+
+    flag2 := ClipCode( x2, y2 );
+  end;
+end;
+
+end.
+
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas
index ba60714b..99eea304 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas
@@ -1,566 +1,566 @@
-unit sdlwindow;

-{

-  $Id: sdlwindow.pas,v 1.9 2006/10/22 18:55:25 savage Exp $

-  

-}

-{******************************************************************************}

-{                                                                              }

-{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }

-{                SDL Window Wrapper                                            }

-{                                                                              }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Portions created by Dominique Louis are                                      }

-{ Copyright (C) 2004 - 2100 Dominique Louis.                                   }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{   SDL Window Wrapper                                                         }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   SDL.dll on Windows platforms                                               }

-{   libSDL-1.1.so.0 on Linux platform                                          }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{ January    31     2003 - DL : Initial creation                               }

-{                                                                              }

-{

-  $Log: sdlwindow.pas,v $

-  Revision 1.9  2006/10/22 18:55:25  savage

-  Slight Change to handle OpenGL context

-

-  Revision 1.8  2005/08/03 18:57:32  savage

-  Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class

-

-  Revision 1.7  2004/09/30 22:35:47  savage

-  Changes, enhancements and additions as required to get SoAoS working.

-

-  Revision 1.6  2004/09/12 21:52:58  savage

-  Slight changes to fix some issues with the sdl classes.

-

-  Revision 1.5  2004/05/10 21:11:49  savage

-  changes required to help get SoAoS off the ground.

-

-  Revision 1.4  2004/05/01 14:59:27  savage

-  Updated code

-

-  Revision 1.3  2004/04/23 10:45:28  savage

-  Changes made by Dean Ellis to work more modularly.

-

-  Revision 1.2  2004/03/31 10:06:41  savage

-  Changed so that it now compiles, but is untested.

-

-  Revision 1.1  2004/02/05 00:08:20  savage

-  Module 1.0 release

-  

-}

-{******************************************************************************}

-

-interface

-

-{$i jedi-sdl.inc}

-

-uses

-  Classes,

-  sdl,

-  sdlinput,

-  sdlticks;

-

-type

-  TSDLNotifyEvent =  procedure {$IFNDEF NOT_OO}of object{$ENDIF};

-  TSDLUpdateEvent =  procedure( aElapsedTime : single ) {$IFNDEF NOT_OO}of object{$ENDIF};

-  TSDLResizeEvent =  procedure( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ) {$IFNDEF NOT_OO}of object{$ENDIF};

-  TSDLUserEvent =  procedure( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer ) {$IFNDEF NOT_OO}of object{$ENDIF};

-  TSDLActiveEvent = procedure( aGain: UInt8; aState: UInt8 ) {$IFNDEF NOT_OO}of object{$ENDIF};

-

-  TSDLBaseWindow = class( TObject )

-  private

-    FDisplaySurface : PSDL_Surface;

-    FVideoFlags : Uint32;

-    FOnDestroy: TSDLNotifyEvent;

-    FOnCreate: TSDLNotifyEvent;

-    FOnShow: TSDLNotifyEvent;

-    FOnResize: TSDLResizeEvent;

-    FOnUpdate: TSDLUpdateEvent;

-    FOnRender: TSDLNotifyEvent;

-    FOnClose: TSDLNotifyEvent;

-    FLoaded: Boolean;

-    FRendering: Boolean;

-    FHeight: integer;

-    FBitDepth: integer;

-    FWidth: integer;

-    FInputManager: TSDLInputManager;

-    FCaptionText : PChar;

-    FIconName : PChar;

-    FOnActive: TSDLActiveEvent;

-    FOnQuit: TSDLNotifyEvent;

-    FOnExpose: TSDLNotifyEvent;

-    FOnUser: TSDLUserEvent;

-    FTimer : TSDLTicks;

-  protected

-    procedure DoActive( aGain: UInt8; aState: UInt8 );

-    procedure DoCreate;

-    procedure DoClose;

-    procedure DoDestroy;

-    procedure DoUpdate( aElapsedTime : single );

-    procedure DoQuit;

-    procedure DoRender;

-    procedure DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );

-    procedure DoShow;

-    procedure DoUser( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer );

-    procedure DoExpose;

-    procedure Render; virtual;

-    procedure Update( aElapsedTime : single ); virtual;

-    procedure InitialiseObjects; virtual;

-    procedure RestoreObjects; virtual;

-    procedure DeleteObjects; virtual;

-    function Flip : integer; virtual;

-    property OnActive : TSDLActiveEvent read FOnActive write FOnActive;

-    property OnClose: TSDLNotifyEvent read FOnClose write FOnClose;

-    property OnDestroy : TSDLNotifyEvent read FOnDestroy write FOnDestroy;

-    property OnCreate : TSDLNotifyEvent read FOnCreate write FOnCreate;

-    property OnUpdate: TSDLUpdateEvent read FOnUpdate write FOnUpdate;

-    property OnQuit : TSDLNotifyEvent read FOnQuit write FOnQuit;

-    property OnResize : TSDLResizeEvent read FOnResize write FOnResize;

-    property OnRender: TSDLNotifyEvent read FOnRender write FOnRender;

-    property OnShow : TSDLNotifyEvent read FOnShow write FOnShow;

-    property OnUser : TSDLUserEvent read FOnUser write FOnUser;

-    property OnExpose : TSDLNotifyEvent read FOnExpose write FOnExpose;

-    property DisplaySurface: PSDL_Surface read FDisplaySurface;

-  public

-    property InputManager : TSDLInputManager read FInputManager;

-    property Loaded : Boolean read FLoaded;

-    property Width : integer read FWidth;

-    property Height : integer read FHeight;

-    property BitDepth : integer read FBitDepth;

-    property Rendering : Boolean read FRendering write FRendering;

-    procedure SetCaption( const aCaptionText : string; const aIconName : string );

-    procedure GetCaption( var aCaptionText : string; var aIconName : string );

-    procedure SetIcon( aIcon : PSDL_Surface; aMask: UInt8 );

-    procedure ActivateVideoMode;

-    constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ); virtual;

-    destructor Destroy; override;

-    procedure InitialiseEnvironment;

-    function Show : Boolean; virtual;

-  end;

-

-  TSDLCustomWindow = class( TSDLBaseWindow )

-  public

-    property OnCreate;

-    property OnDestroy;

-    property OnClose;

-    property OnShow;

-    property OnResize;

-    property OnRender;

-    property OnUpdate;

-    property DisplaySurface;

-  end;

-

-  TSDL2DWindow = class( TSDLCustomWindow )

-  public

-    constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_DOUBLEBUF or SDL_SWSURFACE); override;

-    procedure Render; override;

-    procedure Update( aElapsedTime : single ); override;

-    procedure InitialiseObjects; override;

-    procedure RestoreObjects; override;

-    procedure DeleteObjects; override;

-    function Flip : integer; override;

-  end;

-

-  TSDL3DWindow = class( TSDLCustomWindow )

-  public

-    constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_OPENGL or SDL_DOUBLEBUF); override;

-    function Flip : integer; override;

-    procedure Render; override;

-    procedure Update( aElapsedTime : single ); override;

-    procedure InitialiseObjects; override;

-    procedure RestoreObjects; override;

-    procedure DeleteObjects; override;

-  end;

-

-

-

-implementation

-

-uses

-  logger,

-  SysUtils;

-

-{ TSDLBaseWindow }

-procedure TSDLBaseWindow.ActivateVideoMode;

-begin

-  FDisplaySurface := SDL_SetVideoMode( FWidth, FHeight, FBitDepth, FVideoFlags);

-  if (FDisplaySurface = nil) then

-  begin

-    Log.LogError( Format('Could not set video mode: %s', [SDL_GetError]), 'Main');

-    exit;

-  end;

-

-  SetCaption( 'Made with JEDI-SDL', 'JEDI-SDL Icon' );

-end;

-

-constructor TSDLBaseWindow.Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );

-begin

-  inherited Create;

-  SDL_Init(SDL_INIT_EVERYTHING);

-  FInputManager := TSDLInputManager.Create( [ itJoystick, itKeyBoard, itMouse ]);

-  FTimer := TSDLTicks.Create;

-

-  FWidth := aWidth;

-  FHeight := aHeight;

-  FBitDepth := aBitDepth;

-  FVideoFlags := aVideoFlags;

-

-  DoCreate;

-end;

-

-procedure TSDLBaseWindow.DeleteObjects;

-begin

-  FLoaded := False;

-end;

-

-destructor TSDLBaseWindow.Destroy;

-begin

-  DoDestroy;

-  if FLoaded then

-    DeleteObjects;

-  if FInputManager <> nil then

-    FreeAndNil( FInputManager );

-  if FTimer <> nil then

-    FreeAndNil( FTimer );

-  if FDisplaySurface <> nil then

-    SDL_FreeSurface( FDisplaySurface );

-  inherited Destroy;

-  SDL_Quit;

-end;

-

-procedure TSDLBaseWindow.DoActive(aGain, aState: UInt8);

-begin

-  if Assigned( FOnActive ) then

-  begin

-    FOnActive( aGain, aState );

-  end;

-end;

-

-procedure TSDLBaseWindow.DoClose;

-begin

-  if Assigned( FOnClose ) then

-  begin

-    FOnClose;

-  end;

-end;

-

-procedure TSDLBaseWindow.DoCreate;

-begin

-  if Assigned( FOnCreate ) then

-  begin

-    FOnCreate;

-  end;

-end;

-

-procedure TSDLBaseWindow.DoDestroy;

-begin

-  if Assigned( FOnDestroy ) then

-  begin

-    FOnDestroy;

-  end;

-end;

-

-procedure TSDLBaseWindow.DoExpose;

-begin

-  if Assigned( FOnExpose ) then

-  begin

-    FOnExpose;

-  end;

-end;

-

-procedure TSDLBaseWindow.DoUpdate( aElapsedTime : single );

-begin

-  if Assigned( FOnUpdate ) then

-  begin

-    FOnUpdate( aElapsedTime );

-  end;

-end;

-

-procedure TSDLBaseWindow.DoQuit;

-begin

-  FRendering := false;

-  if Assigned( FOnQuit ) then

-  begin

-    FOnQuit;

-  end;

-end;

-

-procedure TSDLBaseWindow.DoRender;

-begin

-  if Assigned(  FOnRender ) then

-  begin

-    FOnRender;

-  end;

-end;

-

-procedure TSDLBaseWindow.DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );

-begin

-  // resize to the new size

-  SDL_FreeSurface(FDisplaySurface);

-  FWidth := aWidth;

-  FHeight := aHeight;

-  FBitDepth := aBitDepth;

-  FVideoFlags := aVideoFlags;

-  FDisplaySurface := SDL_SetVideoMode(aWidth, aHeight, aBitDepth, aVideoFlags);

-  if Assigned( FOnResize ) then

-  begin

-    FOnResize( aWidth, aHeight, aBitDepth, aVideoFlags );

-  end;

-end;

-

-procedure TSDLBaseWindow.DoShow;

-begin

-  if Assigned( FOnShow ) then

-  begin

-    FOnShow;

-  end;

-end;

-

-procedure TSDLBaseWindow.DoUser(aType: UInt8; aCode: integer; aData1, aData2: Pointer);

-begin

-  if Assigned(  FOnUser ) then

-  begin

-    FOnUser( aType, aCode, aData1, aData2 );

-  end;

-end;

-

-function TSDLBaseWindow.Flip : integer;

-begin

-  result := 0;

-end;

-

-procedure TSDLBaseWindow.GetCaption( var aCaptionText : string; var aIconName : string );

-begin

-  aCaptionText := string( FCaptionText );

-  aIconName := string( FIconName );

-end;

-

-procedure TSDLBaseWindow.InitialiseEnvironment;

-begin

-  InitialiseObjects;

-  RestoreObjects;

-end;

-

-procedure TSDLBaseWindow.InitialiseObjects;

-begin

-  FLoaded := True;

-end;

-

-procedure TSDLBaseWindow.Update( aElapsedTime : single );

-begin

-  DoUpdate( aElapsedTime );

-end;

-

-procedure TSDLBaseWindow.Render;

-begin

-  DoRender;

-end;

-

-procedure TSDLBaseWindow.RestoreObjects;

-begin

-  FLoaded := false;

-end;

-

-procedure TSDLBaseWindow.SetCaption( const aCaptionText : string; const aIconName : string );

-begin

-  if FCaptionText <> aCaptionText then

-  begin

-    FCaptionText := PChar( aCaptionText );

-    FIconName := PChar( aIconName );

-    SDL_WM_SetCaption( FCaptionText, FIconName );

-  end;

-end;

-

-procedure TSDLBaseWindow.SetIcon(aIcon: PSDL_Surface; aMask: UInt8);

-begin

-  SDL_WM_SetIcon( aIcon, aMask );

-end;

-

-function TSDLBaseWindow.Show : Boolean;

-var

-  eBaseWindowEvent : TSDL_Event;

-begin

-  DoShow;

-

-  FTimer.Init;

-

-  FRendering := true;

-  // repeat until we are told not to render

-  while FRendering do

-  begin

-    // wait for an event

-    while SDL_PollEvent( @eBaseWindowEvent ) > 0 do

-    begin

-

-      // check for a quit event

-      case eBaseWindowEvent.type_ of

-        SDL_ACTIVEEVENT :

-        begin

-          DoActive( eBaseWindowEvent.active.gain, eBaseWindowEvent.active.state );

-        end;

-

-        SDL_QUITEV :

-        begin

-          DoQuit;

-          DoClose;

-        end;

-

-        SDL_USEREVENT :

-        begin

-          DoUser( eBaseWindowEvent.user.type_, eBaseWindowEvent.user.code, eBaseWindowEvent.user.data1, eBaseWindowEvent.user.data2 );

-        end;

-

-        SDL_VIDEOEXPOSE :

-        begin

-          DoExpose;

-        end;

-

-        SDL_VIDEORESIZE :

-        begin

-          DoResize( eBaseWindowEvent.resize.w, eBaseWindowEvent.resize.h, FDisplaySurface.format.BitsPerPixel, FVideoflags );

-        end;

-

-

-      end;

-      InputManager.UpdateInputs( eBaseWindowEvent );

-    end;

-    // Prepare the Next Frame

-    Update( FTimer.GetElapsedSeconds );

-    // Display the Next Frame

-    Render;

-    // Flip the surfaces

-    Flip;

-  end;

-

-  Result := FRendering;

-end;

-

-{ TSDL2DWindow }

-

-constructor TSDL2DWindow.Create(aWidth, aHeight, aBitDepth: integer; aVideoFlags: Uint32);

-begin

-  // make sure double buffer is always included in the video flags

-  inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_DOUBLEBUF);

-end;

-

-procedure TSDL2DWindow.DeleteObjects;

-begin

-  inherited;

-

-end;

-

-function TSDL2DWindow.Flip: integer;

-begin

-  // let's show the back buffer

-  result := SDL_Flip( FDisplaySurface );

-end;

-

-procedure TSDL2DWindow.InitialiseObjects;

-begin

-  inherited;

-

-end;

-

-procedure TSDL2DWindow.Update( aElapsedTime : single );

-begin

-  inherited;

-

-end;

-

-procedure TSDL2DWindow.Render;

-begin

-  inherited;

-

-end;

-

-procedure TSDL2DWindow.RestoreObjects;

-begin

-  inherited;

-

-end;

-

-{ TSDL3DWindow }

-

-constructor TSDL3DWindow.Create(aWidth,

-  aHeight, aBitDepth: integer; aVideoFlags: Uint32);

-begin

-  // make sure opengl is always included in the video flags

-  inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_OPENGL or SDL_DOUBLEBUF);

-end;

-

-procedure TSDL3DWindow.DeleteObjects;

-begin

-  inherited;

-

-end;

-

-function TSDL3DWindow.Flip : integer;

-begin

-  SDL_GL_SwapBuffers;

-  result := 0;

-end;

-

-procedure TSDL3DWindow.InitialiseObjects;

-begin

-  inherited;

-

-end;

-

-procedure TSDL3DWindow.Update( aElapsedTime : single );

-begin

-  inherited;

-

-end;

-

-procedure TSDL3DWindow.Render;

-begin

-  inherited;

-  

-end;

-

-procedure TSDL3DWindow.RestoreObjects;

-begin

-  inherited;

-

-end;

-

-end.

+unit sdlwindow;
+{
+  $Id: sdlwindow.pas,v 1.9 2006/10/22 18:55:25 savage Exp $
+  
+}
+{******************************************************************************}
+{                                                                              }
+{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }
+{                SDL Window Wrapper                                            }
+{                                                                              }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Portions created by Dominique Louis are                                      }
+{ Copyright (C) 2004 - 2100 Dominique Louis.                                   }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{ Dominique Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{   SDL Window Wrapper                                                         }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   SDL.dll on Windows platforms                                               }
+{   libSDL-1.1.so.0 on Linux platform                                          }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{ January    31     2003 - DL : Initial creation                               }
+{                                                                              }
+{
+  $Log: sdlwindow.pas,v $
+  Revision 1.9  2006/10/22 18:55:25  savage
+  Slight Change to handle OpenGL context
+
+  Revision 1.8  2005/08/03 18:57:32  savage
+  Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class
+
+  Revision 1.7  2004/09/30 22:35:47  savage
+  Changes, enhancements and additions as required to get SoAoS working.
+
+  Revision 1.6  2004/09/12 21:52:58  savage
+  Slight changes to fix some issues with the sdl classes.
+
+  Revision 1.5  2004/05/10 21:11:49  savage
+  changes required to help get SoAoS off the ground.
+
+  Revision 1.4  2004/05/01 14:59:27  savage
+  Updated code
+
+  Revision 1.3  2004/04/23 10:45:28  savage
+  Changes made by Dean Ellis to work more modularly.
+
+  Revision 1.2  2004/03/31 10:06:41  savage
+  Changed so that it now compiles, but is untested.
+
+  Revision 1.1  2004/02/05 00:08:20  savage
+  Module 1.0 release
+  
+}
+{******************************************************************************}
+
+interface
+
+{$i jedi-sdl.inc}
+
+uses
+  Classes,
+  sdl,
+  sdlinput,
+  sdlticks;
+
+type
+  TSDLNotifyEvent =  procedure {$IFNDEF NOT_OO}of object{$ENDIF};
+  TSDLUpdateEvent =  procedure( aElapsedTime : single ) {$IFNDEF NOT_OO}of object{$ENDIF};
+  TSDLResizeEvent =  procedure( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+  TSDLUserEvent =  procedure( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer ) {$IFNDEF NOT_OO}of object{$ENDIF};
+  TSDLActiveEvent = procedure( aGain: UInt8; aState: UInt8 ) {$IFNDEF NOT_OO}of object{$ENDIF};
+
+  TSDLBaseWindow = class( TObject )
+  private
+    FDisplaySurface : PSDL_Surface;
+    FVideoFlags : Uint32;
+    FOnDestroy: TSDLNotifyEvent;
+    FOnCreate: TSDLNotifyEvent;
+    FOnShow: TSDLNotifyEvent;
+    FOnResize: TSDLResizeEvent;
+    FOnUpdate: TSDLUpdateEvent;
+    FOnRender: TSDLNotifyEvent;
+    FOnClose: TSDLNotifyEvent;
+    FLoaded: Boolean;
+    FRendering: Boolean;
+    FHeight: integer;
+    FBitDepth: integer;
+    FWidth: integer;
+    FInputManager: TSDLInputManager;
+    FCaptionText : PChar;
+    FIconName : PChar;
+    FOnActive: TSDLActiveEvent;
+    FOnQuit: TSDLNotifyEvent;
+    FOnExpose: TSDLNotifyEvent;
+    FOnUser: TSDLUserEvent;
+    FTimer : TSDLTicks;
+  protected
+    procedure DoActive( aGain: UInt8; aState: UInt8 );
+    procedure DoCreate;
+    procedure DoClose;
+    procedure DoDestroy;
+    procedure DoUpdate( aElapsedTime : single );
+    procedure DoQuit;
+    procedure DoRender;
+    procedure DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );
+    procedure DoShow;
+    procedure DoUser( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer );
+    procedure DoExpose;
+    procedure Render; virtual;
+    procedure Update( aElapsedTime : single ); virtual;
+    procedure InitialiseObjects; virtual;
+    procedure RestoreObjects; virtual;
+    procedure DeleteObjects; virtual;
+    function Flip : integer; virtual;
+    property OnActive : TSDLActiveEvent read FOnActive write FOnActive;
+    property OnClose: TSDLNotifyEvent read FOnClose write FOnClose;
+    property OnDestroy : TSDLNotifyEvent read FOnDestroy write FOnDestroy;
+    property OnCreate : TSDLNotifyEvent read FOnCreate write FOnCreate;
+    property OnUpdate: TSDLUpdateEvent read FOnUpdate write FOnUpdate;
+    property OnQuit : TSDLNotifyEvent read FOnQuit write FOnQuit;
+    property OnResize : TSDLResizeEvent read FOnResize write FOnResize;
+    property OnRender: TSDLNotifyEvent read FOnRender write FOnRender;
+    property OnShow : TSDLNotifyEvent read FOnShow write FOnShow;
+    property OnUser : TSDLUserEvent read FOnUser write FOnUser;
+    property OnExpose : TSDLNotifyEvent read FOnExpose write FOnExpose;
+    property DisplaySurface: PSDL_Surface read FDisplaySurface;
+  public
+    property InputManager : TSDLInputManager read FInputManager;
+    property Loaded : Boolean read FLoaded;
+    property Width : integer read FWidth;
+    property Height : integer read FHeight;
+    property BitDepth : integer read FBitDepth;
+    property Rendering : Boolean read FRendering write FRendering;
+    procedure SetCaption( const aCaptionText : string; const aIconName : string );
+    procedure GetCaption( var aCaptionText : string; var aIconName : string );
+    procedure SetIcon( aIcon : PSDL_Surface; aMask: UInt8 );
+    procedure ActivateVideoMode;
+    constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ); virtual;
+    destructor Destroy; override;
+    procedure InitialiseEnvironment;
+    function Show : Boolean; virtual;
+  end;
+
+  TSDLCustomWindow = class( TSDLBaseWindow )
+  public
+    property OnCreate;
+    property OnDestroy;
+    property OnClose;
+    property OnShow;
+    property OnResize;
+    property OnRender;
+    property OnUpdate;
+    property DisplaySurface;
+  end;
+
+  TSDL2DWindow = class( TSDLCustomWindow )
+  public
+    constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_DOUBLEBUF or SDL_SWSURFACE); override;
+    procedure Render; override;
+    procedure Update( aElapsedTime : single ); override;
+    procedure InitialiseObjects; override;
+    procedure RestoreObjects; override;
+    procedure DeleteObjects; override;
+    function Flip : integer; override;
+  end;
+
+  TSDL3DWindow = class( TSDLCustomWindow )
+  public
+    constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_OPENGL or SDL_DOUBLEBUF); override;
+    function Flip : integer; override;
+    procedure Render; override;
+    procedure Update( aElapsedTime : single ); override;
+    procedure InitialiseObjects; override;
+    procedure RestoreObjects; override;
+    procedure DeleteObjects; override;
+  end;
+
+
+
+implementation
+
+uses
+  logger,
+  SysUtils;
+
+{ TSDLBaseWindow }
+procedure TSDLBaseWindow.ActivateVideoMode;
+begin
+  FDisplaySurface := SDL_SetVideoMode( FWidth, FHeight, FBitDepth, FVideoFlags);
+  if (FDisplaySurface = nil) then
+  begin
+    Log.LogError( Format('Could not set video mode: %s', [SDL_GetError]), 'Main');
+    exit;
+  end;
+
+  SetCaption( 'Made with JEDI-SDL', 'JEDI-SDL Icon' );
+end;
+
+constructor TSDLBaseWindow.Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );
+begin
+  inherited Create;
+  SDL_Init(SDL_INIT_EVERYTHING);
+  FInputManager := TSDLInputManager.Create( [ itJoystick, itKeyBoard, itMouse ]);
+  FTimer := TSDLTicks.Create;
+
+  FWidth := aWidth;
+  FHeight := aHeight;
+  FBitDepth := aBitDepth;
+  FVideoFlags := aVideoFlags;
+
+  DoCreate;
+end;
+
+procedure TSDLBaseWindow.DeleteObjects;
+begin
+  FLoaded := False;
+end;
+
+destructor TSDLBaseWindow.Destroy;
+begin
+  DoDestroy;
+  if FLoaded then
+    DeleteObjects;
+  if FInputManager <> nil then
+    FreeAndNil( FInputManager );
+  if FTimer <> nil then
+    FreeAndNil( FTimer );
+  if FDisplaySurface <> nil then
+    SDL_FreeSurface( FDisplaySurface );
+  inherited Destroy;
+  SDL_Quit;
+end;
+
+procedure TSDLBaseWindow.DoActive(aGain, aState: UInt8);
+begin
+  if Assigned( FOnActive ) then
+  begin
+    FOnActive( aGain, aState );
+  end;
+end;
+
+procedure TSDLBaseWindow.DoClose;
+begin
+  if Assigned( FOnClose ) then
+  begin
+    FOnClose;
+  end;
+end;
+
+procedure TSDLBaseWindow.DoCreate;
+begin
+  if Assigned( FOnCreate ) then
+  begin
+    FOnCreate;
+  end;
+end;
+
+procedure TSDLBaseWindow.DoDestroy;
+begin
+  if Assigned( FOnDestroy ) then
+  begin
+    FOnDestroy;
+  end;
+end;
+
+procedure TSDLBaseWindow.DoExpose;
+begin
+  if Assigned( FOnExpose ) then
+  begin
+    FOnExpose;
+  end;
+end;
+
+procedure TSDLBaseWindow.DoUpdate( aElapsedTime : single );
+begin
+  if Assigned( FOnUpdate ) then
+  begin
+    FOnUpdate( aElapsedTime );
+  end;
+end;
+
+procedure TSDLBaseWindow.DoQuit;
+begin
+  FRendering := false;
+  if Assigned( FOnQuit ) then
+  begin
+    FOnQuit;
+  end;
+end;
+
+procedure TSDLBaseWindow.DoRender;
+begin
+  if Assigned(  FOnRender ) then
+  begin
+    FOnRender;
+  end;
+end;
+
+procedure TSDLBaseWindow.DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );
+begin
+  // resize to the new size
+  SDL_FreeSurface(FDisplaySurface);
+  FWidth := aWidth;
+  FHeight := aHeight;
+  FBitDepth := aBitDepth;
+  FVideoFlags := aVideoFlags;
+  FDisplaySurface := SDL_SetVideoMode(aWidth, aHeight, aBitDepth, aVideoFlags);
+  if Assigned( FOnResize ) then
+  begin
+    FOnResize( aWidth, aHeight, aBitDepth, aVideoFlags );
+  end;
+end;
+
+procedure TSDLBaseWindow.DoShow;
+begin
+  if Assigned( FOnShow ) then
+  begin
+    FOnShow;
+  end;
+end;
+
+procedure TSDLBaseWindow.DoUser(aType: UInt8; aCode: integer; aData1, aData2: Pointer);
+begin
+  if Assigned(  FOnUser ) then
+  begin
+    FOnUser( aType, aCode, aData1, aData2 );
+  end;
+end;
+
+function TSDLBaseWindow.Flip : integer;
+begin
+  result := 0;
+end;
+
+procedure TSDLBaseWindow.GetCaption( var aCaptionText : string; var aIconName : string );
+begin
+  aCaptionText := string( FCaptionText );
+  aIconName := string( FIconName );
+end;
+
+procedure TSDLBaseWindow.InitialiseEnvironment;
+begin
+  InitialiseObjects;
+  RestoreObjects;
+end;
+
+procedure TSDLBaseWindow.InitialiseObjects;
+begin
+  FLoaded := True;
+end;
+
+procedure TSDLBaseWindow.Update( aElapsedTime : single );
+begin
+  DoUpdate( aElapsedTime );
+end;
+
+procedure TSDLBaseWindow.Render;
+begin
+  DoRender;
+end;
+
+procedure TSDLBaseWindow.RestoreObjects;
+begin
+  FLoaded := false;
+end;
+
+procedure TSDLBaseWindow.SetCaption( const aCaptionText : string; const aIconName : string );
+begin
+  if FCaptionText <> aCaptionText then
+  begin
+    FCaptionText := PChar( aCaptionText );
+    FIconName := PChar( aIconName );
+    SDL_WM_SetCaption( FCaptionText, FIconName );
+  end;
+end;
+
+procedure TSDLBaseWindow.SetIcon(aIcon: PSDL_Surface; aMask: UInt8);
+begin
+  SDL_WM_SetIcon( aIcon, aMask );
+end;
+
+function TSDLBaseWindow.Show : Boolean;
+var
+  eBaseWindowEvent : TSDL_Event;
+begin
+  DoShow;
+
+  FTimer.Init;
+
+  FRendering := true;
+  // repeat until we are told not to render
+  while FRendering do
+  begin
+    // wait for an event
+    while SDL_PollEvent( @eBaseWindowEvent ) > 0 do
+    begin
+
+      // check for a quit event
+      case eBaseWindowEvent.type_ of
+        SDL_ACTIVEEVENT :
+        begin
+          DoActive( eBaseWindowEvent.active.gain, eBaseWindowEvent.active.state );
+        end;
+
+        SDL_QUITEV :
+        begin
+          DoQuit;
+          DoClose;
+        end;
+
+        SDL_USEREVENT :
+        begin
+          DoUser( eBaseWindowEvent.user.type_, eBaseWindowEvent.user.code, eBaseWindowEvent.user.data1, eBaseWindowEvent.user.data2 );
+        end;
+
+        SDL_VIDEOEXPOSE :
+        begin
+          DoExpose;
+        end;
+
+        SDL_VIDEORESIZE :
+        begin
+          DoResize( eBaseWindowEvent.resize.w, eBaseWindowEvent.resize.h, FDisplaySurface.format.BitsPerPixel, FVideoflags );
+        end;
+
+
+      end;
+      InputManager.UpdateInputs( eBaseWindowEvent );
+    end;
+    // Prepare the Next Frame
+    Update( FTimer.GetElapsedSeconds );
+    // Display the Next Frame
+    Render;
+    // Flip the surfaces
+    Flip;
+  end;
+
+  Result := FRendering;
+end;
+
+{ TSDL2DWindow }
+
+constructor TSDL2DWindow.Create(aWidth, aHeight, aBitDepth: integer; aVideoFlags: Uint32);
+begin
+  // make sure double buffer is always included in the video flags
+  inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_DOUBLEBUF);
+end;
+
+procedure TSDL2DWindow.DeleteObjects;
+begin
+  inherited;
+
+end;
+
+function TSDL2DWindow.Flip: integer;
+begin
+  // let's show the back buffer
+  result := SDL_Flip( FDisplaySurface );
+end;
+
+procedure TSDL2DWindow.InitialiseObjects;
+begin
+  inherited;
+
+end;
+
+procedure TSDL2DWindow.Update( aElapsedTime : single );
+begin
+  inherited;
+
+end;
+
+procedure TSDL2DWindow.Render;
+begin
+  inherited;
+
+end;
+
+procedure TSDL2DWindow.RestoreObjects;
+begin
+  inherited;
+
+end;
+
+{ TSDL3DWindow }
+
+constructor TSDL3DWindow.Create(aWidth,
+  aHeight, aBitDepth: integer; aVideoFlags: Uint32);
+begin
+  // make sure opengl is always included in the video flags
+  inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_OPENGL or SDL_DOUBLEBUF);
+end;
+
+procedure TSDL3DWindow.DeleteObjects;
+begin
+  inherited;
+
+end;
+
+function TSDL3DWindow.Flip : integer;
+begin
+  SDL_GL_SwapBuffers;
+  result := 0;
+end;
+
+procedure TSDL3DWindow.InitialiseObjects;
+begin
+  inherited;
+
+end;
+
+procedure TSDL3DWindow.Update( aElapsedTime : single );
+begin
+  inherited;
+
+end;
+
+procedure TSDL3DWindow.Render;
+begin
+  inherited;
+  
+end;
+
+procedure TSDL3DWindow.RestoreObjects;
+begin
+  inherited;
+
+end;
+
+end.
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas
index 97e26520..aed326d1 100644
--- a/Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas
+++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas
@@ -1,159 +1,159 @@
-unit userpreferences;

-{

-  $Id: userpreferences.pas,v 1.1 2004/09/30 22:35:47 savage Exp $

-  

-}

-{******************************************************************************}

-{                                                                              }

-{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }

-{                 Base Class for User Preferences                              }

-{                                                                              }

-{ The initial developer of this Pascal code was :                              }

-{ Dominqiue Louis <Dominique@SavageSoftware.com.au>                            }

-{                                                                              }

-{ Portions created by Dominqiue Louis are                                      }

-{ Copyright (C) 2000 - 2001 Dominqiue Louis.                                   }

-{                                                                              }

-{                                                                              }

-{ Contributor(s)                                                               }

-{ --------------                                                               }

-{                                                                              }

-{                                                                              }

-{ Obtained through:                                                            }

-{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }

-{                                                                              }

-{ You may retrieve the latest version of this file at the Project              }

-{ JEDI home page, located at http://delphi-jedi.org                            }

-{                                                                              }

-{ 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.                                    }

-{                                                                              }

-{ Description                                                                  }

-{ -----------                                                                  }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Requires                                                                     }

-{ --------                                                                     }

-{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }

-{   They are available from...                                                 }

-{   http://www.libsdl.org .                                                    }

-{                                                                              }

-{ Programming Notes                                                            }

-{ -----------------                                                            }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{                                                                              }

-{ Revision History                                                             }

-{ ----------------                                                             }

-{   September   23 2004 - DL : Initial Creation                                }

-{

-  $Log: userpreferences.pas,v $

-  Revision 1.1  2004/09/30 22:35:47  savage

-  Changes, enhancements and additions as required to get SoAoS working.

-

-

-}

-{******************************************************************************}

-

-interface

-

-uses

-  Classes;

-

-type

-  TUserPreferences = class

-  private

-    FAutoSave: Boolean;

-    procedure CheckAutoSave;

-  protected

-    function GetDefaultBoolean( const Index : Integer ) : Boolean; virtual; abstract;

-    function GetBoolean( const Index : Integer ) : Boolean; virtual; abstract;

-    procedure SetBoolean( const Index : Integer; const Value : Boolean ); virtual;

-    function GetDefaultDateTime( const Index : Integer ) : TDateTime; virtual; abstract;

-    function GetDateTime( const Index : Integer ) : TDateTime; virtual; abstract;

-    procedure SetDateTime( const Index : Integer; const Value : TDateTime ); virtual;

-    function GetDefaultInteger( const Index : Integer ) : Integer; virtual; abstract;

-    function GetInteger( const Index : Integer ) : Integer; virtual; abstract;

-    procedure SetInteger( const Index : Integer; const Value : Integer ); virtual;

-    function GetDefaultFloat( const Index : Integer ) : single; virtual; abstract;

-    function GetFloat( const Index : Integer ) : single; virtual; abstract;

-    procedure SetFloat( const Index : Integer; const Value : single ); virtual;

-    function GetDefaultString( const Index : Integer ) : string; virtual; abstract;

-    function GetString( const Index : Integer ) : string; virtual; abstract;

-    procedure SetString( const Index : Integer; const Value : string ); virtual;

-    function GetDefaultBinaryStream( const Index : Integer ) : TStream; virtual; abstract;

-    function GetBinaryStream( const Index : Integer ) : TStream; virtual; abstract;

-    procedure SetBinaryStream( const Index : Integer; const Value : TStream ); virtual;

-  public

-    procedure Update; virtual; abstract;

-    constructor Create; virtual;

-    destructor Destroy; override;

-    property AutoSave : Boolean read FAutoSave write FAutoSave;

-  end;

-

-implementation

-

-{ TUserPreferences }

-procedure TUserPreferences.CheckAutoSave;

-begin

-  if FAutoSave then

-    Update;

-end;

-

-constructor TUserPreferences.Create;

-begin

-  inherited;

-  FAutoSave := false;

-end;

-

-destructor TUserPreferences.Destroy;

-begin

-

-  inherited;

-end;

-

-procedure TUserPreferences.SetBinaryStream( const Index : Integer; const Value : TStream );

-begin

-  CheckAutoSave;

-end;

-

-procedure TUserPreferences.SetBoolean(const Index: Integer; const Value: Boolean);

-begin

-  CheckAutoSave;

-end;

-

-procedure TUserPreferences.SetDateTime(const Index: Integer; const Value: TDateTime);

-begin

-  CheckAutoSave;

-end;

-

-procedure TUserPreferences.SetFloat(const Index: Integer; const Value: single);

-begin

-  CheckAutoSave;

-end;

-

-procedure TUserPreferences.SetInteger(const Index, Value: Integer);

-begin

-  CheckAutoSave;

-end;

-

-procedure TUserPreferences.SetString(const Index: Integer; const Value: string);

-begin

-  CheckAutoSave;

-end;

-

-end.

+unit userpreferences;
+{
+  $Id: userpreferences.pas,v 1.1 2004/09/30 22:35:47 savage Exp $
+  
+}
+{******************************************************************************}
+{                                                                              }
+{          JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer          }
+{                 Base Class for User Preferences                              }
+{                                                                              }
+{ The initial developer of this Pascal code was :                              }
+{ Dominqiue Louis <Dominique@SavageSoftware.com.au>                            }
+{                                                                              }
+{ Portions created by Dominqiue Louis are                                      }
+{ Copyright (C) 2000 - 2001 Dominqiue Louis.                                   }
+{                                                                              }
+{                                                                              }
+{ Contributor(s)                                                               }
+{ --------------                                                               }
+{                                                                              }
+{                                                                              }
+{ Obtained through:                                                            }
+{ Joint Endeavour of Delphi Innovators ( Project JEDI )                        }
+{                                                                              }
+{ You may retrieve the latest version of this file at the Project              }
+{ JEDI home page, located at http://delphi-jedi.org                            }
+{                                                                              }
+{ 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.                                    }
+{                                                                              }
+{ Description                                                                  }
+{ -----------                                                                  }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Requires                                                                     }
+{ --------                                                                     }
+{   The SDL Runtime libraris on Win32  : SDL.dll on Linux : libSDL.so          }
+{   They are available from...                                                 }
+{   http://www.libsdl.org .                                                    }
+{                                                                              }
+{ Programming Notes                                                            }
+{ -----------------                                                            }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{                                                                              }
+{ Revision History                                                             }
+{ ----------------                                                             }
+{   September   23 2004 - DL : Initial Creation                                }
+{
+  $Log: userpreferences.pas,v $
+  Revision 1.1  2004/09/30 22:35:47  savage
+  Changes, enhancements and additions as required to get SoAoS working.
+
+
+}
+{******************************************************************************}
+
+interface
+
+uses
+  Classes;
+
+type
+  TUserPreferences = class
+  private
+    FAutoSave: Boolean;
+    procedure CheckAutoSave;
+  protected
+    function GetDefaultBoolean( const Index : Integer ) : Boolean; virtual; abstract;
+    function GetBoolean( const Index : Integer ) : Boolean; virtual; abstract;
+    procedure SetBoolean( const Index : Integer; const Value : Boolean ); virtual;
+    function GetDefaultDateTime( const Index : Integer ) : TDateTime; virtual; abstract;
+    function GetDateTime( const Index : Integer ) : TDateTime; virtual; abstract;
+    procedure SetDateTime( const Index : Integer; const Value : TDateTime ); virtual;
+    function GetDefaultInteger( const Index : Integer ) : Integer; virtual; abstract;
+    function GetInteger( const Index : Integer ) : Integer; virtual; abstract;
+    procedure SetInteger( const Index : Integer; const Value : Integer ); virtual;
+    function GetDefaultFloat( const Index : Integer ) : single; virtual; abstract;
+    function GetFloat( const Index : Integer ) : single; virtual; abstract;
+    procedure SetFloat( const Index : Integer; const Value : single ); virtual;
+    function GetDefaultString( const Index : Integer ) : string; virtual; abstract;
+    function GetString( const Index : Integer ) : string; virtual; abstract;
+    procedure SetString( const Index : Integer; const Value : string ); virtual;
+    function GetDefaultBinaryStream( const Index : Integer ) : TStream; virtual; abstract;
+    function GetBinaryStream( const Index : Integer ) : TStream; virtual; abstract;
+    procedure SetBinaryStream( const Index : Integer; const Value : TStream ); virtual;
+  public
+    procedure Update; virtual; abstract;
+    constructor Create; virtual;
+    destructor Destroy; override;
+    property AutoSave : Boolean read FAutoSave write FAutoSave;
+  end;
+
+implementation
+
+{ TUserPreferences }
+procedure TUserPreferences.CheckAutoSave;
+begin
+  if FAutoSave then
+    Update;
+end;
+
+constructor TUserPreferences.Create;
+begin
+  inherited;
+  FAutoSave := false;
+end;
+
+destructor TUserPreferences.Destroy;
+begin
+
+  inherited;
+end;
+
+procedure TUserPreferences.SetBinaryStream( const Index : Integer; const Value : TStream );
+begin
+  CheckAutoSave;
+end;
+
+procedure TUserPreferences.SetBoolean(const Index: Integer; const Value: Boolean);
+begin
+  CheckAutoSave;
+end;
+
+procedure TUserPreferences.SetDateTime(const Index: Integer; const Value: TDateTime);
+begin
+  CheckAutoSave;
+end;
+
+procedure TUserPreferences.SetFloat(const Index: Integer; const Value: single);
+begin
+  CheckAutoSave;
+end;
+
+procedure TUserPreferences.SetInteger(const Index, Value: Integer);
+begin
+  CheckAutoSave;
+end;
+
+procedure TUserPreferences.SetString(const Index: Integer; const Value: string);
+begin
+  CheckAutoSave;
+end;
+
+end.