From 1cec357365c6260da0667966460387aaffa76436 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 5 Feb 2008 11:27:22 +0000 Subject: renamed Jedi-SDL folder. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@810 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt | 27 + Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc | 337 ++ Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas | 2690 ++++++++++ Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas | 176 + Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas | 319 ++ .../JEDI-SDL/SDL/Pas/registryuserpreferences.pas | 229 + Game/Code/lib/JEDI-SDL/SDL/Pas/sdl.pas | 4118 +++++++++++++++ Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas | 155 + .../Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas | 195 + Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas | 5236 ++++++++++++++++++++ Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas | 692 +++ Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas | 216 + Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas | 196 + Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas | 4256 ++++++++++++++++ Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas | 564 +++ Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas | 159 + 16 files changed, 19565 insertions(+) create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/sdl.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas create mode 100644 Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas (limited to 'Game/Code/lib/JEDI-SDL/SDL/Pas') diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt b/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt new file mode 100644 index 00000000..76d63a9d --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt @@ -0,0 +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 +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 new file mode 100644 index 00000000..48a789fd --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc @@ -0,0 +1,337 @@ +{ + $Id: jedi-sdl.inc,v 1.9 2004/12/23 23:42:17 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 } +{ } +{ Portions created by Prof. Abimbola Olowofoyeku are } +{ Copyright (C) 2000 - 2100 Prof. Abimbola Olowofoyeku. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Prof. Abimbola Olowofoyeku } +{ Dominqiue Louis } +{ } +{ 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.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} +{$ENDIF ver90} + +{$IFDEF ver100} + {$DEFINE Delphi} {Delphi 3.x} + {$DEFINE Delphi32} + {$DEFINE WIN32} +{$ENDIF ver100} + +{$IFDEF ver93} + {$DEFINE Delphi} {C++ Builder 1.x} + {$DEFINE Delphi32} +{$ENDIF ver93} + +{$IFDEF ver110} + {$DEFINE Delphi} {C++ Builder 3.x} + {$DEFINE Delphi32} +{$ENDIF ver110} + +{$IFDEF ver120} + {$DEFINE Delphi} {Delphi 4.x} + {$DEFINE Delphi32} + {$DEFINE Has_Int64} +{$ENDIF ver120} + +{$IFDEF ver130} + {$DEFINE Delphi} {Delphi 5.x} + {$DEFINE Delphi32} + {$DEFINE Has_Int64} +{$ENDIF ver130} + +{$IFDEF ver140} + {$DEFINE Delphi} {Delphi 6.x} + {$DEFINE Delphi32} + {$DEFINE Has_Int64} +{$ENDIF ver140} + +{$IFDEF ver150} + {$DEFINE Delphi} {Delphi 7.x} + {$DEFINE Delphi32} + {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} + {$DEFINE Has_Int64} +{$ENDIF ver150} + +{$IFDEF ver160} + {$DEFINE Delphi} {Delphi 8??} + {$DEFINE Delphi32} + {$DEFINE Has_Int64} +{$ENDIF ver160} + +{$IFDEF ver170} + {$DEFINE Delphi} {Delphi 9??} + {$DEFINE Delphi32} + {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} + {$DEFINE Has_Int64} +{$ENDIF ver170} + +{$IFDEF UNIX} + {$ifdef VER150} + {$define KYLIX} + {$endif} + + {$ifdef VER140} + {$define KYLIX} + {$endif} + + {$ifdef VER140} + {$define KYLIX} + {$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} +{$ENDIF Delphi} + +{$IFDEF FPC} + {$MODE Delphi} { use Delphi compatibility mode } + {$H+} + {$PACKRECORDS 4} // Added for record + {$MACRO ON} // Added For OpenGL + {$THREADING on} + {$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} +{$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} diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas new file mode 100644 index 00000000..54841840 --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas @@ -0,0 +1,2690 @@ +(** +=============================================================================================== +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} + +{$ALIGN ON} + +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, // + deAttList : (ElemDef : TElemDef); // + deEntity : (EntityDef : TEntityDef); // + deNotation : (NotationDef : TNotationDef); // + dePI : (Target : PChar; // + Content : PChar; + AttrList : TAttrList); + deError : (Pos : PChar); // Error + // deComment : ((No additional fields here)); // + 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 '; + + // --- 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 " 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 '' if successful +BEGIN + Result := FALSE; + Clear; + FBufferSize := StrLen (Buffer) + 1; + TRY + GetMem (FBuffer, FBufferSize); + EXCEPT + Clear; + EXIT; + END; + StrCopy (FBuffer, Buffer); + FSource := ''; + Result := TRUE; +END; + + +PROCEDURE TXmlParser.SetBuffer (Buffer : PChar); // References another buffer +BEGIN + Clear; + FBuffer := Buffer; + FBufferSize := 0; + FSource := ''; +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, ''); + 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 ::= '' + markupdecl ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment + PEReference ::= '%' Name ';' + + elementdecl ::= '' + AttlistDecl ::= '' + EntityDecl ::= '' | + '' + NotationDecl ::= '' + PI ::= '' Char* )))? '?>' + Comment ::= '' *) +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 '' : 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, ' 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, ''); + + // --- 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 ' character + XmlSpec 3.2: + elementdecl ::= '' + 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 ' character + XmlSpec 3.3: + AttlistDecl ::= '' + 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: + *) +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 ' : 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 ' character + XmlSpec 4.2: + EntityDecl ::= '' | + '' + EntityDef ::= EntityValue | (ExternalID NDataDecl?) + PEDef ::= EntityValue | ExternalID + NDataDecl ::= S 'NDATA' S Name + EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"' | + "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'" + PEReference ::= '%' Name ';' + + Examples + + + + "> + + + Dies ist ein Test-Absatz

"> + *) +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 ' : 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 ' character + // XmlSpec 4.7: NotationDecl ::= '' +TYPE + TPhase = (phName, phExtId, phEnd); +VAR + ExternalID : TExternalID; + Phase : TPhase; + F : PChar; + NotationDef : TNotationDef; + DER : TDtdElementRec; +BEGIN + Final := Start + 10; // Character after ', + #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 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 +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 +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

+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
+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

+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 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 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 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 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 new file mode 100644 index 00000000..88bb1698 --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas @@ -0,0 +1,176 @@ +unit logger; +{ + $Id: logger.pas,v 1.1 2004/02/05 00:08:20 savage Exp $ + +} +{******************************************************************************} +{ } +{ Error Logging Unit } +{ } +{ The initial developer of this Pascal code was : } +{ Dominique Louis } +{ } +{ 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.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; +begin + FApplicationName := ExtractFileName( ParamStr(0) ); + FApplicationPath := ExtractFilePath( ParamStr(0) ); + AssignFile( FFileHandle, FApplicationPath + ChangeFileExt( FApplicationName, '.log' ) ); + 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 new file mode 100644 index 00000000..146e4b30 --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas @@ -0,0 +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 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 new file mode 100644 index 00000000..2d28a222 --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas @@ -0,0 +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 } +{ } +{ 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.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl.pas new file mode 100644 index 00000000..ad5d783a --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl.pas @@ -0,0 +1,4118 @@ +unit sdl; +{ + $Id: sdl.pas,v 1.17 2005/01/03 18:40:59 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ Conversion of the Simple DirectMedia Layer Headers } +{ } +{ Portions created by Sam Lantinga are } +{ Copyright (C) 1997-2004 Sam Lantinga } +{ 5635-34 Springhouse Dr. } +{ Pleasanton, CA 94588 (USA) } +{ } +{ All Rights Reserved. } +{ } +{ The original files are : SDL.h } +{ SDL_main.h } +{ SDL_types.h } +{ SDL_rwops.h } +{ SDL_timer.h } +{ SDL_audio.h } +{ SDL_cdrom.h } +{ SDL_joystick.h } +{ SDL_mouse.h } +{ SDL_keyboard.h } +{ SDL_events.h } +{ SDL_video.h } +{ SDL_byteorder.h } +{ SDL_version.h } +{ SDL_active.h } +{ SDL_thread.h } +{ SDL_mutex .h } +{ SDL_getenv.h } +{ SDL_loadso.h } +{ } +{ The initial developer of this Pascal code was : } +{ Dominqiue Louis } +{ } +{ Portions created by Dominqiue Louis are } +{ Copyright (C) 2000 - 2004 Dominqiue Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Tom Jones His Project inspired this conversion } +{ Matthias Thoma } +{ } +{ 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 } +{ ---------------- } +{ May 08 2001 - DL : Added Keyboard State Array ( See demos for how to } +{ use ) } +{ PKeyStateArr = ^TKeyStateArr; } +{ TKeyStateArr = array[0..65000] of UInt8; } +{ As most games will need it. } +{ } +{ April 02 2001 - DL : Added SDL_getenv.h definitions and tested version } +{ 1.2.0 compatability. } +{ } +{ March 13 2001 - MT : Added Linux compatibility. } +{ } +{ March 10 2001 - MT : Added externalsyms for DEFINES } +{ Changed the license header } +{ } +{ March 09 2001 - MT : Added Kylix Ifdefs/Deleted the uses mmsystem } +{ } +{ March 01 2001 - DL : Update conversion of version 1.1.8 } +{ } +{ July 22 2001 - DL : Added TUInt8Array and PUIntArray after suggestions } +{ from Matthias Thoma and Eric Grange. } +{ } +{ October 12 2001 - DL : Various changes as suggested by Matthias Thoma and } +{ David Acklam } +{ } +{ October 24 2001 - DL : Added FreePascal support as per suggestions from } +{ Dean Ellis. } +{ } +{ October 27 2001 - DL : Added SDL_BUTTON macro } +{ } +{ November 08 2001 - DL : Bug fix as pointed out by Puthoon. } +{ } +{ November 29 2001 - DL : Bug fix of SDL_SetGammaRamp as pointed out by Simon} +{ Rushton. } +{ } +{ November 30 2001 - DL : SDL_NOFRAME added as pointed out by Simon Rushton. } +{ } +{ December 11 2001 - DL : Added $WEAKPACKAGEUNIT ON to facilitate useage in } +{ Components } +{ } +{ January 05 2002 - DL : Added SDL_Swap32 function as suggested by Matthias } +{ Thoma and also made sure the _getenv from } +{ MSVCRT.DLL uses the right calling convention } +{ } +{ January 25 2002 - DL : Updated conversion of SDL_AddTimer & } +{ SDL_RemoveTimer as per suggestions from Matthias } +{ Thoma. } +{ } +{ January 27 2002 - DL : Commented out exported function putenv and getenv } +{ So that developers get used to using SDL_putenv } +{ SDL_getenv, as they are more portable } +{ } +{ March 05 2002 - DL : Added FreeAnNil procedure for Delphi 4 users. } +{ } +{ October 23 2002 - DL : Added Delphi 3 Define of Win32. } +{ If you intend to you Delphi 3... } +{ ( which is officially unsupported ) make sure you } +{ remove references to $EXTERNALSYM in this and other} +{ SDL files. } +{ } +{ November 29 2002 - DL : Fixed bug in Declaration of SDL_GetRGBA that was } +{ pointed out by Todd Lang } +{ } +{ April 03 2003 - DL : Added jedi-sdl.inc include file to support more } +{ Pascal compilers. Initial support is now included } +{ for GnuPascal, VirtualPascal, TMT and obviously } +{ continue support for Delphi Kylix and FreePascal. } +{ } +{ April 08 2003 - MK : Aka Mr Kroket - Added Better FPC support } +{ } +{ April 24 2003 - 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 } +{ } +{ April 30 2003 - DL : under instruction from David Mears AKA } +{ Jason Siletto, I have added FPC Linux support. } +{ This was compiled with fpc 1.1, so remember to set } +{ include file path. ie. -Fi/usr/share/fpcsrc/rtl/* } +{ } +{ + $Log: sdl.pas,v $ + Revision 1.17 2005/01/03 18:40:59 savage + Updated Version number to reflect latest one + + Revision 1.16 2005/01/01 02:02:06 savage + Updated to v1.2.8 + + Revision 1.15 2004/12/24 18:57:11 savage + forgot to apply Michalis Kamburelis' patch to the implementation section. now fixed + + Revision 1.14 2004/12/23 23:42:18 savage + Applied Patches supplied by Michalis Kamburelis ( THANKS! ), for greater FreePascal compatability. + + Revision 1.13 2004/09/30 22:31:59 savage + Updated with slightly different header comments + + Revision 1.12 2004/09/12 21:52:58 savage + Slight changes to fix some issues with the sdl classes. + + Revision 1.11 2004/08/14 22:54:30 savage + Updated so that Library name defines are correctly defined for MacOS X. + + Revision 1.10 2004/07/20 23:57:33 savage + Thanks to Paul Toth for spotting an error in the SDL Audio Convertion structures. + In TSDL_AudioCVT the filters variable should point to and array of pointers and not what I had there previously. + + Revision 1.9 2004/07/03 22:07:22 savage + Added Bitwise Manipulation Functions for TSDL_VideoInfo struct. + + Revision 1.8 2004/05/10 14:10:03 savage + Initial MacOS X support. Fixed defines for MACOS ( Classic ) and DARWIN ( MacOS X ). + + Revision 1.7 2004/04/13 09:32:08 savage + Changed Shared object names back to just the .so extension to avoid conflicts on various Linux/Unix distros. Therefore developers will need to create Symbolic links to the actual Share Objects if necessary. + + Revision 1.6 2004/04/01 20:53:23 savage + Changed Linux Shared Object names so they reflect the Symbolic Links that are created when installing the RPMs from the SDL site. + + Revision 1.5 2004/02/22 15:32:10 savage + SDL_GetEnv Fix so it also works on FPC/Linux. Thanks to Rodrigo for pointing this out. + + Revision 1.4 2004/02/21 23:24:29 savage + SDL_GetEnv Fix so that it is not define twice for FPC. Thanks to Rene Hugentobler for pointing out this bug, + + Revision 1.3 2004/02/18 22:35:51 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. + + Revision 1.2 2004/02/17 21:37:12 savage + Tidying up of units + + Revision 1.1 2004/02/05 00:08:20 savage + Module 1.0 release + +} +{******************************************************************************} + +{$I jedi-sdl.inc} + +{$ALIGN ON} + +interface + +uses +{$IFDEF __GPC__} + system, + gpc; +{$ENDIF} + +{$IFDEF WIN32} + {$IFNDEF __GPC__} + Windows; + {$ENDIF} +{$ENDIF} + +{$IFDEF UNIX} + {$IFDEF FPC} + {$IFDEF Ver1_0} + linux, + {$ELSE} + pthreads, + baseunix, + unix, + {$ENDIF} + x, + xlib; + {$ELSE} + Types, + Libc, + Xlib; + {$ENDIF} +{$ENDIF} + +{$IFDEF __MACH__} + GPCMacOSAll; +{$ENDIF} + +const +{$IFDEF WIN32} + SDLLibName = 'SDL.dll'; +{$ENDIF} + +{$IFDEF UNIX} +{$IFDEF DARWIN} + SDLLibName = 'libSDL.dylib'; +{$ELSE} + SDLLibName = 'libSDL.so'; +{$ENDIF} +{$ENDIF} + +{$IFDEF MACOS} + SDLLibName = 'SDL'; +{$ENDIF} + + // SDL.h constants + SDL_INIT_TIMER = $00000001; +{$EXTERNALSYM SDL_INIT_TIMER} + SDL_INIT_AUDIO = $00000010; +{$EXTERNALSYM SDL_INIT_AUDIO} + SDL_INIT_VIDEO = $00000020; +{$EXTERNALSYM SDL_INIT_VIDEO} + SDL_INIT_CDROM = $00000100; +{$EXTERNALSYM SDL_INIT_CDROM} + SDL_INIT_JOYSTICK = $00000200; +{$EXTERNALSYM SDL_INIT_JOYSTICK} + SDL_INIT_NOPARACHUTE = $00100000; // Don't catch fatal signals +{$EXTERNALSYM SDL_INIT_NOPARACHUTE} + SDL_INIT_EVENTTHREAD = $01000000; // Not supported on all OS's +{$EXTERNALSYM SDL_INIT_EVENTTHREAD} + SDL_INIT_EVERYTHING = $0000FFFF; +{$EXTERNALSYM SDL_INIT_EVERYTHING} + + // SDL_error.h constants + ERR_MAX_STRLEN = 128; +{$EXTERNALSYM ERR_MAX_STRLEN} + ERR_MAX_ARGS = 5; +{$EXTERNALSYM ERR_MAX_ARGS} + + // SDL_types.h constants + SDL_PRESSED = $01; +{$EXTERNALSYM SDL_PRESSED} + SDL_RELEASED = $00; +{$EXTERNALSYM SDL_RELEASED} + + // SDL_timer.h constants + // This is the OS scheduler timeslice, in milliseconds + SDL_TIMESLICE = 10; +{$EXTERNALSYM SDL_TIMESLICE} + // This is the maximum resolution of the SDL timer on all platforms + TIMER_RESOLUTION = 10; // Experimentally determined +{$EXTERNALSYM TIMER_RESOLUTION} + + // SDL_audio.h constants + AUDIO_U8 = $0008; // Unsigned 8-bit samples +{$EXTERNALSYM AUDIO_U8} + AUDIO_S8 = $8008; // Signed 8-bit samples +{$EXTERNALSYM AUDIO_S8} + AUDIO_U16LSB = $0010; // Unsigned 16-bit samples +{$EXTERNALSYM AUDIO_U16LSB} + AUDIO_S16LSB = $8010; // Signed 16-bit samples +{$EXTERNALSYM AUDIO_S16LSB} + AUDIO_U16MSB = $1010; // As above, but big-endian byte order +{$EXTERNALSYM AUDIO_U16MSB} + AUDIO_S16MSB = $9010; // As above, but big-endian byte order +{$EXTERNALSYM AUDIO_S16MSB} + AUDIO_U16 = AUDIO_U16LSB; +{$EXTERNALSYM AUDIO_U16} + AUDIO_S16 = AUDIO_S16LSB; +{$EXTERNALSYM AUDIO_S16} + + + // SDL_cdrom.h constants + // The maximum number of CD-ROM tracks on a disk + SDL_MAX_TRACKS = 99; +{$EXTERNALSYM SDL_MAX_TRACKS} + // The types of CD-ROM track possible + SDL_AUDIO_TRACK = $00; +{$EXTERNALSYM SDL_AUDIO_TRACK} + SDL_DATA_TRACK = $04; +{$EXTERNALSYM SDL_DATA_TRACK} + + // Conversion functions from frames to Minute/Second/Frames and vice versa + CD_FPS = 75; +{$EXTERNALSYM CD_FPS} + // SDL_byteorder.h constants + // The two types of endianness + SDL_LIL_ENDIAN = 1234; +{$EXTERNALSYM SDL_LIL_ENDIAN} + SDL_BIG_ENDIAN = 4321; +{$EXTERNALSYM SDL_BIG_ENDIAN} + +{$IFDEF IA32} + + SDL_BYTEORDER = SDL_LIL_ENDIAN; +{$EXTERNALSYM SDL_BYTEORDER} + // Native audio byte ordering + AUDIO_U16SYS = AUDIO_U16LSB; +{$EXTERNALSYM AUDIO_U16SYS} + AUDIO_S16SYS = AUDIO_S16LSB; +{$EXTERNALSYM AUDIO_S16SYS} + +{$ELSE} + + SDL_BYTEORDER = SDL_BIG_ENDIAN; +{$EXTERNALSYM SDL_BYTEORDER} + // Native audio byte ordering + AUDIO_U16SYS = AUDIO_U16MSB; +{$EXTERNALSYM AUDIO_U16SYS} + AUDIO_S16SYS = AUDIO_S16MSB; +{$EXTERNALSYM AUDIO_S16SYS} + +{$ENDIF} + + + SDL_MIX_MAXVOLUME = 128; +{$EXTERNALSYM SDL_MIX_MAXVOLUME} + + // SDL_joystick.h constants + MAX_JOYSTICKS = 2; // only 2 are supported in the multimedia API +{$EXTERNALSYM MAX_JOYSTICKS} + MAX_AXES = 6; // each joystick can have up to 6 axes +{$EXTERNALSYM MAX_AXES} + MAX_BUTTONS = 32; // and 32 buttons +{$EXTERNALSYM MAX_BUTTONS} + AXIS_MIN = -32768; // minimum value for axis coordinate +{$EXTERNALSYM AXIS_MIN} + AXIS_MAX = 32767; // maximum value for axis coordinate +{$EXTERNALSYM AXIS_MAX} + JOY_AXIS_THRESHOLD = (((AXIS_MAX) - (AXIS_MIN)) / 100); // 1% motion +{$EXTERNALSYM JOY_AXIS_THRESHOLD} + //JOY_BUTTON_FLAG(n) (1< } + + { Function prototype for the new timer callback function. + The callback function is passed the current timer interval and returns + the next timer interval. If the returned value is the same as the one + passed in, the periodic alarm continues, otherwise a new alarm is + scheduled. If the callback returns 0, the periodic alarm is cancelled. } + {$IFNDEF __GPC__} + TSDL_NewTimerCallback = function( interval: UInt32; param: Pointer ): UInt32; cdecl; + {$ELSE} + TSDL_NewTimerCallback = function( interval: UInt32; param: Pointer ): UInt32; + {$ENDIF} + + // Definition of the timer ID type + PSDL_TimerID = ^TSDL_TimerID; + TSDL_TimerID = record + interval: UInt32; + callback: TSDL_NewTimerCallback; + param: Pointer; + last_alarm: UInt32; + next: PSDL_TimerID; + end; + + {$IFNDEF __GPC__} + TSDL_AudioSpecCallback = procedure( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl; + {$ELSE} + TSDL_AudioSpecCallback = procedure( userdata: Pointer; stream: PUInt8; len: Integer ); + {$ENDIF} + + // SDL_audio.h types + // The calculated values in this structure are calculated by SDL_OpenAudio() + PSDL_AudioSpec = ^TSDL_AudioSpec; + TSDL_AudioSpec = record + freq: Integer; // DSP frequency -- samples per second + format: UInt16; // Audio data format + channels: UInt8; // Number of channels: 1 mono, 2 stereo + silence: UInt8; // Audio buffer silence value (calculated) + samples: UInt16; // Audio buffer size in samples + padding: UInt16; // Necessary for some compile environments + size: UInt32; // Audio buffer size in bytes (calculated) + { This function is called when the audio device needs more data. + 'stream' is a pointer to the audio data buffer + 'len' is the length of that buffer in bytes. + Once the callback returns, the buffer will no longer be valid. + Stereo samples are stored in a LRLRLR ordering.} + callback: TSDL_AudioSpecCallback; + userdata: Pointer; + end; + + // A structure to hold a set of audio conversion filters and buffers + PSDL_AudioCVT = ^TSDL_AudioCVT; + + PSDL_AudioCVTFilter = ^TSDL_AudioCVTFilter; + TSDL_AudioCVTFilter = record + cvt: PSDL_AudioCVT; + format: UInt16; + end; + + PSDL_AudioCVTFilterArray = ^TSDL_AudioCVTFilterArray; + TSDL_AudioCVTFilterArray = array[0..9] of PSDL_AudioCVTFilter; + + TSDL_AudioCVT = record + needed: Integer; // Set to 1 if conversion possible + src_format: UInt16; // Source audio format + dst_format: UInt16; // Target audio format + rate_incr: double; // Rate conversion increment + buf: PUInt8; // Buffer to hold entire audio data + len: Integer; // Length of original audio buffer + len_cvt: Integer; // Length of converted audio buffer + len_mult: Integer; // buffer must be len*len_mult big + len_ratio: double; // Given len, final size is len*len_ratio + filters: TSDL_AudioCVTFilterArray; + filter_index: Integer; // Current audio conversion function + end; + + TSDL_Audiostatus = ( + SDL_AUDIO_STOPPED, + SDL_AUDIO_PLAYING, + SDL_AUDIO_PAUSED + ); + + // SDL_cdrom.h types + TSDL_CDStatus = ( + CD_ERROR, + CD_TRAYEMPTY, + CD_STOPPED, + CD_PLAYING, + CD_PAUSED ); + + PSDL_CDTrack = ^TSDL_CDTrack; + TSDL_CDTrack = record + id: UInt8; // Track number + type_: UInt8; // Data or audio track + unused: UInt16; + length: UInt32; // Length, in frames, of this track + offset: UInt32; // Offset, in frames, from start of disk + end; + + // This structure is only current as of the last call to SDL_CDStatus() + PSDL_CD = ^TSDL_CD; + TSDL_CD = record + id: Integer; // Private drive identifier + status: TSDL_CDStatus; // Current drive status + + // The rest of this structure is only valid if there's a CD in drive + numtracks: Integer; // Number of tracks on disk + cur_track: Integer; // Current track position + cur_frame: Integer; // Current frame offset within current track + track: array[0..SDL_MAX_TRACKS] of TSDL_CDTrack; + end; + + //SDL_joystick.h types + PTransAxis = ^TTransAxis; + TTransAxis = record + offset: Integer; + scale: single; + end; + + // The private structure used to keep track of a joystick + PJoystick_hwdata = ^TJoystick_hwdata; + TJoystick_hwdata = record + // joystick ID + id: Integer; + // values used to translate device-specific coordinates into SDL-standard ranges + transaxis: array[0..5] of TTransAxis; + end; + + PBallDelta = ^TBallDelta; + TBallDelta = record + dx: Integer; + dy: Integer; + end; // Current ball motion deltas + + // The SDL joystick structure + PSDL_Joystick = ^TSDL_Joystick; + TSDL_Joystick = record + index: UInt8; // Device index + name: PChar; // Joystick name - system dependent + + naxes: Integer; // Number of axis controls on the joystick + axes: PUInt16; // Current axis states + + nhats: Integer; // Number of hats on the joystick + hats: PUInt8; // Current hat states + + nballs: Integer; // Number of trackballs on the joystick + balls: PBallDelta; // Current ball motion deltas + + nbuttons: Integer; // Number of buttons on the joystick + buttons: PUInt8; // Current button states + + hwdata: PJoystick_hwdata; // Driver dependent information + + ref_count: Integer; // Reference count for multiple opens + end; + + // SDL_verion.h types + PSDL_version = ^TSDL_version; + TSDL_version = record + major: UInt8; + minor: UInt8; + patch: UInt8; + end; + + // SDL_keyboard.h types + TSDLKey = LongWord; + + TSDLMod = LongWord; + + PSDL_KeySym = ^TSDL_KeySym; + TSDL_KeySym = record + scancode: UInt8; // hardware specific scancode + sym: TSDLKey; // SDL virtual keysym + modifier: TSDLMod; // current key modifiers + unicode: UInt16; // translated character + end; + + // SDL_events.h types + {Checks the event queue for messages and optionally returns them. + If 'action' is SDL_ADDEVENT, up to 'numevents' events will be added to + the back of the event queue. + If 'action' is SDL_PEEKEVENT, up to 'numevents' events at the front + of the event queue, matching 'mask', will be returned and will not + be removed from the queue. + If 'action' is SDL_GETEVENT, up to 'numevents' events at the front + of the event queue, matching 'mask', will be returned and will be + removed from the queue. + This function returns the number of events actually stored, or -1 + if there was an error. This function is thread-safe. } + + TSDL_EventAction = (SDL_ADDEVENT, SDL_PEEKEVENT, SDL_GETEVENT); + + // Application visibility event structure + TSDL_ActiveEvent = record + type_: UInt8; // SDL_ACTIVEEVENT + gain: UInt8; // Whether given states were gained or lost (1/0) + state: UInt8; // A mask of the focus states + end; + + // Keyboard event structure + TSDL_KeyboardEvent = record + type_: UInt8; // SDL_KEYDOWN or SDL_KEYUP + which: UInt8; // The keyboard device index + state: UInt8; // SDL_PRESSED or SDL_RELEASED + keysym: TSDL_KeySym; + end; + + // Mouse motion event structure + TSDL_MouseMotionEvent = record + type_: UInt8; // SDL_MOUSEMOTION + which: UInt8; // The mouse device index + state: UInt8; // The current button state + x, y: UInt16; // The X/Y coordinates of the mouse + xrel: SInt16; // The relative motion in the X direction + yrel: SInt16; // The relative motion in the Y direction + end; + + // Mouse button event structure + TSDL_MouseButtonEvent = record + type_: UInt8; // SDL_MOUSEBUTTONDOWN or SDL_MOUSEBUTTONUP + which: UInt8; // The mouse device index + button: UInt8; // The mouse button index + state: UInt8; // SDL_PRESSED or SDL_RELEASED + x: UInt16; // The X coordinates of the mouse at press time + y: UInt16; // The Y coordinates of the mouse at press time + end; + + // Joystick axis motion event structure + TSDL_JoyAxisEvent = record + type_: UInt8; // SDL_JOYAXISMOTION + which: UInt8; // The joystick device index + axis: UInt8; // The joystick axis index + value: SInt16; // The axis value (range: -32768 to 32767) + end; + + // Joystick trackball motion event structure + TSDL_JoyBallEvent = record + type_: UInt8; // SDL_JOYAVBALLMOTION + which: UInt8; // The joystick device index + ball: UInt8; // The joystick trackball index + xrel: SInt16; // The relative motion in the X direction + yrel: SInt16; // The relative motion in the Y direction + end; + + // Joystick hat position change event structure + TSDL_JoyHatEvent = record + type_: UInt8; // SDL_JOYHATMOTION */ + which: UInt8; // The joystick device index */ + hat: UInt8; // The joystick hat index */ + value: UInt8; { The hat position value: + 8 1 2 + 7 0 3 + 6 5 4 + + Note that zero means the POV is centered. } + + end; + + // Joystick button event structure + TSDL_JoyButtonEvent = record + type_: UInt8; // SDL_JOYBUTTONDOWN or SDL_JOYBUTTONUP + which: UInt8; // The joystick device index + button: UInt8; // The joystick button index + state: UInt8; // SDL_PRESSED or SDL_RELEASED + end; + + { The "window resized" event + When you get this event, you are responsible for setting a new video + mode with the new width and height. } + TSDL_ResizeEvent = record + type_: UInt8; // SDL_VIDEORESIZE + w: Integer; // New width + h: Integer; // New height + end; + + // The "quit requested" event + PSDL_QuitEvent = ^TSDL_QuitEvent; + TSDL_QuitEvent = record + type_: UInt8; + end; + + // A user-defined event type + PSDL_UserEvent = ^TSDL_UserEvent; + TSDL_UserEvent = record + type_: UInt8; // SDL_USEREVENT through SDL_NUMEVENTS-1 + code: Integer; // User defined event code */ + data1: Pointer; // User defined data pointer */ + data2: Pointer; // User defined data pointer */ + end; + + // The "screen redraw" event + PSDL_ExposeEvent = ^TSDL_ExposeEvent; + TSDL_ExposeEvent = record + type_ : Uint8; // SDL_VIDEOEXPOSE + end; + + {$IFDEF Unix} + //These are the various supported subsystems under UNIX + TSDL_SysWm = ( SDL_SYSWM_X11 ) ; + {$ENDIF} + +// The windows custom event structure +{$IFDEF Win32} + PSDL_SysWMmsg = ^TSDL_SysWMmsg; + TSDL_SysWMmsg = record + version: TSDL_version; + h_wnd: HWND; // The window for the message + msg: UInt; // The type of message + w_Param: WPARAM; // WORD message parameter + lParam: LPARAM; // LONG message parameter + end; +{$ELSE} + +{$IFDEF Unix} +{ The Linux custom event structure } + PSDL_SysWMmsg = ^TSDL_SysWMmsg; + TSDL_SysWMmsg = record + version : TSDL_version; + subsystem : TSDL_SysWm; + {$IFDEF FPC} + event : TXEvent; + {$ELSE} + event : XEvent; + {$ENDIF} + end; +{$ELSE} +{ The generic custom event structure } + PSDL_SysWMmsg = ^TSDL_SysWMmsg; + TSDL_SysWMmsg = record + version: TSDL_version; + data: Integer; + end; +{$ENDIF} + +{$ENDIF} + +// The Windows custom window manager information structure +{$IFDEF Win32} + PSDL_SysWMinfo = ^TSDL_SysWMinfo; + TSDL_SysWMinfo = record + version : TSDL_version; + window : HWnd; // The display window + end; +{$ELSE} + +// The Linux custom window manager information structure +{$IFDEF Unix} + TX11 = record + display : PDisplay; // The X11 display + window : TWindow ; // The X11 display window */ + {* These locking functions should be called around + any X11 functions using the display variable. + They lock the event thread, so should not be + called around event functions or from event filters. + *} + lock_func : Pointer; + unlock_func : Pointer; + + // Introduced in SDL 1.0.2 + fswindow : TWindow ; // The X11 fullscreen window */ + wmwindow : TWindow ; // The X11 managed input window */ + end; + + PSDL_SysWMinfo = ^TSDL_SysWMinfo; + TSDL_SysWMinfo = record + version : TSDL_version ; + subsystem : TSDL_SysWm; + X11 : TX11; + end; +{$ELSE} + // The generic custom window manager information structure + PSDL_SysWMinfo = ^TSDL_SysWMinfo; + TSDL_SysWMinfo = record + version : TSDL_version ; + data : integer; + end; +{$ENDIF} + +{$ENDIF} + + PSDL_SysWMEvent = ^TSDL_SysWMEvent; + TSDL_SysWMEvent = record + type_: UInt8; + msg: PSDL_SysWMmsg; + end; + + PSDL_Event = ^TSDL_Event; + TSDL_Event = record + case UInt8 of + SDL_NOEVENT: (type_: byte); + SDL_ACTIVEEVENT: (active: TSDL_ActiveEvent); + SDL_KEYDOWN, SDL_KEYUP: (key: TSDL_KeyboardEvent); + SDL_MOUSEMOTION: (motion: TSDL_MouseMotionEvent); + SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP: (button: TSDL_MouseButtonEvent ); + SDL_JOYAXISMOTION: (jaxis: TSDL_JoyAxisEvent ); + SDL_JOYBALLMOTION: (jball: TSDL_JoyBallEvent ); + SDL_JOYHATMOTION: (jhat: TSDL_JoyHatEvent ); + SDL_JOYBUTTONDOWN, SDL_JOYBUTTONUP: (jbutton: TSDL_JoyButtonEvent ); + SDL_VIDEORESIZE: (resize: TSDL_ResizeEvent ); + SDL_QUITEV: (quit: TSDL_QuitEvent ); + SDL_USEREVENT : ( user : TSDL_UserEvent ); + SDL_SYSWMEVENT: (syswm: TSDL_SysWMEvent ); + end; + + +{ This function sets up a filter to process all events before they + change internal state and are posted to the internal event queue. + + The filter is protypted as: } + {$IFNDEF __GPC__} + TSDL_EventFilter = function( event : PSDL_Event ): Integer; cdecl; + {$ELSE} + TSDL_EventFilter = function( event : PSDL_Event ): Integer; + {$ENDIF} + + // SDL_video.h types + // Useful data types + PPSDL_Rect = ^PSDL_Rect; + PSDL_Rect = ^TSDL_Rect; + TSDL_Rect = record + x, y: SInt16; + w, h: UInt16; + end; + + SDL_Rect = TSDL_Rect; +{$EXTERNALSYM SDL_Rect} + + PSDL_Color = ^TSDL_Color; + TSDL_Color = record + r: UInt8; + g: UInt8; + b: UInt8; + unused: UInt8; + end; + + PSDL_ColorArray = ^TSDL_ColorArray; + TSDL_ColorArray = array[0..65000] of TSDL_Color; + + PSDL_Palette = ^TSDL_Palette; + TSDL_Palette = record + ncolors: Integer; + colors: PSDL_ColorArray; + end; + + // Everything in the pixel format structure is read-only + PSDL_PixelFormat = ^TSDL_PixelFormat; + TSDL_PixelFormat = record + palette: PSDL_Palette; + BitsPerPixel: UInt8; + BytesPerPixel: UInt8; + Rloss: UInt8; + Gloss: UInt8; + Bloss: UInt8; + Aloss: UInt8; + Rshift: UInt8; + Gshift: UInt8; + Bshift: UInt8; + Ashift: UInt8; + RMask: UInt32; + GMask: UInt32; + BMask: UInt32; + AMask: UInt32; + colorkey: UInt32; // RGB color key information + alpha: UInt8; // Alpha value information (per-surface alpha) + end; + +{$IFDEF WIN32} + {PPrivate_hwdata = ^TPrivate_hwdata; + TPrivate_hwdata = record + dd_surface : IDIRECTDRAWSURFACE3; + dd_writebuf : IDIRECTDRAWSURFACE3; + end;} + {ELSE} +{$ENDIF} + + // The structure passed to the low level blit functions + PSDL_BlitInfo = ^TSDL_BlitInfo; + TSDL_BlitInfo = record + s_pixels: PUInt8; + s_width: Integer; + s_height: Integer; + s_skip: Integer; + d_pixels: PUInt8; + d_width: Integer; + d_height: Integer; + d_skip: Integer; + aux_data: Pointer; + src: PSDL_PixelFormat; + table: PUInt8; + dst: PSDL_PixelFormat; + end; + + // typedef for private surface blitting functions + PSDL_Surface = ^TSDL_Surface; + + {$IFNDEF __GPC__} + TSDL_Blit = function( src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect ): Integer; cdecl; + {$ELSE} + TSDL_Blit = function( src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect ): Integer; + {$ENDIF} + + // The type definition for the low level blit functions + //TSDL_LoBlit = procedure( info : PSDL_BlitInfo ); cdecl; + + // This is the private info structure for software accelerated blits + {PPrivate_swaccel = ^TPrivate_swaccel; + TPrivate_swaccel = record + blit : TSDL_LoBlit; + aux_data : Pointer; + end;} + + // Blit mapping definition + {PSDL_BlitMap = ^TSDL_BlitMap; + TSDL_BlitMap = record + dst : PSDL_Surface; + identity : Integer; + table : PUInt8; + hw_blit : TSDL_Blit; + sw_blit : TSDL_Blit; + hw_data : PPrivate_hwaccel; + sw_data : PPrivate_swaccel; + + // the version count matches the destination; mismatch indicates an invalid mapping + format_version : Cardinal; + end;} + + TSDL_Surface = record + flags: UInt32; // Read-only + format: PSDL_PixelFormat; // Read-only + w, h: Integer; // Read-only + pitch: UInt16; // Read-only + pixels: Pointer; // Read-write + offset: Integer; // Private + hwdata: Pointer; //TPrivate_hwdata; Hardware-specific surface info + + // clipping information: + clip_rect: TSDL_Rect; // Read-only + unused1: UInt32; // for binary compatibility + // Allow recursive locks + locked: UInt32; // Private + // info for fast blit mapping to other surfaces + Blitmap: Pointer; // PSDL_BlitMap; // Private + // format version, bumped at every change to invalidate blit maps + format_version: Cardinal; // Private + refcount: Integer; + end; + + // Useful for determining the video hardware capabilities + PSDL_VideoInfo = ^TSDL_VideoInfo; + TSDL_VideoInfo = record + hw_available: UInt8; // Hardware and WindowManager flags in first 2 bits ( see below ) + {hw_available: 1; // Can you create hardware surfaces + wm_available: 1; // Can you talk to a window manager? + UnusedBits1: 6;} + blit_hw: UInt8; // Blit Hardware flags. See below for which bits do what + {UnusedBits2: 1; + blit_hw: 1; // Flag:UInt32 Accelerated blits HW --> HW + blit_hw_CC: 1; // Flag:UInt32 Accelerated blits with Colorkey + blit_hw_A: 1; // Flag:UInt32 Accelerated blits with Alpha + blit_sw: 1; // Flag:UInt32 Accelerated blits SW --> HW + blit_sw_CC: 1; // Flag:UInt32 Accelerated blits with Colorkey + blit_sw_A: 1; // Flag:UInt32 Accelerated blits with Alpha + blit_fill: 1; // Flag:UInt32 Accelerated color fill} + UnusedBits3: UInt8; // Unused at this point + video_mem: UInt32; // The total amount of video memory (in K) + vfmt: PSDL_PixelFormat; // Value: The format of the video surface + end; + + // The YUV hardware video overlay + PSDL_Overlay = ^TSDL_Overlay; + TSDL_Overlay = record + format: UInt32; // Overlay format + w, h: Integer; // Width and height of overlay + planes: Integer; // Number of planes in the overlay. Usually either 1 or 3 + pitches: PUInt16; + // An array of pitches, one for each plane. Pitch is the length of a row in bytes. + pixels: PUInt8; + // An array of pointers to teh data of each plane. The overlay should be locked before these pointers are used. + hw_overlay: UInt32; + // This will be set to 1 if the overlay is hardware accelerated. + end; + + // Public enumeration for setting the OpenGL window attributes. + TSDL_GLAttr = ( + SDL_GL_RED_SIZE, + SDL_GL_GREEN_SIZE, + SDL_GL_BLUE_SIZE, + SDL_GL_ALPHA_SIZE, + SDL_GL_BUFFER_SIZE, + SDL_GL_DOUBLEBUFFER, + SDL_GL_DEPTH_SIZE, + SDL_GL_STENCIL_SIZE, + SDL_GL_ACCUM_RED_SIZE, + SDL_GL_ACCUM_GREEN_SIZE, + SDL_GL_ACCUM_BLUE_SIZE, + SDL_GL_ACCUM_ALPHA_SIZE, + SDL_GL_STEREO, + SDL_GL_MULTISAMPLEBUFFERS, + SDL_GL_MULTISAMPLESAMPLES); + + + + PSDL_Cursor = ^TSDL_Cursor; + TSDL_Cursor = record + area: TSDL_Rect; // The area of the mouse cursor + hot_x, hot_y: SInt16; // The "tip" of the cursor + data: PUInt8; // B/W cursor data + mask: PUInt8; // B/W cursor mask + save: array[1..2] of PUInt8; // Place to save cursor area + wm_cursor: Pointer; // Window-manager cursor + end; + +// SDL_mutex.h types + +{$IFDEF WIN32} + PSDL_Mutex = ^TSDL_Mutex; + TSDL_Mutex = record + id: THANDLE; + end; +{$ENDIF} + +{$IFDEF Unix} + PSDL_Mutex = ^TSDL_Mutex; + TSDL_mutex = record + id: pthread_mutex_t; +{$IFDEF PTHREAD_NO_RECURSIVE_MUTEX} + recursive: Integer; + owner: pthread_t; +{$ENDIF} + end; +{$ENDIF} + +{$IFDEF __MACH__} + {$define USE_NAMED_SEMAPHORES} + // Broken sem_getvalue() in MacOS X Public Beta */ + {$define BROKEN_SEMGETVALUE} +{$ENDIF} + +PSDL_semaphore = ^TSDL_semaphore; +{$IFDEF WIN32} + // Win32 or Machintosh + TSDL_semaphore = record + id: THANDLE; + count: UInt32; + end; +{$ELSE} + {$IFDEF FPC} + // This should be semaphore.h + __sem_lock_t = {packed} record { Not in header file - anonymous } + status: Longint; + spinlock: Integer; + end; + + sem_t = {packed} record + __sem_lock: __sem_lock_t; + __sem_value: Integer; + __sem_waiting: longint ; {_pthread_queue;} + end; + {$ENDIF} + + TSDL_semaphore = record + sem: Pointer; //PSem_t; + {$IFNDEF USE_NAMED_SEMAPHORES} + sem_data: Sem_t; + {$ENDIF} + + {$IFDEF BROKEN_SEMGETVALUE} + { This is a little hack for MacOS X - + It's not thread-safe, but it's better than nothing } + sem_value: Integer; + {$ENDIF} + end; +{$ENDIF} + + PSDL_Sem = ^TSDL_Sem; + TSDL_Sem = TSDL_Semaphore; + + PSDL_Cond = ^TSDL_Cond; + TSDL_Cond = record +{$IFDEF Unix} + cond: pthread_cond_t; +{$ELSE} + // Generic Cond structure + lock: PSDL_mutex; + waiting: Integer; + signals: Integer; + wait_sem: PSDL_Sem; + wait_done: PSDL_Sem; +{$ENDIF} + end; + + // SDL_thread.h types +{$IFDEF WIN32} + TSYS_ThreadHandle = THandle; +{$ENDIF} + +{$IFDEF Unix} + TSYS_ThreadHandle = pthread_t; +{$ENDIF} + + { This is the system-independent thread info structure } + PSDL_Thread = ^TSDL_Thread; + TSDL_Thread = record + threadid: UInt32; + handle: TSYS_ThreadHandle; + status: Integer; + errbuf: TSDL_Error; + data: Pointer; + end; + + // Helper Types + + // Keyboard State Array ( See demos for how to use ) + PKeyStateArr = ^TKeyStateArr; + TKeyStateArr = array[0..65000] of UInt8; + + // Types required so we don't need to use Windows.pas + PInteger = ^Integer; + PByte = ^Byte; + PWord = ^Word; + PLongWord = ^Longword; + + // General arrays + PByteArray = ^TByteArray; + TByteArray = array[0..32767] of Byte; + + PWordArray = ^TWordArray; + TWordArray = array[0..16383] of Word; + + PPoint = ^TPoint; + TPoint = record + x: Longint; + y: Longint; + end; + + PRect = ^TRect; + TRect = record + case Integer of + 0: (Left, Top, Right, Bottom: Integer); + 1: (TopLeft, BottomRight: TPoint); + end; + + { Generic procedure pointer } + TProcedure = procedure; + +{------------------------------------------------------------------------------} +{ initialization } +{------------------------------------------------------------------------------} + +{ This function loads the SDL dynamically linked library and initializes + the subsystems specified by 'flags' (and those satisfying dependencies) + Unless the SDL_INIT_NOPARACHUTE flag is set, it will install cleanup + signal handlers for some commonly ignored fatal signals (like SIGSEGV) } + +function SDL_Init( flags : UInt32 ) : Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_Init} + +// This function initializes specific SDL subsystems +function SDL_InitSubSystem( flags : UInt32 ) : Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_InitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_InitSubSystem} + +// This function cleans up specific SDL subsystems +procedure SDL_QuitSubSystem( flags : UInt32 ); +cdecl; external {$IFDEF __GPC__}name 'SDL_QuitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_QuitSubSystem} + +{ This function returns mask of the specified subsystems which have + been initialized. + If 'flags' is 0, it returns a mask of all initialized subsystems. } + +function SDL_WasInit( flags : UInt32 ): UInt32; +cdecl; external {$IFDEF __GPC__}name 'SDL_WasInit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WasInit} + +{ This function cleans up all initialized subsystems and unloads the + dynamically linked library. You should call it upon all exit conditions. } +procedure SDL_Quit; +cdecl; external {$IFDEF __GPC__}name 'SDL_Quit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_Quit} + +{$IFDEF WIN32} +// This should be called from your WinMain() function, if any +function SDL_RegisterApp(name: PChar; style: UInt32; h_Inst: Pointer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_RegisterApp'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_RegisterApp} +{$ENDIF} + +{$IFDEF __MACH__} +// This should be called from your main() function, if any +procedure SDL_InitQuickDraw( the_qd: QDGlobals ); +cdecl; external {$IFDEF __GPC__}name 'SDL_InitQuickDraw'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_InitQuickDraw} +{$ENDIF} + + +{------------------------------------------------------------------------------} +{ types } +{------------------------------------------------------------------------------} +// The number of elements in a table +function SDL_TableSize( table: PChar ): Integer; +{$EXTERNALSYM SDL_TABLESIZE} + + +{------------------------------------------------------------------------------} +{ error-handling } +{------------------------------------------------------------------------------} +// Public functions +function SDL_GetError: PChar; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetError'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetError} +procedure SDL_SetError(fmt: PChar); +cdecl; external {$IFDEF __GPC__}name 'SDL_SetError'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetError} +procedure SDL_ClearError; +cdecl; external {$IFDEF __GPC__}name 'SDL_ClearError'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_ClearError} + +{$IFNDEF WIN32} +procedure SDL_Error(Code: TSDL_errorcode); +cdecl; external {$IFDEF __GPC__}name 'SDL_Error'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_Error} +{$ENDIF} + +// Private error message function - used internally +procedure SDL_OutOfMemory; + +{------------------------------------------------------------------------------} +{ io handling } +{------------------------------------------------------------------------------} +// Functions to create SDL_RWops structures from various data sources + +function SDL_RWFromFile(filename, mode: PChar): PSDL_RWops; +cdecl; external {$IFDEF __GPC__}name 'SDL_RWFromFile'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_RWFromFile} +procedure SDL_FreeRW(area: PSDL_RWops); +cdecl; external {$IFDEF __GPC__}name 'SDL_FreeRW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_FreeRW} + +//fp is FILE *fp ??? +function SDL_RWFromFP(fp: Pointer; autoclose: Integer): PSDL_RWops; +cdecl; external {$IFDEF __GPC__}name 'SDL_RWFromFP'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_RWFromFP} +function SDL_RWFromMem(mem: Pointer; size: Integer): PSDL_RWops; +cdecl; external {$IFDEF __GPC__}name 'SDL_RWFromMem'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_RWFromMem} +function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops; +cdecl; external {$IFDEF __GPC__}name 'SDL_RWFromConstMem'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_RWFromConstMem} +function SDL_AllocRW: PSDL_RWops; +cdecl; external {$IFDEF __GPC__}name 'SDL_AllocRW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_AllocRW} + +function SDL_RWSeek(context: PSDL_RWops; offset: Integer; whence: Integer) : Integer; +{$EXTERNALSYM SDL_RWSeek} +function SDL_RWTell(context: PSDL_RWops): Integer; +{$EXTERNALSYM SDL_RWTell} +function SDL_RWRead(context: PSDL_RWops; ptr: Pointer; size: Integer; n : Integer): Integer; +{$EXTERNALSYM SDL_RWRead} +function SDL_RWWrite(context: PSDL_RWops; ptr: Pointer; size: Integer; n : Integer): Integer; +{$EXTERNALSYM SDL_RWWrite} +function SDL_RWClose(context: PSDL_RWops): Integer; +{$EXTERNALSYM SDL_RWClose} + +{------------------------------------------------------------------------------} +{ time-handling } +{------------------------------------------------------------------------------} + +{ Get the number of milliseconds since the SDL library initialization. } +{ Note that this value wraps if the program runs for more than ~49 days. } +function SDL_GetTicks: UInt32; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetTicks'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetTicks} + +// Wait a specified number of milliseconds before returning +procedure SDL_Delay(msec: UInt32); +cdecl; external {$IFDEF __GPC__}name 'SDL_Delay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_Delay} + +{ Add a new timer to the pool of timers already running. } +{ Returns a timer ID, or NULL when an error occurs. } +function SDL_AddTimer(interval: UInt32; callback: TSDL_NewTimerCallback; param : Pointer): PSDL_TimerID; +cdecl; external {$IFDEF __GPC__}name 'SDL_AddTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_AddTimer} + +{ Remove one of the multiple timers knowing its ID. } +{ Returns a boolean value indicating success. } +function SDL_RemoveTimer(t: PSDL_TimerID): TSDL_Bool; +cdecl; external {$IFDEF __GPC__}name 'SDL_RemoveTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_RemoveTimer} + +function SDL_SetTimer(interval: UInt32; callback: TSDL_TimerCallback): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SetTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetTimer} + +{------------------------------------------------------------------------------} +{ audio-routines } +{------------------------------------------------------------------------------} + +{ These functions are used internally, and should not be used unless you + have a specific need to specify the audio driver you want to use. + You should normally use SDL_Init() or SDL_InitSubSystem(). } + +function SDL_AudioInit(driver_name: PChar): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_AudioInit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_AudioInit} +procedure SDL_AudioQuit; +cdecl; external {$IFDEF __GPC__}name 'SDL_AudioQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_AudioQuit} + +{ This function fills the given character buffer with the name of the + current audio driver, and returns a Pointer to it if the audio driver has + been initialized. It returns NULL if no driver has been initialized. } + +function SDL_AudioDriverName(namebuf: PChar; maxlen: Integer): PChar; +cdecl; external {$IFDEF __GPC__}name 'SDL_AudioDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_AudioDriverName} + +{ This function opens the audio device with the desired parameters, and + returns 0 if successful, placing the actual hardware parameters in the + structure pointed to by 'obtained'. If 'obtained' is NULL, the audio + data passed to the callback function will be guaranteed to be in the + requested format, and will be automatically converted to the hardware + audio format if necessary. This function returns -1 if it failed + to open the audio device, or couldn't set up the audio thread. + + When filling in the desired audio spec structure, + 'desired->freq' should be the desired audio frequency in samples-per-second. + 'desired->format' should be the desired audio format. + 'desired->samples' is the desired size of the audio buffer, in samples. + This number should be a power of two, and may be adjusted by the audio + driver to a value more suitable for the hardware. Good values seem to + range between 512 and 8096 inclusive, depending on the application and + CPU speed. Smaller values yield faster response time, but can lead + to underflow if the application is doing heavy processing and cannot + fill the audio buffer in time. A stereo sample consists of both right + and left channels in LR ordering. + Note that the number of samples is directly related to time by the + following formula: ms = (samples*1000)/freq + 'desired->size' is the size in bytes of the audio buffer, and is + calculated by SDL_OpenAudio(). + 'desired->silence' is the value used to set the buffer to silence, + and is calculated by SDL_OpenAudio(). + 'desired->callback' should be set to a function that will be called + when the audio device is ready for more data. It is passed a pointer + to the audio buffer, and the length in bytes of the audio buffer. + This function usually runs in a separate thread, and so you should + protect data structures that it accesses by calling SDL_LockAudio() + and SDL_UnlockAudio() in your code. + 'desired->userdata' is passed as the first parameter to your callback + function. + + The audio device starts out playing silence when it's opened, and should + be enabled for playing by calling SDL_PauseAudio(0) when you are ready + for your audio callback function to be called. Since the audio driver + may modify the requested size of the audio buffer, you should allocate + any local mixing buffers after you open the audio device. } + +function SDL_OpenAudio(desired, obtained: PSDL_AudioSpec): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_OpenAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_OpenAudio} + +{ Get the current audio state: } +function SDL_GetAudioStatus: TSDL_Audiostatus; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetAudioStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetAudioStatus} + +{ This function pauses and unpauses the audio callback processing. + It should be called with a parameter of 0 after opening the audio + device to start playing sound. This is so you can safely initialize + data for your callback function after opening the audio device. + Silence will be written to the audio device during the pause. } + +procedure SDL_PauseAudio(pause_on: Integer); +cdecl; external {$IFDEF __GPC__}name 'SDL_PauseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_PauseAudio} + +{ This function loads a WAVE from the data source, automatically freeing + that source if 'freesrc' is non-zero. For example, to load a WAVE file, + you could do: + SDL_LoadWAV_RW(SDL_RWFromFile("sample.wav", "rb"), 1, ...); + + If this function succeeds, it returns the given SDL_AudioSpec, + filled with the audio data format of the wave data, and sets + 'audio_buf' to a malloc()'d buffer containing the audio data, + and sets 'audio_len' to the length of that audio buffer, in bytes. + You need to free the audio buffer with SDL_FreeWAV() when you are + done with it. + + This function returns NULL and sets the SDL error message if the + wave file cannot be opened, uses an unknown data format, or is + corrupt. Currently raw and MS-ADPCM WAVE files are supported. } + +function SDL_LoadWAV_RW(src: PSDL_RWops; freesrc: Integer; spec: + PSDL_AudioSpec; audio_buf: PUInt8; audiolen: PUInt32): PSDL_AudioSpec; +cdecl; external {$IFDEF __GPC__}name 'SDL_LoadWAV_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_LoadWAV_RW} + +// Compatibility convenience function -- loads a WAV from a file +function SDL_LoadWAV(filename: PChar; spec: PSDL_AudioSpec; audio_buf: + PUInt8; audiolen: PUInt32): PSDL_AudioSpec; +{$EXTERNALSYM SDL_LoadWAV} + +{ This function frees data previously allocated with SDL_LoadWAV_RW() } + +procedure SDL_FreeWAV(audio_buf: PUInt8); +cdecl; external {$IFDEF __GPC__}name 'SDL_FreeWAV'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_FreeWAV} + +{ This function takes a source format and rate and a destination format + and rate, and initializes the 'cvt' structure with information needed + by SDL_ConvertAudio() to convert a buffer of audio data from one format + to the other. + This function returns 0, or -1 if there was an error. } +function SDL_BuildAudioCVT(cvt: PSDL_AudioCVT; src_format: UInt16; + src_channels: UInt8; src_rate: Integer; dst_format: UInt16; dst_channels: UInt8; + dst_rate: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_BuildAudioCVT'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_BuildAudioCVT} + +{ Once you have initialized the 'cvt' structure using SDL_BuildAudioCVT(), + created an audio buffer cvt->buf, and filled it with cvt->len bytes of + audio data in the source format, this function will convert it in-place + to the desired format. + The data conversion may expand the size of the audio data, so the buffer + cvt->buf should be allocated after the cvt structure is initialized by + SDL_BuildAudioCVT(), and should be cvt->len*cvt->len_mult bytes long. } +function SDL_ConvertAudio(cvt: PSDL_AudioCVT): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_ConvertAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_ConvertAudio} + +{ This takes two audio buffers of the playing audio format and mixes + them, performing addition, volume adjustment, and overflow clipping. + The volume ranges from 0 - 128, and should be set to SDL_MIX_MAXVOLUME + for full audio volume. Note this does not change hardware volume. + This is provided for convenience -- you can mix your own audio data. } + +procedure SDL_MixAudio(dst, src: PUInt8; len: UInt32; volume: Integer); +cdecl; external {$IFDEF __GPC__}name 'SDL_MixAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_MixAudio} + +{ The lock manipulated by these functions protects the callback function. + During a LockAudio/UnlockAudio pair, you can be guaranteed that the + callback function is not running. Do not call these from the callback + function or you will cause deadlock. } +procedure SDL_LockAudio; +cdecl; external {$IFDEF __GPC__}name 'SDL_LockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_LockAudio} +procedure SDL_UnlockAudio; +cdecl; external {$IFDEF __GPC__}name 'SDL_UnlockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_UnlockAudio} + +{ This function shuts down audio processing and closes the audio device. } + +procedure SDL_CloseAudio; +cdecl; external {$IFDEF __GPC__}name 'SDL_CloseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CloseAudio} + +{------------------------------------------------------------------------------} +{ CD-routines } +{------------------------------------------------------------------------------} + +{ Returns the number of CD-ROM drives on the system, or -1 if + SDL_Init() has not been called with the SDL_INIT_CDROM flag. } + +function SDL_CDNumDrives: Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDNumDrives'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDNumDrives} + +{ Returns a human-readable, system-dependent identifier for the CD-ROM. + Example: + "/dev/cdrom" + "E:" + "/dev/disk/ide/1/master" } + +function SDL_CDName(drive: Integer): PChar; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDName} + +{ Opens a CD-ROM drive for access. It returns a drive handle on success, + or NULL if the drive was invalid or busy. This newly opened CD-ROM + becomes the default CD used when other CD functions are passed a NULL + CD-ROM handle. + Drives are numbered starting with 0. Drive 0 is the system default CD-ROM. } + +function SDL_CDOpen(drive: Integer): PSDL_CD; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDOpen} + +{ This function returns the current status of the given drive. + If the drive has a CD in it, the table of contents of the CD and current + play position of the CD will be stored in the SDL_CD structure. } + +function SDL_CDStatus(cdrom: PSDL_CD): TSDL_CDStatus; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDStatus} + +{ Play the given CD starting at 'start_track' and 'start_frame' for 'ntracks' + tracks and 'nframes' frames. If both 'ntrack' and 'nframe' are 0, play + until the end of the CD. This function will skip data tracks. + This function should only be called after calling SDL_CDStatus() to + get track information about the CD. + + For example: + // Play entire CD: + if ( CD_INDRIVE(SDL_CDStatus(cdrom)) ) then + SDL_CDPlayTracks(cdrom, 0, 0, 0, 0); + // Play last track: + if ( CD_INDRIVE(SDL_CDStatus(cdrom)) ) then + begin + SDL_CDPlayTracks(cdrom, cdrom->numtracks-1, 0, 0, 0); + end; + + // Play first and second track and 10 seconds of third track: + if ( CD_INDRIVE(SDL_CDStatus(cdrom)) ) + SDL_CDPlayTracks(cdrom, 0, 0, 2, 10); + + This function returns 0, or -1 if there was an error. } + +function SDL_CDPlayTracks(cdrom: PSDL_CD; start_track: Integer; start_frame: + Integer; ntracks: Integer; nframes: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDPlayTracks'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDPlayTracks} + + +{ Play the given CD starting at 'start' frame for 'length' frames. + It returns 0, or -1 if there was an error. } + +function SDL_CDPlay(cdrom: PSDL_CD; start: Integer; length: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDPlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDPlay} + +// Pause play -- returns 0, or -1 on error +function SDL_CDPause(cdrom: PSDL_CD): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDPause'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDPause} + +// Resume play -- returns 0, or -1 on error +function SDL_CDResume(cdrom: PSDL_CD): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDResume'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDResume} + +// Stop play -- returns 0, or -1 on error +function SDL_CDStop(cdrom: PSDL_CD): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDStop'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDStop} + +// Eject CD-ROM -- returns 0, or -1 on error +function SDL_CDEject(cdrom: PSDL_CD): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CDEject'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDEject} + +// Closes the handle for the CD-ROM drive +procedure SDL_CDClose(cdrom: PSDL_CD); +cdecl; external {$IFDEF __GPC__}name 'SDL_CDClose'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CDClose} + +// Given a status, returns true if there's a disk in the drive +function SDL_CDInDrive( status : TSDL_CDStatus ) : LongBool; +{$EXTERNALSYM SDL_CDInDrive} + +// Conversion functions from frames to Minute/Second/Frames and vice versa +procedure FRAMES_TO_MSF(frames: Integer; var M: Integer; var S: Integer; var + F: Integer); +{$EXTERNALSYM FRAMES_TO_MSF} +function MSF_TO_FRAMES(M: Integer; S: Integer; F: Integer): Integer; +{$EXTERNALSYM MSF_TO_FRAMES} + +{------------------------------------------------------------------------------} +{ JoyStick-routines } +{------------------------------------------------------------------------------} + +{ Count the number of joysticks attached to the system } +function SDL_NumJoysticks: Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_NumJoysticks'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_NumJoysticks} + +{ Get the implementation dependent name of a joystick. + This can be called before any joysticks are opened. + If no name can be found, this function returns NULL. } +function SDL_JoystickName(index: Integer): PChar; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickName} + +{ Open a joystick for use - the index passed as an argument refers to + the N'th joystick on the system. This index is the value which will + identify this joystick in future joystick events. + + This function returns a joystick identifier, or NULL if an error occurred. } +function SDL_JoystickOpen(index: Integer): PSDL_Joystick; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickOpen} + +{ Returns 1 if the joystick has been opened, or 0 if it has not. } +function SDL_JoystickOpened(index: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickOpened'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickOpened} + +{ Get the device index of an opened joystick. } +function SDL_JoystickIndex(joystick: PSDL_Joystick): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickIndex'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickIndex} + +{ Get the number of general axis controls on a joystick } +function SDL_JoystickNumAxes(joystick: PSDL_Joystick): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickNumAxes'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickNumAxes} + +{ Get the number of trackballs on a joystick + Joystick trackballs have only relative motion events associated + with them and their state cannot be polled. } +function SDL_JoystickNumBalls(joystick: PSDL_Joystick): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickNumBalls'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickNumBalls} + + +{ Get the number of POV hats on a joystick } +function SDL_JoystickNumHats(joystick: PSDL_Joystick): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickNumHats'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickNumHats} + +{ Get the number of buttons on a joystick } +function SDL_JoystickNumButtons(joystick: PSDL_Joystick): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickNumButtons'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickNumButtons} + +{ Update the current state of the open joysticks. + This is called automatically by the event loop if any joystick + events are enabled. } + +procedure SDL_JoystickUpdate; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickUpdate'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickUpdate;} + +{ Enable/disable joystick event polling. + If joystick events are disabled, you must call SDL_JoystickUpdate() + yourself and check the state of the joystick when you want joystick + information. + The state can be one of SDL_QUERY, SDL_ENABLE or SDL_IGNORE. } + +function SDL_JoystickEventState(state: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickEventState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickEventState} + +{ Get the current state of an axis control on a joystick + The state is a value ranging from -32768 to 32767. + The axis indices start at index 0. } + +function SDL_JoystickGetAxis(joystick: PSDL_Joystick; axis: Integer) : SInt16; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickGetAxis'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickGetAxis} + +{ The hat indices start at index 0. } + +function SDL_JoystickGetHat(joystick: PSDL_Joystick; hat: Integer): UInt8; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickGetHat'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickGetHat} + +{ Get the ball axis change since the last poll + This returns 0, or -1 if you passed it invalid parameters. + The ball indices start at index 0. } + +function SDL_JoystickGetBall(joystick: PSDL_Joystick; ball: Integer; var dx: Integer; var dy: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickGetBall'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickGetBall} + +{ Get the current state of a button on a joystick + The button indices start at index 0. } +function SDL_JoystickGetButton( joystick: PSDL_Joystick; Button: Integer): UInt8; +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickGetButton'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickGetButton} + +{ Close a joystick previously opened with SDL_JoystickOpen() } +procedure SDL_JoystickClose(joystick: PSDL_Joystick); +cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickClose'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_JoystickClose} + +{------------------------------------------------------------------------------} +{ event-handling } +{------------------------------------------------------------------------------} + +{ Pumps the event loop, gathering events from the input devices. + This function updates the event queue and internal input device state. + This should only be run in the thread that sets the video mode. } + +procedure SDL_PumpEvents; +cdecl; external {$IFDEF __GPC__}name 'SDL_PumpEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_PumpEvents;} + +{ Checks the event queue for messages and optionally returns them. + If 'action' is SDL_ADDEVENT, up to 'numevents' events will be added to + the back of the event queue. + If 'action' is SDL_PEEKEVENT, up to 'numevents' events at the front + of the event queue, matching 'mask', will be returned and will not + be removed from the queue. + If 'action' is SDL_GETEVENT, up to 'numevents' events at the front + of the event queue, matching 'mask', will be returned and will be + removed from the queue. + This function returns the number of events actually stored, or -1 + if there was an error. This function is thread-safe. } + +function SDL_PeepEvents(events: PSDL_Event; numevents: Integer; action: TSDL_eventaction; mask: UInt32): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_PeepEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_PeepEvents} + +{ Polls for currently pending events, and returns 1 if there are any pending + events, or 0 if there are none available. If 'event' is not NULL, the next + event is removed from the queue and stored in that area. } + +function SDL_PollEvent(event: PSDL_Event): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_PollEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_PollEvent} + +{ Waits indefinitely for the next available event, returning 1, or 0 if there + was an error while waiting for events. If 'event' is not NULL, the next + event is removed from the queue and stored in that area. } + +function SDL_WaitEvent(event: PSDL_Event): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_WaitEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WaitEvent} + +function SDL_PushEvent( event : PSDL_Event ) : Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_PushEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_PushEvent} + +{ If the filter returns 1, then the event will be added to the internal queue. + If it returns 0, then the event will be dropped from the queue, but the + internal state will still be updated. This allows selective filtering of + dynamically arriving events. + + WARNING: Be very careful of what you do in the event filter function, as + it may run in a different thread! + + There is one caveat when dealing with the SDL_QUITEVENT event type. The + event filter is only called when the window manager desires to close the + application window. If the event filter returns 1, then the window will + be closed, otherwise the window will remain open if possible. + If the quit event is generated by an interrupt signal, it will bypass the + internal queue and be delivered to the application at the next event poll. } +procedure SDL_SetEventFilter( filter : TSDL_EventFilter ); +cdecl; external {$IFDEF __GPC__}name 'SDL_SetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetEventFilter} + +{ Return the current event filter - can be used to "chain" filters. + If there is no event filter set, this function returns NULL. } + +function SDL_GetEventFilter: TSDL_EventFilter; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetEventFilter} + +{ This function allows you to set the state of processing certain events. + If 'state' is set to SDL_IGNORE, that event will be automatically dropped + from the event queue and will not event be filtered. + If 'state' is set to SDL_ENABLE, that event will be processed normally. + If 'state' is set to SDL_QUERY, SDL_EventState() will return the + current processing state of the specified event. } + +function SDL_EventState(type_: UInt8; state: Integer): UInt8; +cdecl; external {$IFDEF __GPC__}name 'SDL_EventState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_EventState} + +{------------------------------------------------------------------------------} +{ Version Routines } +{------------------------------------------------------------------------------} + +{ This macro can be used to fill a version structure with the compile-time + version of the SDL library. } +procedure SDL_VERSION(var X: TSDL_Version); +{$EXTERNALSYM SDL_VERSION} + +{ This macro turns the version numbers into a numeric value: + (1,2,3) -> (1203) + This assumes that there will never be more than 100 patchlevels } + +function SDL_VERSIONNUM(X, Y, Z: Integer): Integer; +{$EXTERNALSYM SDL_VERSIONNUM} + +// This is the version number macro for the current SDL version +function SDL_COMPILEDVERSION: Integer; +{$EXTERNALSYM SDL_COMPILEDVERSION} + +// This macro will evaluate to true if compiled with SDL at least X.Y.Z +function SDL_VERSION_ATLEAST(X: Integer; Y: Integer; Z: Integer) : LongBool; +{$EXTERNALSYM SDL_VERSION_ATLEAST} + +{ This function gets the version of the dynamically linked SDL library. + it should NOT be used to fill a version structure, instead you should + use the SDL_Version() macro. } + +function SDL_Linked_Version: PSDL_version; +cdecl; external {$IFDEF __GPC__}name 'SDL_Linked_Version'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_Linked_Version} + +{------------------------------------------------------------------------------} +{ video } +{------------------------------------------------------------------------------} + +{ These functions are used internally, and should not be used unless you + have a specific need to specify the video driver you want to use. + You should normally use SDL_Init() or SDL_InitSubSystem(). + + SDL_VideoInit() initializes the video subsystem -- sets up a connection + to the window manager, etc, and determines the current video mode and + pixel format, but does not initialize a window or graphics mode. + Note that event handling is activated by this routine. + + If you use both sound and video in your application, you need to call + SDL_Init() before opening the sound device, otherwise under Win32 DirectX, + you won't be able to set full-screen display modes. } + +function SDL_VideoInit(driver_name: PChar; flags: UInt32): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_VideoInit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_VideoInit} +procedure SDL_VideoQuit; +cdecl; external {$IFDEF __GPC__}name 'SDL_VideoQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_VideoQuit} + +{ This function fills the given character buffer with the name of the + video driver, and returns a pointer to it if the video driver has + been initialized. It returns NULL if no driver has been initialized. } + +function SDL_VideoDriverName(namebuf: PChar; maxlen: Integer): PChar; +cdecl; external {$IFDEF __GPC__}name 'SDL_VideoDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_VideoDriverName} + +{ This function returns a pointer to the current display surface. + If SDL is doing format conversion on the display surface, this + function returns the publicly visible surface, not the real video + surface. } + +function SDL_GetVideoSurface: PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetVideoSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetVideoSurface} + +{ This function returns a read-only pointer to information about the + video hardware. If this is called before SDL_SetVideoMode(), the 'vfmt' + member of the returned structure will contain the pixel format of the + "best" video mode. } +function SDL_GetVideoInfo: PSDL_VideoInfo; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetVideoInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetVideoInfo} + +{ Check to see if a particular video mode is supported. + It returns 0 if the requested mode is not supported under any bit depth, + or returns the bits-per-pixel of the closest available mode with the + given width and height. If this bits-per-pixel is different from the + one used when setting the video mode, SDL_SetVideoMode() will succeed, + but will emulate the requested bits-per-pixel with a shadow surface. + + The arguments to SDL_VideoModeOK() are the same ones you would pass to + SDL_SetVideoMode() } + +function SDL_VideoModeOK(width, height, bpp: Integer; flags: UInt32): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_VideoModeOK'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_VideoModeOK} + +{ Return a pointer to an array of available screen dimensions for the + given format and video flags, sorted largest to smallest. Returns + NULL if there are no dimensions available for a particular format, + or (SDL_Rect **)-1 if any dimension is okay for the given format. + + if 'format' is NULL, the mode list will be for the format given + by SDL_GetVideoInfo( ) - > vfmt } + +function SDL_ListModes(format: PSDL_PixelFormat; flags: UInt32): PPSDL_Rect; +cdecl; external {$IFDEF __GPC__}name 'SDL_ListModes'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_ListModes} + + +{ Set up a video mode with the specified width, height and bits-per-pixel. + + If 'bpp' is 0, it is treated as the current display bits per pixel. + + If SDL_ANYFORMAT is set in 'flags', the SDL library will try to set the + requested bits-per-pixel, but will return whatever video pixel format is + available. The default is to emulate the requested pixel format if it + is not natively available. + + If SDL_HWSURFACE is set in 'flags', the video surface will be placed in + video memory, if possible, and you may have to call SDL_LockSurface() + in order to access the raw framebuffer. Otherwise, the video surface + will be created in system memory. + + If SDL_ASYNCBLIT is set in 'flags', SDL will try to perform rectangle + updates asynchronously, but you must always lock before accessing pixels. + SDL will wait for updates to complete before returning from the lock. + + If SDL_HWPALETTE is set in 'flags', the SDL library will guarantee + that the colors set by SDL_SetColors() will be the colors you get. + Otherwise, in 8-bit mode, SDL_SetColors() may not be able to set all + of the colors exactly the way they are requested, and you should look + at the video surface structure to determine the actual palette. + If SDL cannot guarantee that the colors you request can be set, + i.e. if the colormap is shared, then the video surface may be created + under emulation in system memory, overriding the SDL_HWSURFACE flag. + + If SDL_FULLSCREEN is set in 'flags', the SDL library will try to set + a fullscreen video mode. The default is to create a windowed mode + if the current graphics system has a window manager. + If the SDL library is able to set a fullscreen video mode, this flag + will be set in the surface that is returned. + + If SDL_DOUBLEBUF is set in 'flags', the SDL library will try to set up + two surfaces in video memory and swap between them when you call + SDL_Flip(). This is usually slower than the normal single-buffering + scheme, but prevents "tearing" artifacts caused by modifying video + memory while the monitor is refreshing. It should only be used by + applications that redraw the entire screen on every update. + + This function returns the video framebuffer surface, or NULL if it fails. } + +function SDL_SetVideoMode(width, height, bpp: Integer; flags: UInt32): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'SDL_SetVideoMode'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetVideoMode} + + +{ Makes sure the given list of rectangles is updated on the given screen. + If 'x', 'y', 'w' and 'h' are all 0, SDL_UpdateRect will update the entire + screen. + These functions should not be called while 'screen' is locked. } + +procedure SDL_UpdateRects(screen: PSDL_Surface; numrects: Integer; rects: PSDL_Rect); +cdecl; external {$IFDEF __GPC__}name 'SDL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_UpdateRects} +procedure SDL_UpdateRect(screen: PSDL_Surface; x, y: SInt32; w, h: UInt32); +cdecl; external {$IFDEF __GPC__}name 'SDL_UpdateRect'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_UpdateRect} + + +{ On hardware that supports double-buffering, this function sets up a flip + and returns. The hardware will wait for vertical retrace, and then swap + video buffers before the next video surface blit or lock will return. + On hardware that doesn not support double-buffering, this is equivalent + to calling SDL_UpdateRect(screen, 0, 0, 0, 0); + The SDL_DOUBLEBUF flag must have been passed to SDL_SetVideoMode() when + setting the video mode for this function to perform hardware flipping. + This function returns 0 if successful, or -1 if there was an error.} + +function SDL_Flip(screen: PSDL_Surface): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_Flip'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_Flip} + +{ Set the gamma correction for each of the color channels. + The gamma values range (approximately) between 0.1 and 10.0 + + If this function isn't supported directly by the hardware, it will + be emulated using gamma ramps, if available. If successful, this + function returns 0, otherwise it returns -1. } + +function SDL_SetGamma(redgamma: single; greengamma: single; bluegamma: single ): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SetGamma'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetGamma} + +{ Set the gamma translation table for the red, green, and blue channels + of the video hardware. Each table is an array of 256 16-bit quantities, + representing a mapping between the input and output for that channel. + The input is the index into the array, and the output is the 16-bit + gamma value at that index, scaled to the output color precision. + + You may pass NULL for any of the channels to leave it unchanged. + If the call succeeds, it will return 0. If the display driver or + hardware does not support gamma translation, or otherwise fails, + this function will return -1. } + +function SDL_SetGammaRamp( redtable: PUInt16; greentable: PUInt16; bluetable: PUInt16): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetGammaRamp} + +{ Retrieve the current values of the gamma translation tables. + + You must pass in valid pointers to arrays of 256 16-bit quantities. + Any of the pointers may be NULL to ignore that channel. + If the call succeeds, it will return 0. If the display driver or + hardware does not support gamma translation, or otherwise fails, + this function will return -1. } + +function SDL_GetGammaRamp( redtable: PUInt16; greentable: PUInt16; bluetable: PUInt16): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetGammaRamp} + +{ Sets a portion of the colormap for the given 8-bit surface. If 'surface' + is not a palettized surface, this function does nothing, returning 0. + If all of the colors were set as passed to SDL_SetColors(), it will + return 1. If not all the color entries were set exactly as given, + it will return 0, and you should look at the surface palette to + determine the actual color palette. + + When 'surface' is the surface associated with the current display, the + display colormap will be updated with the requested colors. If + SDL_HWPALETTE was set in SDL_SetVideoMode() flags, SDL_SetColors() + will always return 1, and the palette is guaranteed to be set the way + you desire, even if the window colormap has to be warped or run under + emulation. } + + +function SDL_SetColors(surface: PSDL_Surface; colors: PSDL_Color; firstcolor : Integer; ncolors: Integer) : Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SetColors'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetColors} + +{ Sets a portion of the colormap for a given 8-bit surface. + 'flags' is one or both of: + SDL_LOGPAL -- set logical palette, which controls how blits are mapped + to/from the surface, + SDL_PHYSPAL -- set physical palette, which controls how pixels look on + the screen + Only screens have physical palettes. Separate change of physical/logical + palettes is only possible if the screen has SDL_HWPALETTE set. + + The return value is 1 if all colours could be set as requested, and 0 + otherwise. + + SDL_SetColors() is equivalent to calling this function with + flags = (SDL_LOGPAL or SDL_PHYSPAL). } + +function SDL_SetPalette(surface: PSDL_Surface; flags: Integer; colors: PSDL_Color; firstcolor: Integer; ncolors: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SetPalette'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetPalette} + +{ Maps an RGB triple to an opaque pixel value for a given pixel format } +function SDL_MapRGB(format: PSDL_PixelFormat; r: UInt8; g: UInt8; b: UInt8) : UInt32; +cdecl; external {$IFDEF __GPC__}name 'SDL_MapRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_MapRGB} + +{ Maps an RGBA quadruple to a pixel value for a given pixel format } +function SDL_MapRGBA(format: PSDL_PixelFormat; r: UInt8; g: UInt8; b: UInt8; a: UInt8): UInt32; +cdecl; external {$IFDEF __GPC__}name 'SDL_MapRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_MapRGBA} + +{ Maps a pixel value into the RGB components for a given pixel format } +procedure SDL_GetRGB(pixel: UInt32; fmt: PSDL_PixelFormat; r: PUInt8; g: PUInt8; b: PUInt8); +cdecl; external {$IFDEF __GPC__}name 'SDL_GetRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetRGB} + +{ Maps a pixel value into the RGBA components for a given pixel format } +procedure SDL_GetRGBA(pixel: UInt32; fmt: PSDL_PixelFormat; r: PUInt8; g: PUInt8; b: PUInt8; a: PUInt8); +cdecl; external {$IFDEF __GPC__}name 'SDL_GetRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetRGBA} + +{ Allocate and free an RGB surface (must be called after SDL_SetVideoMode) + If the depth is 4 or 8 bits, an empty palette is allocated for the surface. + If the depth is greater than 8 bits, the pixel format is set using the + flags '[RGB]mask'. + If the function runs out of memory, it will return NULL. + + The 'flags' tell what kind of surface to create. + SDL_SWSURFACE means that the surface should be created in system memory. + SDL_HWSURFACE means that the surface should be created in video memory, + with the same format as the display surface. This is useful for surfaces + that will not change much, to take advantage of hardware acceleration + when being blitted to the display surface. + SDL_ASYNCBLIT means that SDL will try to perform asynchronous blits with + this surface, but you must always lock it before accessing the pixels. + SDL will wait for current blits to finish before returning from the lock. + SDL_SRCCOLORKEY indicates that the surface will be used for colorkey blits. + If the hardware supports acceleration of colorkey blits between + two surfaces in video memory, SDL will try to place the surface in + video memory. If this isn't possible or if there is no hardware + acceleration available, the surface will be placed in system memory. + SDL_SRCALPHA means that the surface will be used for alpha blits and + if the hardware supports hardware acceleration of alpha blits between + two surfaces in video memory, to place the surface in video memory + if possible, otherwise it will be placed in system memory. + If the surface is created in video memory, blits will be _much_ faster, + but the surface format must be identical to the video surface format, + and the only way to access the pixels member of the surface is to use + the SDL_LockSurface() and SDL_UnlockSurface() calls. + If the requested surface actually resides in video memory, SDL_HWSURFACE + will be set in the flags member of the returned surface. If for some + reason the surface could not be placed in video memory, it will not have + the SDL_HWSURFACE flag set, and will be created in system memory instead. } + +function SDL_AllocSurface(flags: UInt32; width, height, depth: Integer; + RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; +{$EXTERNALSYM SDL_AllocSurface} + +function SDL_CreateRGBSurface(flags: UInt32; width, height, depth: Integer; RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'SDL_CreateRGBSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CreateRGBSurface} + +function SDL_CreateRGBSurfaceFrom(pixels: Pointer; width, height, depth, pitch + : Integer; RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'SDL_CreateRGBSurfaceFrom'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CreateRGBSurfaceFrom} + +procedure SDL_FreeSurface(surface: PSDL_Surface); +cdecl; external {$IFDEF __GPC__}name 'SDL_FreeSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_FreeSurface} + +function SDL_MustLock(Surface: PSDL_Surface): Boolean; +{$EXTERNALSYM SDL_MustLock} +{ SDL_LockSurface() sets up a surface for directly accessing the pixels. + Between calls to SDL_LockSurface()/SDL_UnlockSurface(), you can write + to and read from 'surface->pixels', using the pixel format stored in + 'surface->format'. Once you are done accessing the surface, you should + use SDL_UnlockSurface() to release it. + + Not all surfaces require locking. If SDL_MUSTLOCK(surface) evaluates + to 0, then you can read and write to the surface at any time, and the + pixel format of the surface will not change. In particular, if the + SDL_HWSURFACE flag is not given when calling SDL_SetVideoMode(), you + will not need to lock the display surface before accessing it. + + No operating system or library calls should be made between lock/unlock + pairs, as critical system locks may be held during this time. + + SDL_LockSurface() returns 0, or -1 if the surface couldn't be locked. } +function SDL_LockSurface(surface: PSDL_Surface): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_LockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_LockSurface} + +procedure SDL_UnlockSurface(surface: PSDL_Surface); +cdecl; external {$IFDEF __GPC__}name 'SDL_UnlockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_UnlockSurface} + +{ Load a surface from a seekable SDL data source (memory or file.) + If 'freesrc' is non-zero, the source will be closed after being read. + Returns the new surface, or NULL if there was an error. + The new surface should be freed with SDL_FreeSurface(). } +function SDL_LoadBMP_RW(src: PSDL_RWops; freesrc: Integer): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'SDL_LoadBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_LoadBMP_RW} + +// Convenience macro -- load a surface from a file +function SDL_LoadBMP(filename: PChar): PSDL_Surface; +{$EXTERNALSYM SDL_LoadBMP} + +{ Save a surface to a seekable SDL data source (memory or file.) + If 'freedst' is non-zero, the source will be closed after being written. + Returns 0 if successful or -1 if there was an error. } + +function SDL_SaveBMP_RW(surface: PSDL_Surface; dst: PSDL_RWops; freedst: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SaveBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SaveBMP_RW} + +// Convenience macro -- save a surface to a file +function SDL_SaveBMP(surface: PSDL_Surface; filename: PChar): Integer; +{$EXTERNALSYM SDL_SaveBMP} + +{ Sets the color key (transparent pixel) in a blittable surface. + If 'flag' is SDL_SRCCOLORKEY (optionally OR'd with SDL_RLEACCEL), + 'key' will be the transparent pixel in the source image of a blit. + SDL_RLEACCEL requests RLE acceleration for the surface if present, + and removes RLE acceleration if absent. + If 'flag' is 0, this function clears any current color key. + This function returns 0, or -1 if there was an error. } + +function SDL_SetColorKey(surface: PSDL_Surface; flag, key: UInt32) : Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SetColorKey'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetColorKey} + +{ This function sets the alpha value for the entire surface, as opposed to + using the alpha component of each pixel. This value measures the range + of transparency of the surface, 0 being completely transparent to 255 + being completely opaque. An 'alpha' value of 255 causes blits to be + opaque, the source pixels copied to the destination (the default). Note + that per-surface alpha can be combined with colorkey transparency. + + If 'flag' is 0, alpha blending is disabled for the surface. + If 'flag' is SDL_SRCALPHA, alpha blending is enabled for the surface. + OR:ing the flag with SDL_RLEACCEL requests RLE acceleration for the + surface; if SDL_RLEACCEL is not specified, the RLE accel will be removed. } + + +function SDL_SetAlpha(surface: PSDL_Surface; flag: UInt32; alpha: UInt8): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SetAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetAlpha} + +{ Sets the clipping rectangle for the destination surface in a blit. + + If the clip rectangle is NULL, clipping will be disabled. + If the clip rectangle doesn't intersect the surface, the function will + return SDL_FALSE and blits will be completely clipped. Otherwise the + function returns SDL_TRUE and blits to the surface will be clipped to + the intersection of the surface area and the clipping rectangle. + + Note that blits are automatically clipped to the edges of the source + and destination surfaces. } +procedure SDL_SetClipRect(surface: PSDL_Surface; rect: PSDL_Rect); cdecl; +external {$IFDEF __GPC__}name 'SDL_SetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetClipRect} + +{ Gets the clipping rectangle for the destination surface in a blit. + 'rect' must be a pointer to a valid rectangle which will be filled + with the correct values. } +procedure SDL_GetClipRect(surface: PSDL_Surface; rect: PSDL_Rect); cdecl; +external {$IFDEF __GPC__}name 'SDL_GetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetClipRect} + +{ Creates a new surface of the specified format, and then copies and maps + the given surface to it so the blit of the converted surface will be as + fast as possible. If this function fails, it returns NULL. + + The 'flags' parameter is passed to SDL_CreateRGBSurface() and has those + semantics. You can also pass SDL_RLEACCEL in the flags parameter and + SDL will try to RLE accelerate colorkey and alpha blits in the resulting + surface. + + This function is used internally by SDL_DisplayFormat(). } + +function SDL_ConvertSurface(src: PSDL_Surface; fmt: PSDL_PixelFormat; flags: UInt32): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'SDL_ConvertSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_ConvertSurface} + +{ + This performs a fast blit from the source surface to the destination + surface. It assumes that the source and destination rectangles are + the same size. If either 'srcrect' or 'dstrect' are NULL, the entire + surface (src or dst) is copied. The final blit rectangles are saved + in 'srcrect' and 'dstrect' after all clipping is performed. + If the blit is successful, it returns 0, otherwise it returns -1. + + The blit function should not be called on a locked surface. + + The blit semantics for surfaces with and without alpha and colorkey + are defined as follows: + + RGBA->RGB: + SDL_SRCALPHA set: + alpha-blend (using alpha-channel). + SDL_SRCCOLORKEY ignored. + SDL_SRCALPHA not set: + copy RGB. + if SDL_SRCCOLORKEY set, only copy the pixels matching the + RGB values of the source colour key, ignoring alpha in the + comparison. + + RGB->RGBA: + SDL_SRCALPHA set: + alpha-blend (using the source per-surface alpha value); + set destination alpha to opaque. + SDL_SRCALPHA not set: + copy RGB, set destination alpha to opaque. + both: + if SDL_SRCCOLORKEY set, only copy the pixels matching the + source colour key. + + RGBA->RGBA: + SDL_SRCALPHA set: + alpha-blend (using the source alpha channel) the RGB values; + leave destination alpha untouched. [Note: is this correct?] + SDL_SRCCOLORKEY ignored. + SDL_SRCALPHA not set: + copy all of RGBA to the destination. + if SDL_SRCCOLORKEY set, only copy the pixels matching the + RGB values of the source colour key, ignoring alpha in the + comparison. + + RGB->RGB: + SDL_SRCALPHA set: + alpha-blend (using the source per-surface alpha value). + SDL_SRCALPHA not set: + copy RGB. + both: + if SDL_SRCCOLORKEY set, only copy the pixels matching the + source colour key. + + If either of the surfaces were in video memory, and the blit returns -2, + the video memory was lost, so it should be reloaded with artwork and + re-blitted: + while ( SDL_BlitSurface(image, imgrect, screen, dstrect) = -2 ) do + begin + while ( SDL_LockSurface(image) < 0 ) do + Sleep(10); + -- Write image pixels to image->pixels -- + SDL_UnlockSurface(image); + end; + + This happens under DirectX 5.0 when the system switches away from your + fullscreen application. The lock will also fail until you have access + to the video memory again. } + +{ You should call SDL_BlitSurface() unless you know exactly how SDL + blitting works internally and how to use the other blit functions. } + +function SDL_BlitSurface(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; +{$EXTERNALSYM SDL_BlitSurface} + +{ This is the public blit function, SDL_BlitSurface(), and it performs + rectangle validation and clipping before passing it to SDL_LowerBlit() } +function SDL_UpperBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_UpperBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_UpperBlit} + +{ This is a semi-private blit function and it performs low-level surface + blitting only. } +function SDL_LowerBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_LowerBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_LowerBlit} + +{ This function performs a fast fill of the given rectangle with 'color' + The given rectangle is clipped to the destination surface clip area + and the final fill rectangle is saved in the passed in pointer. + If 'dstrect' is NULL, the whole surface will be filled with 'color' + The color should be a pixel of the format used by the surface, and + can be generated by the SDL_MapRGB() function. + This function returns 0 on success, or -1 on error. } + +function SDL_FillRect(dst: PSDL_Surface; dstrect: PSDL_Rect; color: UInt32) : Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_FillRect'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_FillRect} + +{ This function takes a surface and copies it to a new surface of the + pixel format and colors of the video framebuffer, suitable for fast + blitting onto the display surface. It calls SDL_ConvertSurface() + + If you want to take advantage of hardware colorkey or alpha blit + acceleration, you should set the colorkey and alpha value before + calling this function. + + If the conversion fails or runs out of memory, it returns NULL } + +function SDL_DisplayFormat(surface: PSDL_Surface): PSDL_Surface; cdecl; +external {$IFDEF __GPC__}name 'SDL_DisplayFormat'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_DisplayFormat} + +{ This function takes a surface and copies it to a new surface of the + pixel format and colors of the video framebuffer (if possible), + suitable for fast alpha blitting onto the display surface. + The new surface will always have an alpha channel. + + If you want to take advantage of hardware colorkey or alpha blit + acceleration, you should set the colorkey and alpha value before + calling this function. + + If the conversion fails or runs out of memory, it returns NULL } + + +function SDL_DisplayFormatAlpha(surface: PSDL_Surface): PSDL_Surface; cdecl; +external {$IFDEF __GPC__}name 'SDL_DisplayFormatAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_DisplayFormatAlpha} + +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ +//* YUV video surface overlay functions */ +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +{ This function creates a video output overlay + Calling the returned surface an overlay is something of a misnomer because + the contents of the display surface underneath the area where the overlay + is shown is undefined - it may be overwritten with the converted YUV data. } + +function SDL_CreateYUVOverlay(width: Integer; height: Integer; format: UInt32; display: PSDL_Surface): PSDL_Overlay; +cdecl; external {$IFDEF __GPC__}name 'SDL_CreateYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CreateYUVOverlay} + +// Lock an overlay for direct access, and unlock it when you are done +function SDL_LockYUVOverlay(Overlay: PSDL_Overlay): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_LockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_LockYUVOverlay} + +procedure SDL_UnlockYUVOverlay(Overlay: PSDL_Overlay); cdecl; +external {$IFDEF __GPC__}name 'SDL_UnlockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_UnlockYUVOverlay} + + +{ Blit a video overlay to the display surface. + The contents of the video surface underneath the blit destination are + not defined. + The width and height of the destination rectangle may be different from + that of the overlay, but currently only 2x scaling is supported. } + +function SDL_DisplayYUVOverlay(Overlay: PSDL_Overlay; dstrect: PSDL_Rect) : Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_DisplayYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_DisplayYUVOverlay} + +// Free a video overlay +procedure SDL_FreeYUVOverlay(Overlay: PSDL_Overlay); +cdecl; external {$IFDEF __GPC__}name 'SDL_FreeYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_FreeYUVOverlay} + +{------------------------------------------------------------------------------} +{ OpenGL Routines } +{------------------------------------------------------------------------------} + +{ Dynamically load a GL driver, if SDL is built with dynamic GL. + + SDL links normally with the OpenGL library on your system by default, + but you can compile it to dynamically load the GL driver at runtime. + If you do this, you need to retrieve all of the GL functions used in + your program from the dynamic library using SDL_GL_GetProcAddress(). + + This is disabled in default builds of SDL. } + + +function SDL_GL_LoadLibrary(filename: PChar): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_GL_LoadLibrary'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GL_LoadLibrary} + +{ Get the address of a GL function (for extension functions) } +function SDL_GL_GetProcAddress(procname: PChar) : Pointer; +cdecl; external {$IFDEF __GPC__}name 'SDL_GL_GetProcAddress'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GL_GetProcAddress} + +{ Set an attribute of the OpenGL subsystem before intialization. } +function SDL_GL_SetAttribute(attr: TSDL_GLAttr; value: Integer) : Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_GL_SetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GL_SetAttribute} + +{ Get an attribute of the OpenGL subsystem from the windowing + interface, such as glX. This is of course different from getting + the values from SDL's internal OpenGL subsystem, which only + stores the values you request before initialization. + + Developers should track the values they pass into SDL_GL_SetAttribute + themselves if they want to retrieve these values. } + +function SDL_GL_GetAttribute(attr: TSDL_GLAttr; var value: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_GL_GetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GL_GetAttribute} + +{ Swap the OpenGL buffers, if double-buffering is supported. } + +procedure SDL_GL_SwapBuffers; +cdecl; external {$IFDEF __GPC__}name 'SDL_GL_SwapBuffers'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GL_SwapBuffers;} + +{ Internal functions that should not be called unless you have read + and understood the source code for these functions. } + +procedure SDL_GL_UpdateRects(numrects: Integer; rects: PSDL_Rect); +cdecl; external {$IFDEF __GPC__}name 'SDL_GL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GL_UpdateRects} +procedure SDL_GL_Lock; +cdecl; external {$IFDEF __GPC__}name 'SDL_GL_Lock'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GL_Lock;} +procedure SDL_GL_Unlock; +cdecl; external {$IFDEF __GPC__}name 'SDL_GL_Unlock'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GL_Unlock;} + +{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} +{* These functions allow interaction with the window manager, if any. *} +{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} + +{ Sets/Gets the title and icon text of the display window } +procedure SDL_WM_GetCaption(var title : PChar; var icon : PChar); +cdecl; external {$IFDEF __GPC__}name 'SDL_WM_GetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WM_GetCaption} +procedure SDL_WM_SetCaption( const title : PChar; const icon : PChar); +cdecl; external {$IFDEF __GPC__}name 'SDL_WM_SetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WM_SetCaption} + +{ Sets the icon for the display window. + This function must be called before the first call to SDL_SetVideoMode(). + It takes an icon surface, and a mask in MSB format. + If 'mask' is NULL, the entire icon surface will be used as the icon. } +procedure SDL_WM_SetIcon(icon: PSDL_Surface; mask: UInt8); +cdecl; external {$IFDEF __GPC__}name 'SDL_WM_SetIcon'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WM_SetIcon} + +{ This function iconifies the window, and returns 1 if it succeeded. + If the function succeeds, it generates an SDL_APPACTIVE loss event. + This function is a noop and returns 0 in non-windowed environments. } + +function SDL_WM_IconifyWindow: Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_WM_IconifyWindow'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WM_IconifyWindow} + +{ Toggle fullscreen mode without changing the contents of the screen. + If the display surface does not require locking before accessing + the pixel information, then the memory pointers will not change. + + If this function was able to toggle fullscreen mode (change from + running in a window to fullscreen, or vice-versa), it will return 1. + If it is not implemented, or fails, it returns 0. + + The next call to SDL_SetVideoMode() will set the mode fullscreen + attribute based on the flags parameter - if SDL_FULLSCREEN is not + set, then the display will be windowed by default where supported. + + This is currently only implemented in the X11 video driver. } + +function SDL_WM_ToggleFullScreen(surface: PSDL_Surface): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_WM_ToggleFullScreen'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WM_ToggleFullScreen} + +{ Grabbing means that the mouse is confined to the application window, + and nearly all keyboard input is passed directly to the application, + and not interpreted by a window manager, if any. } + +function SDL_WM_GrabInput(mode: TSDL_GrabMode): TSDL_GrabMode; +cdecl; external {$IFDEF __GPC__}name 'SDL_WM_GrabInput'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WM_GrabInput} + +{------------------------------------------------------------------------------} +{ mouse-routines } +{------------------------------------------------------------------------------} + +{ Retrieve the current state of the mouse. + The current button state is returned as a button bitmask, which can + be tested using the SDL_BUTTON(X) macros, and x and y are set to the + current mouse cursor position. You can pass NULL for either x or y. } + +function SDL_GetMouseState(var x: Integer; var y: Integer): UInt8; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetMouseState} + +{ Retrieve the current state of the mouse. + The current button state is returned as a button bitmask, which can + be tested using the SDL_BUTTON(X) macros, and x and y are set to the + mouse deltas since the last call to SDL_GetRelativeMouseState(). } +function SDL_GetRelativeMouseState(var x: Integer; var y: Integer): UInt8; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetRelativeMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetRelativeMouseState} + +{ Set the position of the mouse cursor (generates a mouse motion event) } +procedure SDL_WarpMouse(x, y: UInt16); +cdecl; external {$IFDEF __GPC__}name 'SDL_WarpMouse'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WarpMouse} + +{ Create a cursor using the specified data and mask (in MSB format). + The cursor width must be a multiple of 8 bits. + + The cursor is created in black and white according to the following: + data mask resulting pixel on screen + 0 1 White + 1 1 Black + 0 0 Transparent + 1 0 Inverted color if possible, black if not. + + Cursors created with this function must be freed with SDL_FreeCursor(). } +function SDL_CreateCursor(data, mask: PUInt8; w, h, hot_x, hot_y: Integer): PSDL_Cursor; +cdecl; external {$IFDEF __GPC__}name 'SDL_CreateCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CreateCursor} + +{ Set the currently active cursor to the specified one. + If the cursor is currently visible, the change will be immediately + represented on the display. } +procedure SDL_SetCursor(cursor: PSDL_Cursor); +cdecl; external {$IFDEF __GPC__}name 'SDL_SetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetCursor} + +{ Returns the currently active cursor. } +function SDL_GetCursor: PSDL_Cursor; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetCursor} + +{ Deallocates a cursor created with SDL_CreateCursor(). } +procedure SDL_FreeCursor(cursor: PSDL_Cursor); +cdecl; external {$IFDEF __GPC__}name 'SDL_FreeCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_FreeCursor} + +{ Toggle whether or not the cursor is shown on the screen. + The cursor start off displayed, but can be turned off. + SDL_ShowCursor() returns 1 if the cursor was being displayed + before the call, or 0 if it was not. You can query the current + state by passing a 'toggle' value of -1. } +function SDL_ShowCursor(toggle: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_ShowCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_ShowCursor} + +function SDL_BUTTON( Button : Integer ) : Integer; + +{------------------------------------------------------------------------------} +{ Keyboard-routines } +{------------------------------------------------------------------------------} + +{ Enable/Disable UNICODE translation of keyboard input. + This translation has some overhead, so translation defaults off. + If 'enable' is 1, translation is enabled. + If 'enable' is 0, translation is disabled. + If 'enable' is -1, the translation state is not changed. + It returns the previous state of keyboard translation. } +function SDL_EnableUNICODE(enable: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_EnableUNICODE'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_EnableUNICODE} + +{ If 'delay' is set to 0, keyboard repeat is disabled. } +function SDL_EnableKeyRepeat(delay: Integer; interval: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_EnableKeyRepeat'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_EnableKeyRepeat} + +{ Get a snapshot of the current state of the keyboard. + Returns an array of keystates, indexed by the SDLK_* syms. + Used: + + UInt8 *keystate = SDL_GetKeyState(NULL); + if ( keystate[SDLK_RETURN] ) ... is pressed } + +function SDL_GetKeyState(numkeys: PInt): PUInt8; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetKeyState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetKeyState} + +{ Get the current key modifier state } +function SDL_GetModState: TSDLMod; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetModState} + +{ Set the current key modifier state + This does not change the keyboard state, only the key modifier flags. } +procedure SDL_SetModState(modstate: TSDLMod); +cdecl; external {$IFDEF __GPC__}name 'SDL_SetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SetModState} + +{ Get the name of an SDL virtual keysym } +function SDL_GetKeyName(key: TSDLKey): PChar; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetKeyName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetKeyName} + +{------------------------------------------------------------------------------} +{ Active Routines } +{------------------------------------------------------------------------------} + +{ This function returns the current state of the application, which is a + bitwise combination of SDL_APPMOUSEFOCUS, SDL_APPINPUTFOCUS, and + SDL_APPACTIVE. If SDL_APPACTIVE is set, then the user is able to + see your application, otherwise it has been iconified or disabled. } + +function SDL_GetAppState: UInt8; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetAppState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetAppState} + + +{ Mutex functions } + +{ Create a mutex, initialized unlocked } + +function SDL_CreateMutex: PSDL_Mutex; +cdecl; external {$IFDEF __GPC__}name 'SDL_CreateMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CreateMutex} + +{ Lock the mutex (Returns 0, or -1 on error) } + + function SDL_mutexP(mutex: PSDL_mutex): Integer; + cdecl; external {$IFDEF __GPC__}name 'SDL_mutexP'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{ $ EXTERNALSYM SDL_mutexP} + +function SDL_LockMutex(mutex: PSDL_mutex): Integer; +{$EXTERNALSYM SDL_LockMutex} + +{ Unlock the mutex (Returns 0, or -1 on error) } +function SDL_mutexV(mutex: PSDL_mutex): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_mutexV'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_mutexV} + +function SDL_UnlockMutex(mutex: PSDL_mutex): Integer; +{$EXTERNALSYM SDL_UnlockMutex} + +{ Destroy a mutex } +procedure SDL_DestroyMutex(mutex: PSDL_mutex); +cdecl; external {$IFDEF __GPC__}name 'SDL_DestroyMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_DestroyMutex} + +{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } +{ Semaphore functions } +{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } +{ Create a semaphore, initialized with value, returns NULL on failure. } +function SDL_CreateSemaphore(initial_value: UInt32): PSDL_Sem; +cdecl; external {$IFDEF __GPC__}name 'SDL_CreateSemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CreateSemaphore} + + +{ Destroy a semaphore } +procedure SDL_DestroySemaphore(sem: PSDL_sem); +cdecl; external {$IFDEF __GPC__}name 'SDL_DestroySemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_DestroySemaphore} + +{ This function suspends the calling thread until the semaphore pointed + to by sem has a positive count. It then atomically decreases the semaphore + count. } + +function SDL_SemWait(sem: PSDL_sem): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SemWait'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SemWait} + +{ Non-blocking variant of SDL_SemWait(), returns 0 if the wait succeeds, + SDL_MUTEX_TIMEDOUT if the wait would block, and -1 on error. } + +function SDL_SemTryWait(sem: PSDL_sem): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SemTryWait'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SemTryWait} + +{ Variant of SDL_SemWait() with a timeout in milliseconds, returns 0 if + the wait succeeds, SDL_MUTEX_TIMEDOUT if the wait does not succeed in + the allotted time, and -1 on error. + On some platforms this function is implemented by looping with a delay + of 1 ms, and so should be avoided if possible. } + +function SDL_SemWaitTimeout(sem: PSDL_sem; ms: UInt32): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SemWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SemTryWait} + +{ Atomically increases the semaphore's count (not blocking), returns 0, + or -1 on error. } + +function SDL_SemPost(sem: PSDL_sem): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_SemPost'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SemTryWait} + +{ Returns the current count of the semaphore } + +function SDL_SemValue(sem: PSDL_sem): UInt32; +cdecl; external {$IFDEF __GPC__}name 'SDL_SemValue'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_SemValue} + +{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } +{ Condition variable functions } +{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } +{ Create a condition variable } +function SDL_CreateCond: PSDL_Cond; +cdecl; external {$IFDEF __GPC__}name 'SDL_CreateCond'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CreateCond} + +{ Destroy a condition variable } +procedure SDL_DestroyCond(cond: PSDL_Cond); +cdecl; external {$IFDEF __GPC__}name 'SDL_DestroyCond'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_DestroyCond} + +{ Restart one of the threads that are waiting on the condition variable, + returns 0 or -1 on error. } + +function SDL_CondSignal(cond: PSDL_cond): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CondSignal'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CondSignal} + +{ Restart all threads that are waiting on the condition variable, + returns 0 or -1 on error. } + +function SDL_CondBroadcast(cond: PSDL_cond): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CondBroadcast'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CondBroadcast} + + +{ Wait on the condition variable, unlocking the provided mutex. + The mutex must be locked before entering this function! + Returns 0 when it is signaled, or -1 on error. } + +function SDL_CondWait(cond: PSDL_cond; mut: PSDL_mutex): Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CondWait'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CondWait} + +{ Waits for at most 'ms' milliseconds, and returns 0 if the condition + variable is signaled, SDL_MUTEX_TIMEDOUT if the condition is not + signaled in the allotted time, and -1 on error. + On some platforms this function is implemented by looping with a delay + of 1 ms, and so should be avoided if possible. } + +function SDL_CondWaitTimeout(cond: PSDL_cond; mut: PSDL_mutex; ms: UInt32) : Integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_CondWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CondWaitTimeout} + +{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } +{ Condition variable functions } +{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } + +{ Create a thread } +function SDL_CreateThread(fn: PInt; data: Pointer): PSDL_Thread; +cdecl; external {$IFDEF __GPC__}name 'SDL_CreateThread'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_CreateThread} + +{ Get the 32-bit thread identifier for the current thread } +function SDL_ThreadID: UInt32; +cdecl; external {$IFDEF __GPC__}name 'SDL_ThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_ThreadID} + +{ Get the 32-bit thread identifier for the specified thread, + equivalent to SDL_ThreadID() if the specified thread is NULL. } +function SDL_GetThreadID(thread: PSDL_Thread): UInt32; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetThreadID} + +{ Wait for a thread to finish. + The return code for the thread function is placed in the area + pointed to by 'status', if 'status' is not NULL. } + +procedure SDL_WaitThread(thread: PSDL_Thread; var status: Integer); +cdecl; external {$IFDEF __GPC__}name 'SDL_WaitThread'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_WaitThread} + +{ Forcefully kill a thread without worrying about its state } +procedure SDL_KillThread(thread: PSDL_Thread); +cdecl; external {$IFDEF __GPC__}name 'SDL_KillThread'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_KillThread} + +{------------------------------------------------------------------------------} +{ Get Environment Routines } +{------------------------------------------------------------------------------} +{$IFDEF WIN32} +function _putenv( const variable : Pchar ): integer; +cdecl; +{$ENDIF} + +{$IFDEF Unix} +{$IFDEF FPC} +function _putenv( const variable : Pchar ): integer; +cdecl; external 'libc.so' name 'putenv'; +{$ENDIF} +{$ENDIF} + +{ Put a variable of the form "name=value" into the environment } +//function SDL_putenv(const variable: PChar): integer; cdecl; external {$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name ''; +function SDL_putenv(const variable: PChar): integer; +{$EXTERNALSYM SDL_putenv} + +// The following function has been commented out to encourage developers to use +// SDL_putenv as it it more portable +//function putenv(const variable: PChar): integer; +//{$EXTERNALSYM putenv} + +{$IFDEF WIN32} +{$IFNDEF __GPC__} +function getenv( const name : Pchar ): PChar; cdecl; +{$ENDIF} +{$ENDIF} + +{* Retrieve a variable named "name" from the environment } +//function SDL_getenv(const name: PChar): PChar; cdecl; external {$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name ''; +function SDL_getenv(const name: PChar): PChar; +{$EXTERNALSYM SDL_getenv} + +// The following function has been commented out to encourage developers to use +// SDL_getenv as it it more portable +//function getenv(const name: PChar): PChar; +//{$EXTERNALSYM getenv} + +{* + * This function gives you custom hooks into the window manager information. + * It fills the structure pointed to by 'info' with custom information and + * returns 1 if the function is implemented. If it's not implemented, or + * the version member of the 'info' structure is invalid, it returns 0. + *} +function SDL_GetWMInfo(info : PSDL_SysWMinfo) : integer; +cdecl; external {$IFDEF __GPC__}name 'SDL_GetWMInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_GetWMInfo} + +{------------------------------------------------------------------------------} + +//SDL_loadso.h +{* This function dynamically loads a shared object and returns a pointer + * to the object handle (or NULL if there was an error). + * The 'sofile' parameter is a system dependent name of the object file. + *} +function SDL_LoadObject( const sofile : PChar ) : Pointer; +cdecl; external {$IFDEF __GPC__}name 'SDL_LoadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_LoadObject} + +{* Given an object handle, this function looks up the address of the + * named function in the shared object and returns it. This address + * is no longer valid after calling SDL_UnloadObject(). + *} +function SDL_LoadFunction( handle : Pointer; const name : PChar ) : Pointer; +cdecl; external {$IFDEF __GPC__}name 'SDL_LoadFunction'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_LoadFunction} + +{* Unload a shared object from memory *} +procedure SDL_UnloadObject( handle : Pointer ); +cdecl; external {$IFDEF __GPC__}name 'SDL_UnloadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_UnloadObject} + + + +{------------------------------------------------------------------------------} + +function SDL_Swap32(D: Uint32): Uint32; +{$EXTERNALSYM SDL_Swap32} + +{ FreeAndNil frees the given TObject instance and sets the variable reference + to nil. Be careful to only pass TObjects to this routine. } +procedure FreeAndNil(var Obj); + +{ Exit procedure handling } + +{ AddExitProc adds the given procedure to the run-time library's exit + procedure list. When an application terminates, its exit procedures are + executed in reverse order of definition, i.e. the last procedure passed + to AddExitProc is the first one to get executed upon termination. } +procedure AddExitProc(Proc: TProcedure); + +// Bitwise Checking functions +function IsBitOn( value : integer; bit : Byte ) : boolean; + +function TurnBitOn( value : integer; bit : Byte ) : integer; + +function TurnBitOff( value : integer; bit : Byte ) : integer; + +implementation + +{$IFDEF __GPC__} + {$L 'sdl'} { link sdl.dll.a or libsdl.so or libsdl.a } +{$ENDIF} + +function SDL_TABLESIZE(table: PChar): Integer; +begin + Result := SizeOf(table) div SizeOf(table[0]); +end; + +procedure SDL_OutOfMemory; +begin + {$IFNDEF WIN32} + SDL_Error(SDL_ENOMEM); + {$ENDIF} +end; + +function SDL_RWSeek(context: PSDL_RWops; offset: Integer; whence: Integer) : Integer; +begin + Result := context^.seek(context, offset, whence); +end; + +function SDL_RWTell(context: PSDL_RWops): Integer; +begin + Result := context^.seek(context, 0, 1); +end; + +function SDL_RWRead(context: PSDL_RWops; ptr: Pointer; size: Integer; n: Integer): Integer; +begin + Result := context^.read(context, ptr, size, n); +end; + +function SDL_RWWrite(context: PSDL_RWops; ptr: Pointer; size: Integer; n: Integer): Integer; +begin + Result := context^.write(context, ptr, size, n); +end; + +function SDL_RWClose(context: PSDL_RWops): Integer; +begin + Result := context^.close(context); +end; + +function SDL_LoadWAV(filename: PChar; spec: PSDL_AudioSpec; audio_buf: PUInt8; audiolen: PUInt32): PSDL_AudioSpec; +begin + Result := SDL_LoadWAV_RW(SDL_RWFromFile(filename, 'rb'), 1, spec, audio_buf, audiolen); +end; + +function SDL_CDInDrive( status : TSDL_CDStatus ): LongBool; +begin + Result := ord( status ) > ord( CD_ERROR ); +end; + +procedure FRAMES_TO_MSF(frames: Integer; var M: Integer; var S: Integer; var + F: Integer); +var + value: Integer; +begin + value := frames; + F := value mod CD_FPS; + value := value div CD_FPS; + S := value mod 60; + value := value div 60; + M := value; +end; + +function MSF_TO_FRAMES(M: Integer; S: Integer; F: Integer): Integer; +begin + Result := M * 60 * CD_FPS + S * CD_FPS + F; +end; + +procedure SDL_VERSION(var X: TSDL_Version); +begin + X.major := SDL_MAJOR_VERSION; + X.minor := SDL_MINOR_VERSION; + X.patch := SDL_PATCHLEVEL; +end; + +function SDL_VERSIONNUM(X, Y, Z: Integer): Integer; +begin + Result := X * 1000 + Y * 100 + Z; +end; + +function SDL_COMPILEDVERSION: Integer; +begin + Result := SDL_VERSIONNUM(SDL_MAJOR_VERSION, SDL_MINOR_VERSION, SDL_PATCHLEVEL + ); +end; + +function SDL_VERSION_ATLEAST(X, Y, Z: Integer): LongBool; +begin + Result := (SDL_COMPILEDVERSION >= SDL_VERSIONNUM(X, Y, Z)); +end; + +function SDL_LoadBMP(filename: PChar): PSDL_Surface; +begin + Result := SDL_LoadBMP_RW(SDL_RWFromFile(filename, 'rb'), 1); +end; + +function SDL_SaveBMP(surface: PSDL_Surface; filename: PChar): Integer; +begin + Result := SDL_SaveBMP_RW(surface, SDL_RWFromFile(filename, 'wb'), 1); +end; + +function SDL_BlitSurface(src: PSDL_Surface; srcrect: PSDL_Rect; dst: + PSDL_Surface; + dstrect: PSDL_Rect): Integer; +begin + Result := SDL_UpperBlit(src, srcrect, dst, dstrect); +end; + +function SDL_AllocSurface(flags: UInt32; width, height, depth: Integer; + RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; +begin + Result := SDL_CreateRGBSurface(flags, width, height, depth, RMask, GMask, + BMask, AMask); +end; + +function SDL_MustLock(Surface: PSDL_Surface): Boolean; +begin + Result := ( ( surface^.offset <> 0 ) or + ( ( surface^.flags and ( SDL_HWSURFACE or SDL_ASYNCBLIT or SDL_RLEACCEL ) ) <> 0 ) ); +end; + +function SDL_LockMutex(mutex: PSDL_mutex): Integer; +begin + Result := SDL_mutexP(mutex); +end; + +function SDL_UnlockMutex(mutex: PSDL_mutex): Integer; +begin + Result := SDL_mutexV(mutex); +end; + +{$IFDEF WIN32} +function _putenv( const variable : Pchar ): Integer; +cdecl; external {$IFDEF __GPC__}name '_putenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF __GPC__}; +{$ENDIF} + + +function SDL_putenv(const variable: PChar): Integer; +begin + {$IFDEF WIN32} + Result := _putenv(variable); + {$ENDIF} + + {$IFDEF UNIX} + {$IFDEF FPC} + Result := _putenv(variable); + {$ELSE} + Result := libc.putenv(variable); + {$ENDIF} + {$ENDIF} +end; + +{$IFDEF WIN32} +{$IFNDEF __GPC__} +function getenv( const name : Pchar ): PChar; +cdecl; external {$IFDEF __GPC__}name 'getenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF}; +{$ENDIF} +{$ENDIF} + +function SDL_getenv(const name: PChar): PChar; +begin + {$IFDEF WIN32} + + {$IFDEF __GPC__} + Result := getenv( string( name ) ); + {$ELSE} + Result := getenv( name ); + {$ENDIF} + + {$ELSE} + + {$IFDEF UNIX} + + {$IFDEF FPC} + Result := fpgetenv(name); + {$ELSE} + Result := libc.getenv(name); + {$ENDIF} + + {$ENDIF} + + {$ENDIF} +end; + +function SDL_BUTTON( Button : Integer ) : Integer; +begin + Result := SDL_PRESSED shl ( Button - 1 ); +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; + +procedure FreeAndNil(var Obj); +{$IFNDEF __GPC__} +{$IFNDEF __TMT__} +var + Temp: TObject; +{$ENDIF} +{$ENDIF} +begin +{$IFNDEF __GPC__} +{$IFNDEF __TMT__} + Temp := TObject(Obj); + Pointer(Obj) := nil; + Temp.Free; +{$ENDIF} +{$ENDIF} +end; + +{ Exit procedure handling } +type + PExitProcInfo = ^TExitProcInfo; + TExitProcInfo = record + Next: PExitProcInfo; + SaveExit: Pointer; + Proc: TProcedure; + end; + +var + ExitProcList: PExitProcInfo = nil; + +procedure DoExitProc; +var + P: PExitProcInfo; + Proc: TProcedure; +begin + P := ExitProcList; + ExitProcList := P^.Next; + ExitProc := P^.SaveExit; + Proc := P^.Proc; + Dispose(P); + Proc; +end; + +procedure AddExitProc(Proc: TProcedure); +var + P: PExitProcInfo; +begin + New(P); + P^.Next := ExitProcList; + P^.SaveExit := ExitProc; + P^.Proc := Proc; + ExitProcList := P; + ExitProc := @DoExitProc; +end; + +function IsBitOn( value : integer; bit : Byte ) : boolean; +begin + result := ( ( value and ( 1 shl bit ) ) <> 0 ); +end; + +function TurnBitOn( value : integer; bit : Byte ) : integer; +begin + result := ( value or ( 1 shl bit ) ); +end; + +function TurnBitOff( value : integer; bit : Byte ) : integer; +begin + result := ( value and not ( 1 shl bit ) ); +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 new file mode 100644 index 00000000..bd371c55 --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas @@ -0,0 +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 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 } +{ } +{ 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 new file mode 100644 index 00000000..f8bf902c --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas @@ -0,0 +1,195 @@ +unit sdlgameinterface; +{ + $Id: sdlgameinterface.pas,v 1.3 2004/10/17 18:41:49 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 } +{ } +{ 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.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 : TSDL2DWindow; + procedure ResetInputManager; + procedure LoadSurfaces; virtual; + function PointIsInRect( Point : TPoint; x, y, x1, y1 : integer ) : Boolean; + constructor Create( const aMainWindow : TSDL2DWindow ); + 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 : TSDL2DWindow ); +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; +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; + MainWindow.OnRender := Render; + MainWindow.OnClose := Close; + 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 new file mode 100644 index 00000000..9151168a --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas @@ -0,0 +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 } +{ } +{ Portions created by Tom Jones are } +{ Copyright (C) 2000 - 2001 Tom Jones. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis } +{ Róbert Kisnémeth } +{ } +{ 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 new file mode 100644 index 00000000..2955d17a --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas @@ -0,0 +1,692 @@ +unit sdlinput; +{ + $Id: sdlinput.pas,v 1.7 2004/09/30 22:32:04 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ SDL Input Wrapper } +{ } +{ } +{ The initial developer of this Pascal code was : } +{ Dominique Louis } +{ } +{ Portions created by Dominique Louis are } +{ Copyright (C) 2003 - 2100 Dominique Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis } +{ } +{ 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.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}; + + TSDLMouse = class( TSDLCustomInput ) + private + FDragging : Boolean; + FMousePos : TPoint; + FOnMouseUp: TSDLMouseButtonEvent; + FOnMouseDown: TSDLMouseButtonEvent; + FOnMouseMove: TSDLMouseMoveEvent; + FOnMouseWheel: TSDLMouseWheelEvent; + FCursor : PSDL_Cursor; // 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); + public + destructor Destroy; override; + function UpdateInput( event: TSDL_EVENT ) : Boolean; override; + function MouseIsDown( Button : Integer ) : Boolean; + function MouseIsUp( Button : Integer ) : Boolean; + procedure SetCursor(data, mask: PUInt8; w, h, hot_x, hot_y: Integer); + 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; + 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 + +{ 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 + if FCursor <> nil then + SDL_FreeCursor( FCursor ); + 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.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.SetCursor(data, mask: PUInt8; w, h, hot_x, hot_y: Integer); +begin + if FCursor <> nil then + SDL_FreeCursor( FCursor ); + // create the cursor + FCursor := SDL_CreateCursor( data, mask, w, h, hot_x, hot_y ); + + // set the cursor + SDL_SetCursor( FCursor ); +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; + +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas new file mode 100644 index 00000000..64009176 --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas @@ -0,0 +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" } +{ } +{******************************************************************} +{ + $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 new file mode 100644 index 00000000..4e91ecb8 --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas @@ -0,0 +1,196 @@ +unit sdlticks; +{ + $Id: sdlticks.pas,v 1.1 2004/09/30 22:35:47 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 } +{ } +{ Portions created by Dominique Louis are } +{ Copyright (C) 2004 - 2100 Dominique Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis } +{ } +{ 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.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 + m_startTime : Int64; + m_ticksPerSecond : Int64; + s_lastTime : Int64; + + 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; + + function GetElapsedSeconds( elapsedFrames : Cardinal = 1 ) : single; + + {*************************************************************************** + GetFPS + + Returns the average frames per second over elapsedFrames, which defaults to + one. 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( elapsedFrames : Cardinal = 1 ) : 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 <= targetFPS. + ***************************************************************************} + function LockFPS( targetFPS : Byte ) : single; + end; + +implementation + +{ TSDLTicks } +constructor TSDLTicks.Create; +begin + +end; + +destructor TSDLTicks.Destroy; +begin + + inherited; +end; + +function TSDLTicks.GetElapsedSeconds( elapsedFrames: Cardinal ): single; +var + currentTime : Int64; +begin + // s_lastTime := m_startTime; + + currentTime := SDL_GetTicks; + //QueryPerformanceCounter( currentTime ); + + result := (currentTime - s_lastTime) / m_ticksPerSecond; + + // reset the timer + s_lastTime := currentTime; +end; + +function TSDLTicks.GetFPS( elapsedFrames: Cardinal ): single; +var + currentTime : integer; + fps : single; +begin + // s_lastTime := m_startTime; + + currentTime := SDL_GetTicks; + + fps := elapsedFrames * m_ticksPerSecond / ( currentTime - s_lastTime); + + // reset the timer + s_lastTime := currentTime; + + result := fps; +end; + +function TSDLTicks.Init: boolean; +begin + m_startTime := SDL_GetTicks; + s_lastTime := m_startTime; + m_ticksPerSecond := 1000; + result := true; +end; + +function TSDLTicks.LockFPS(targetFPS: Byte): single; +var + currentTime : integer; + fps : single; +begin + if (targetFPS = 0) then + targetFPS := 1; + + s_lastTime := m_startTime; + + // delay to maintain a constant frame rate + repeat + currentTime := SDL_GetTicks; + fps := m_ticksPerSecond / (currentTime - s_lastTime); + until (fps > targetFPS); + + // reset the timer + s_lastTime := m_startTime; + + result := fps; +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 new file mode 100644 index 00000000..bef83cbc --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas @@ -0,0 +1,4256 @@ +unit sdlutils; +{ + $Id: sdlutils.pas,v 1.4 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 } +{ } +{ Portions created by Tom Jones are } +{ Copyright (C) 2000 - 2001 Tom Jones. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis } +{ Róbert Kisnémeth } +{ } +{ 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.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, + 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 : 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 : 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; + +procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : + cardinal ); +var + SrcColor : cardinal; + Addr : cardinal; + R, G, B : cardinal; +begin + if Color = 0 then + exit; + with DstSurface^ do + begin + Addr := cardinal( 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 : cardinal; + R, G, B : cardinal; +begin + if Color = 0 then + exit; + with DstSurface^ do + begin + Addr := cardinal( 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 : 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 + 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 : 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 := 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 : cardinal; + _ebx, _esi, _edi, _esp : cardinal; + 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 := 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; + 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 : cardinal; + _ebx, _esi, _edi, _esp : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod, TextMod : cardinal; + SrcColor, TransparentColor, TextureColor : 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 := 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; + BPP := DestSurface.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( 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( 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_MoveLine( Surface : PSDL_Surface; x1, x2, y1, xofs, depth : integer ); +var + src_pixels, dst_pixels : PUint8; + i : integer; +begin + src_pixels := PUint8( integer( Surface^.pixels ) + Surface^.w * y1 * depth + x2 * + depth ); + dst_pixels := PUint8( integer( 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( 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; +{ 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( Uint32( 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( 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: 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; + + 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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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: UInt32; + 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 := UInt32(Src.Pixels); + WriteRow := UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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: UInt32; + 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 := UInt32(Src.Pixels); + WriteRow := UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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(UInt32(ReadRow), SrcPitch); + inc(UInt32(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 : 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 + 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 )^; + 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; + 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 )^; + 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 : 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; + +// 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 new file mode 100644 index 00000000..ef290071 --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas @@ -0,0 +1,564 @@ +unit sdlwindow; +{ + $Id: sdlwindow.pas,v 1.7 2004/09/30 22:35:47 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ SDL Window Wrapper } +{ } +{ } +{ The initial developer of this Pascal code was : } +{ Dominique Louis } +{ } +{ Portions created by Dominique Louis are } +{ Copyright (C) 2004 - 2100 Dominique Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis } +{ } +{ 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.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; + + TSDL2DWindow = class( TSDLBaseWindow ) + 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; + property OnCreate; + property OnDestroy; + property OnClose; + property OnShow; + property OnResize; + property OnRender; + property OnUpdate; + property DisplaySurface; + end; + + TSDL3DWindow = class( TSDLBaseWindow ) + 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; + property OnCreate; + property OnDestroy; + property OnClose; + property OnShow; + property OnResize; + property OnRender; + property OnUpdate; + property DisplaySurface; + 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 new file mode 100644 index 00000000..97e26520 --- /dev/null +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas @@ -0,0 +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 } +{ } +{ 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. -- cgit v1.2.3 From c4eae67bc403eb26af8a1c91f9eb67dc92a8b4b6 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 5 Feb 2008 11:40:45 +0000 Subject: updated to latest version of JEDI SDL JEDI-SDL v1.0 Final RC ( 2008-01-29 05:46 ) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@811 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc | 129 ++- Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas | 2 - Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas | 17 +- Game/Code/lib/JEDI-SDL/SDL/Pas/sdl.pas | 679 ++++++++----- .../Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas | 19 +- Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas | 99 +- Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas | 1053 +++++++++++--------- Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas | 42 +- 8 files changed, 1235 insertions(+), 805 deletions(-) (limited to 'Game/Code/lib/JEDI-SDL/SDL/Pas') 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 48a789fd..31283d40 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc @@ -1,5 +1,5 @@ { - $Id: jedi-sdl.inc,v 1.9 2004/12/23 23:42:17 savage Exp $ + $Id: jedi-sdl.inc,v 1.15 2007/05/29 21:30:48 savage Exp $ } {******************************************************************************} { } @@ -74,6 +74,24 @@ { } (* $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. @@ -148,73 +166,138 @@ {$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 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 9??} + {$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 UNIX} - {$ifdef VER150} - {$define KYLIX} - {$endif} +{$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 VER140} - {$define KYLIX} +{$IFDEF UNIX} + {$ifdef VER140} // Kylix 1 & 2 + {$DEFINE KYLIX} + {$DEFINE KYLIX1UP} + {$DEFINE KYLIX2UP} + {$DEFINE HAS_TYPES} {$endif} - {$ifdef VER140} - {$define KYLIX} + {$ifdef VER150} // Kylix 3 + {$DEFINE KYLIX} + {$DEFINE KYLIX1UP} + {$DEFINE KYLIX2UP} + {$DEFINE KYLIX3UP} + {$DEFINE HAS_TYPES} {$endif} {$ENDIF UNIX} @@ -227,14 +310,14 @@ {$IFDEF Delphi} {$DEFINE Windows} {$DEFINE USE_STDCALL} + //{$ALIGN ON} {$ENDIF Delphi} {$IFDEF FPC} {$MODE Delphi} { use Delphi compatibility mode } {$H+} - {$PACKRECORDS 4} // Added for record + {$PACKRECORDS C} // Added for record {$MACRO ON} // Added For OpenGL - {$THREADING on} {$DEFINE Delphi} {$DEFINE UseAT} {$UNDEF USE_STDCALL} @@ -242,7 +325,7 @@ {$DEFINE NO_EXPORTS} {$DEFINE Has_Int64} {$DEFINE NOCRT} - {$IFDEF unix} + {$IFDEF UNIX} {$DEFINE fpc_unix} {$ELSE} {$DEFINE __OS_DOS__} @@ -250,6 +333,7 @@ {$IFDEF WIN32} {$DEFINE UseWin} {$ENDIF} + {$DEFINE HAS_TYPES} {$ENDIF FPC} {$IFDEF Win16} @@ -335,3 +419,20 @@ {$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 54841840..0cdf44c7 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas @@ -194,8 +194,6 @@ UNIT libxmlparser; {$I jedi-sdl.inc} -{$ALIGN ON} - INTERFACE USES diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas index 88bb1698..461fa261 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas @@ -1,6 +1,6 @@ unit logger; { - $Id: logger.pas,v 1.1 2004/02/05 00:08:20 savage Exp $ + $Id: logger.pas,v 1.2 2006/11/26 16:58:04 savage Exp $ } {******************************************************************************} @@ -63,6 +63,9 @@ unit logger; {******************************************************************************} { $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 @@ -107,10 +110,20 @@ implementation { TLogger } constructor TLogger.Create; +var + FileName : string; + FileNo : integer; begin FApplicationName := ExtractFileName( ParamStr(0) ); FApplicationPath := ExtractFilePath( ParamStr(0) ); - AssignFile( FFileHandle, FApplicationPath + ChangeFileExt( FApplicationName, '.log' ) ); + 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} );*) diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl.pas index ad5d783a..29bc7123 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl.pas @@ -1,6 +1,6 @@ unit sdl; { - $Id: sdl.pas,v 1.17 2005/01/03 18:40:59 savage Exp $ + $Id: sdl.pas,v 1.38 2008/01/26 10:09:32 savage Exp $ } {******************************************************************************} @@ -36,10 +36,10 @@ unit sdl; { SDL_loadso.h } { } { The initial developer of this Pascal code was : } -{ Dominqiue Louis } +{ Dominique Louis } { } -{ Portions created by Dominqiue Louis are } -{ Copyright (C) 2000 - 2004 Dominqiue Louis. } +{ Portions created by Dominique Louis are } +{ Copyright (C) 2000 - 2004 Dominique Louis. } { } { } { Contributor(s) } @@ -168,6 +168,63 @@ unit sdl; { } { $Log: sdl.pas,v $ + Revision 1.38 2008/01/26 10:09:32 savage + Added SDL_BUTTON_X1 and SDL_BUTTON_X2 constants for extended mouse buttons. Now makes SDL v1.2.13 compliant. + + Revision 1.37 2007/12/20 22:36:56 savage + Added SKYOS support, thanks to Sebastian-Torsten Tillmann + + Revision 1.36 2007/12/05 22:52:04 savage + Better Mac OS X support for Frameworks. + + Revision 1.35 2007/12/02 22:41:13 savage + Change for Mac OS X to link to SDL Framework + + Revision 1.34 2007/08/26 23:50:53 savage + Jonas supplied another fix. + + Revision 1.33 2007/08/26 15:59:46 savage + Mac OS changes as suggested by Jonas Maebe + + Revision 1.32 2007/08/22 21:18:43 savage + Thanks to Dean for his MouseDelta patch. + + Revision 1.31 2007/05/29 21:30:48 savage + Changes as suggested by Almindor for 64bit compatibility. + + Revision 1.30 2007/05/29 19:31:03 savage + Fix to TSDL_Overlay structure - thanks David Pethes (aka imcold) + + Revision 1.29 2007/05/20 20:29:11 savage + Initial Changes to Handle 64 Bits + + Revision 1.26 2007/02/11 13:38:04 savage + Added Nintendo DS support - Thanks Dean. + + Revision 1.25 2006/12/02 00:12:52 savage + Updated to latest version + + Revision 1.24 2006/05/18 21:10:04 savage + Added 1.2.10 Changes + + Revision 1.23 2005/12/04 23:17:52 drellis + Added declaration of SInt8 and PSInt8 + + Revision 1.22 2005/05/24 21:59:03 savage + Re-arranged uses clause to work on Win32 and Linux, Thanks again Michalis. + + Revision 1.21 2005/05/22 18:42:31 savage + Changes as suggested by Michalis Kamburelis. Thanks again. + + Revision 1.20 2005/04/10 11:48:33 savage + Changes as suggested by Michalis, thanks. + + Revision 1.19 2005/01/05 01:47:06 savage + Changed LibName to reflect what MacOS X should have. ie libSDL*-1.2.0.dylib respectively. + + Revision 1.18 2005/01/04 23:14:41 savage + Changed LibName to reflect what most Linux distros will have. ie libSDL*-1.2.so.0 respectively. + Revision 1.17 2005/01/03 18:40:59 savage Updated Version number to reflect latest one @@ -241,35 +298,54 @@ unit sdl; {$I jedi-sdl.inc} -{$ALIGN ON} - interface uses {$IFDEF __GPC__} system, + {$IFDEF WINDOWS} + wintypes, + {$ELSE} + {$ENDIF} gpc; {$ENDIF} -{$IFDEF WIN32} - {$IFNDEF __GPC__} +{$IFDEF HAS_TYPES} + Types{$IFNDEF NDS},{$ELSE};{$ENDIF} +{$ENDIF} + +{$IFDEF WINDOWS} Windows; - {$ENDIF} {$ENDIF} {$IFDEF UNIX} {$IFDEF FPC} - {$IFDEF Ver1_0} - linux, - {$ELSE} - pthreads, - baseunix, - unix, - {$ENDIF} - x, - xlib; + {$IFNDEF SKYOS} + pthreads, + {$ENDIF} + baseunix, + {$IFNDEF GP2X} + {$IFNDEF DARWIN} + {$IFNDEF SKYOS} + unix, + {$ELSE} + unix; + {$ENDIF} + {$ELSE} + unix; + {$ENDIF} + {$ELSE} + unix; + {$ENDIF} + {$IFNDEF GP2X} + {$IFNDEF DARWIN} + {$IFNDEF SKYOS} + x, + xlib; + {$ENDIF} + {$ENDIF} + {$ENDIF} {$ELSE} - Types, Libc, Xlib; {$ENDIF} @@ -280,22 +356,45 @@ uses {$ENDIF} const -{$IFDEF WIN32} +{$IFDEF WINDOWS} SDLLibName = 'SDL.dll'; {$ENDIF} {$IFDEF UNIX} {$IFDEF DARWIN} - SDLLibName = 'libSDL.dylib'; + SDLLibName = 'libSDL-1.2.0.dylib'; {$ELSE} + {$IFDEF FPC} SDLLibName = 'libSDL.so'; + {$ELSE} + SDLLibName = 'libSDL-1.2.so.0'; + {$ENDIF} {$ENDIF} {$ENDIF} {$IFDEF MACOS} SDLLibName = 'SDL'; + {$linklib libSDL} +{$ENDIF} + +{$IFDEF NDS} + SDLLibName = 'libSDL.a'; + {$linklib libSDL.a} + {$linklib libnds9.a} + {$linklib libc.a} + {$linklib libgcc.a} + {$linklib libsysbase.a} {$ENDIF} + // SDL_verion.h constants + // Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL + SDL_MAJOR_VERSION = 1; +{$EXTERNALSYM SDL_MAJOR_VERSION} + SDL_MINOR_VERSION = 2; +{$EXTERNALSYM SDL_MINOR_VERSION} + SDL_PATCHLEVEL = 13; +{$EXTERNALSYM SDL_PATCHLEVEL} + // SDL.h constants SDL_INIT_TIMER = $00000001; {$EXTERNALSYM SDL_INIT_TIMER} @@ -438,15 +537,6 @@ const SDL_HAT_LEFTDOWN = SDL_HAT_LEFT or SDL_HAT_DOWN; {$EXTERNALSYM SDL_HAT_LEFTDOWN} - // SDL_verion.h constants - // Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL - SDL_MAJOR_VERSION = 1; -{$EXTERNALSYM SDL_MAJOR_VERSION} - SDL_MINOR_VERSION = 2; -{$EXTERNALSYM SDL_MINOR_VERSION} - SDL_PATCHLEVEL = 8; -{$EXTERNALSYM SDL_PATCHLEVEL} - // SDL_events.h constants SDL_NOEVENT = 0; // Unused (do not remove) {$EXTERNALSYM SDL_NOEVENT} @@ -1059,6 +1149,47 @@ const SDLK_EURO = 321; // Some european keyboards {$EXTERNALSYM SDLK_EURO} +{$IFDEF GP2X} +SDLK_GP2X_UP = 0; +{$EXTERNALSYM SDLK_GP2X_UP} +SDLK_GP2X_UPLEFT = 1; +{$EXTERNALSYM SDLK_GP2X_UPLEFT} +SDLK_GP2X_LEFT = 2; +{$EXTERNALSYM SDLK_GP2X_LEFT} +SDLK_GP2X_DOWNLEFT = 3; +{$EXTERNALSYM SDLK_GP2X_DOWNLEFT} +SDLK_GP2X_DOWN = 4; +{$EXTERNALSYM SDLK_GP2X_DOWN} +SDLK_GP2X_DOWNRIGHT = 5; +{$EXTERNALSYM SDLK_GP2X_DOWNRIGHT} +SDLK_GP2X_RIGHT = 6; +{$EXTERNALSYM SDLK_GP2X_RIGHT} +SDLK_GP2X_UPRIGHT = 7; +{$EXTERNALSYM SDLK_GP2X_UPRIGHT} +SDLK_GP2X_START = 8; +{$EXTERNALSYM SDLK_GP2X_START} +SDLK_GP2X_SELECT = 9; +{$EXTERNALSYM SDLK_GP2X_SELECT} +SDLK_GP2X_L = 10; +{$EXTERNALSYM SDLK_GP2X_L} +SDLK_GP2X_R = 11; +{$EXTERNALSYM SDLK_GP2X_R} +SDLK_GP2X_A = 12; +{$EXTERNALSYM SDLK_GP2X_A} +SDLK_GP2X_B = 13; +{$EXTERNALSYM SDLK_GP2X_B} +SDLK_GP2X_Y = 14; +{$EXTERNALSYM SDLK_GP2X_Y} +SDLK_GP2X_X = 15; +{$EXTERNALSYM SDLK_GP2X_X} +SDLK_GP2X_VOLUP = 16; +{$EXTERNALSYM SDLK_GP2X_VOLUP} +SDLK_GP2X_VOLDOWN = 17; +{$EXTERNALSYM SDLK_GP2X_VOLDOWN} +SDLK_GP2X_CLICK = 18; +{$EXTERNALSYM SDLK_GP2X_CLICK} +{$ENDIF} + // Enumeration of valid key mods (possibly OR'd together) KMOD_NONE = $0000; {$EXTERNALSYM KMOD_NONE} @@ -1173,25 +1304,36 @@ const Button 1: Left mouse button Button 2: Middle mouse button Button 3: Right mouse button - Button 4: Mouse Wheel Up - Button 5: Mouse Wheel Down + Button 4: Mouse Wheel Up (may also be a real button) + Button 5: Mouse Wheel Down (may also be a real button) + Button 6: Mouse X1 (may also be a real button) + Button 7: Mouse X2 (may also be a real button) } - SDL_BUTTON_LEFT = 1; + SDL_BUTTON_LEFT = 1; {$EXTERNALSYM SDL_BUTTON_LEFT} - SDL_BUTTON_MIDDLE = 2; + SDL_BUTTON_MIDDLE = 2; {$EXTERNALSYM SDL_BUTTON_MIDDLE} - SDL_BUTTON_RIGHT = 3; + SDL_BUTTON_RIGHT = 3; {$EXTERNALSYM SDL_BUTTON_RIGHT} - SDL_BUTTON_WHEELUP = 4; + SDL_BUTTON_WHEELUP = 4; {$EXTERNALSYM SDL_BUTTON_WHEELUP} SDL_BUTTON_WHEELDOWN = 5; {$EXTERNALSYM SDL_BUTTON_WHEELDOWN} + SDL_BUTTON_X1 = 6; +{$EXTERNALSYM SDL_BUTTON_X1} + SDL_BUTTON_X2 = 7; +{$EXTERNALSYM SDL_BUTTON_X2} + SDL_BUTTON_LMASK = SDL_PRESSED shl (SDL_BUTTON_LEFT - 1); {$EXTERNALSYM SDL_BUTTON_LMASK} SDL_BUTTON_MMASK = SDL_PRESSED shl (SDL_BUTTON_MIDDLE - 1); {$EXTERNALSYM SDL_BUTTON_MMASK} - SDL_BUTTON_RMask = SDL_PRESSED shl (SDL_BUTTON_RIGHT - 1); -{$EXTERNALSYM SDL_BUTTON_RMask} + SDL_BUTTON_RMASK = SDL_PRESSED shl (SDL_BUTTON_RIGHT - 1); +{$EXTERNALSYM SDL_BUTTON_RMASK} + SDL_BUTTON_X1MASK = SDL_PRESSED shl (SDL_BUTTON_X1 - 1); +{$EXTERNALSYM SDL_BUTTON_X1MASK} + SDL_BUTTON_X2MASK = SDL_PRESSED shl (SDL_BUTTON_X2 - 1); +{$EXTERNALSYM SDL_BUTTON_X2MASK} // SDL_active.h constants // The available application states @@ -1233,6 +1375,7 @@ type PUInt8Array = ^TUInt8Array; PUInt8 = ^UInt8; + PPUInt8 = ^PUInt8; UInt8 = Byte; {$EXTERNALSYM UInt8} TUInt8Array = array [0..MAXINT shr 1] of UInt8; @@ -1241,6 +1384,10 @@ type UInt16 = word; {$EXTERNALSYM UInt16} + PSInt8 = ^SInt8; + SInt8 = Shortint; +{$EXTERNALSYM SInt8} + PSInt16 = ^SInt16; SInt16 = smallint; {$EXTERNALSYM SInt16} @@ -1675,7 +1822,7 @@ type {$ENDIF} // The windows custom event structure -{$IFDEF Win32} +{$IFDEF WINDOWS} PSDL_SysWMmsg = ^TSDL_SysWMmsg; TSDL_SysWMmsg = record version: TSDL_version; @@ -1693,7 +1840,13 @@ type version : TSDL_version; subsystem : TSDL_SysWm; {$IFDEF FPC} + {$IFNDEF GP2X} + {$IFNDEF DARWIN} + {$IFNDEF SKYOS} event : TXEvent; + {$ENDIF} + {$ENDIF} + {$ENDIF} {$ELSE} event : XEvent; {$ENDIF} @@ -1710,7 +1863,7 @@ type {$ENDIF} // The Windows custom window manager information structure -{$IFDEF Win32} +{$IFDEF WINDOWS} PSDL_SysWMinfo = ^TSDL_SysWMinfo; TSDL_SysWMinfo = record version : TSDL_version; @@ -1720,6 +1873,9 @@ type // The Linux custom window manager information structure {$IFDEF Unix} + {$IFNDEF GP2X} + {$IFNDEF DARWIN} + {$IFNDEF SKYOS} TX11 = record display : PDisplay; // The X11 display window : TWindow ; // The X11 display window */ @@ -1735,12 +1891,21 @@ type fswindow : TWindow ; // The X11 fullscreen window */ wmwindow : TWindow ; // The X11 managed input window */ end; - + {$ENDIF} + {$ENDIF} + {$ENDIF} + PSDL_SysWMinfo = ^TSDL_SysWMinfo; TSDL_SysWMinfo = record version : TSDL_version ; subsystem : TSDL_SysWm; + {$IFNDEF GP2X} + {$IFNDEF DARWIN} + {$IFNDEF SKYOS} X11 : TX11; + {$ENDIF} + {$ENDIF} + {$ENDIF} end; {$ELSE} // The generic custom window manager information structure @@ -1839,7 +2004,7 @@ type alpha: UInt8; // Alpha value information (per-surface alpha) end; -{$IFDEF WIN32} +{$IFDEF WINDOWS} {PPrivate_hwdata = ^TPrivate_hwdata; TPrivate_hwdata = record dd_surface : IDIRECTDRAWSURFACE3; @@ -1939,6 +2104,8 @@ type UnusedBits3: UInt8; // Unused at this point video_mem: UInt32; // The total amount of video memory (in K) vfmt: PSDL_PixelFormat; // Value: The format of the video surface + current_w : SInt32; // Value: The current video mode width + current_h : SInt32; // Value: The current video mode height end; // The YUV hardware video overlay @@ -1949,8 +2116,8 @@ type planes: Integer; // Number of planes in the overlay. Usually either 1 or 3 pitches: PUInt16; // An array of pitches, one for each plane. Pitch is the length of a row in bytes. - pixels: PUInt8; - // An array of pointers to teh data of each plane. The overlay should be locked before these pointers are used. + pixels: PPUInt8; + // An array of pointers to the data of each plane. The overlay should be locked before these pointers are used. hw_overlay: UInt32; // This will be set to 1 if the overlay is hardware accelerated. end; @@ -1971,7 +2138,9 @@ type SDL_GL_ACCUM_ALPHA_SIZE, SDL_GL_STEREO, SDL_GL_MULTISAMPLEBUFFERS, - SDL_GL_MULTISAMPLESAMPLES); + SDL_GL_MULTISAMPLESAMPLES, + SDL_GL_ACCELERATED_VISUAL, + SDL_GL_SWAP_CONTROL); @@ -1987,7 +2156,7 @@ type // SDL_mutex.h types -{$IFDEF WIN32} +{$IFDEF WINDOWS} PSDL_Mutex = ^TSDL_Mutex; TSDL_Mutex = record id: THANDLE; @@ -2005,6 +2174,15 @@ type end; {$ENDIF} +{$IFDEF NDS} + PSDL_mutex = ^TSDL_Mutex; + TSDL_Mutex = record + recursive: Integer; + Owner: UInt32; + sem: PSDL_sem; + end; +{$ENDIF} + {$IFDEF __MACH__} {$define USE_NAMED_SEMAPHORES} // Broken sem_getvalue() in MacOS X Public Beta */ @@ -2012,8 +2190,8 @@ type {$ENDIF} PSDL_semaphore = ^TSDL_semaphore; -{$IFDEF WIN32} - // Win32 or Machintosh +{$IFDEF WINDOWS} + // WINDOWS or Machintosh TSDL_semaphore = record id: THANDLE; count: UInt32; @@ -2065,7 +2243,7 @@ PSDL_semaphore = ^TSDL_semaphore; end; // SDL_thread.h types -{$IFDEF WIN32} +{$IFDEF WINDOWS} TSYS_ThreadHandle = THandle; {$ENDIF} @@ -2073,6 +2251,10 @@ PSDL_semaphore = ^TSDL_semaphore; TSYS_ThreadHandle = pthread_t; {$ENDIF} +{$IFDEF NDS} + TSYS_ThreadHandle = Integer; +{$ENDIF} + { This is the system-independent thread info structure } PSDL_Thread = ^TSDL_Thread; TSDL_Thread = record @@ -2103,17 +2285,34 @@ PSDL_semaphore = ^TSDL_semaphore; TWordArray = array[0..16383] of Word; PPoint = ^TPoint; - TPoint = record - x: Longint; - y: Longint; - end; + {$IFDEF HAS_TYPES} + TPoint = Types.TPoint; + {$ELSE} + {$IFDEF WINDOWS} + {$IFDEF __GPC__} + TPoint = wintypes.TPoint; + {$ELSE} + TPoint = Windows.TPoint; + {$ENDIF} + {$ELSE} + //Can't define TPoint : neither Types nor Windows unit available. + {$ENDIF} + {$ENDIF} PRect = ^TRect; - TRect = record - case Integer of - 0: (Left, Top, Right, Bottom: Integer); - 1: (TopLeft, BottomRight: TPoint); - end; + {$IFDEF HAS_TYPES} + TRect = Types.TRect; + {$ELSE} + {$IFDEF WINDOWS} + {$IFDEF __GPC__} + TRect = wintypes.TRect; + {$ELSE} + TRect = Windows.TRect; + {$ENDIF} + {$ELSE} + //Can't define TRect: neither Types nor Windows unit available. + {$ENDIF} + {$ENDIF} { Generic procedure pointer } TProcedure = procedure; @@ -2128,17 +2327,17 @@ PSDL_semaphore = ^TSDL_semaphore; signal handlers for some commonly ignored fatal signals (like SIGSEGV) } function SDL_Init( flags : UInt32 ) : Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_Init} // This function initializes specific SDL subsystems function SDL_InitSubSystem( flags : UInt32 ) : Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_InitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_InitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_InitSubSystem} // This function cleans up specific SDL subsystems procedure SDL_QuitSubSystem( flags : UInt32 ); -cdecl; external {$IFDEF __GPC__}name 'SDL_QuitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_QuitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_QuitSubSystem} { This function returns mask of the specified subsystems which have @@ -2146,26 +2345,26 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_QuitSubSystem'{$ELSE} SDLLibName{$ENDI If 'flags' is 0, it returns a mask of all initialized subsystems. } function SDL_WasInit( flags : UInt32 ): UInt32; -cdecl; external {$IFDEF __GPC__}name 'SDL_WasInit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WasInit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WasInit} { This function cleans up all initialized subsystems and unloads the dynamically linked library. You should call it upon all exit conditions. } procedure SDL_Quit; -cdecl; external {$IFDEF __GPC__}name 'SDL_Quit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Quit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_Quit} -{$IFDEF WIN32} +{$IFDEF WINDOWS} // This should be called from your WinMain() function, if any function SDL_RegisterApp(name: PChar; style: UInt32; h_Inst: Pointer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_RegisterApp'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RegisterApp'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_RegisterApp} {$ENDIF} {$IFDEF __MACH__} // This should be called from your main() function, if any procedure SDL_InitQuickDraw( the_qd: QDGlobals ); -cdecl; external {$IFDEF __GPC__}name 'SDL_InitQuickDraw'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_InitQuickDraw'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_InitQuickDraw} {$ENDIF} @@ -2183,18 +2382,18 @@ function SDL_TableSize( table: PChar ): Integer; {------------------------------------------------------------------------------} // Public functions function SDL_GetError: PChar; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetError'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetError'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetError} procedure SDL_SetError(fmt: PChar); -cdecl; external {$IFDEF __GPC__}name 'SDL_SetError'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetError'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetError} procedure SDL_ClearError; -cdecl; external {$IFDEF __GPC__}name 'SDL_ClearError'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ClearError'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_ClearError} -{$IFNDEF WIN32} +{$IFNDEF WINDOWS} procedure SDL_Error(Code: TSDL_errorcode); -cdecl; external {$IFDEF __GPC__}name 'SDL_Error'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Error'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_Error} {$ENDIF} @@ -2207,24 +2406,24 @@ procedure SDL_OutOfMemory; // Functions to create SDL_RWops structures from various data sources function SDL_RWFromFile(filename, mode: PChar): PSDL_RWops; -cdecl; external {$IFDEF __GPC__}name 'SDL_RWFromFile'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromFile'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_RWFromFile} procedure SDL_FreeRW(area: PSDL_RWops); -cdecl; external {$IFDEF __GPC__}name 'SDL_FreeRW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeRW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_FreeRW} //fp is FILE *fp ??? function SDL_RWFromFP(fp: Pointer; autoclose: Integer): PSDL_RWops; -cdecl; external {$IFDEF __GPC__}name 'SDL_RWFromFP'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromFP'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_RWFromFP} function SDL_RWFromMem(mem: Pointer; size: Integer): PSDL_RWops; -cdecl; external {$IFDEF __GPC__}name 'SDL_RWFromMem'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromMem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_RWFromMem} function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops; -cdecl; external {$IFDEF __GPC__}name 'SDL_RWFromConstMem'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromConstMem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_RWFromConstMem} function SDL_AllocRW: PSDL_RWops; -cdecl; external {$IFDEF __GPC__}name 'SDL_AllocRW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AllocRW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_AllocRW} function SDL_RWSeek(context: PSDL_RWops; offset: Integer; whence: Integer) : Integer; @@ -2245,28 +2444,28 @@ function SDL_RWClose(context: PSDL_RWops): Integer; { Get the number of milliseconds since the SDL library initialization. } { Note that this value wraps if the program runs for more than ~49 days. } function SDL_GetTicks: UInt32; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetTicks'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetTicks'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetTicks} // Wait a specified number of milliseconds before returning procedure SDL_Delay(msec: UInt32); -cdecl; external {$IFDEF __GPC__}name 'SDL_Delay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Delay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_Delay} { Add a new timer to the pool of timers already running. } { Returns a timer ID, or NULL when an error occurs. } function SDL_AddTimer(interval: UInt32; callback: TSDL_NewTimerCallback; param : Pointer): PSDL_TimerID; -cdecl; external {$IFDEF __GPC__}name 'SDL_AddTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AddTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_AddTimer} { Remove one of the multiple timers knowing its ID. } { Returns a boolean value indicating success. } function SDL_RemoveTimer(t: PSDL_TimerID): TSDL_Bool; -cdecl; external {$IFDEF __GPC__}name 'SDL_RemoveTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RemoveTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_RemoveTimer} function SDL_SetTimer(interval: UInt32; callback: TSDL_TimerCallback): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SetTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetTimer} {------------------------------------------------------------------------------} @@ -2278,10 +2477,10 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_SetTimer'{$ELSE} SDLLibName{$ENDIF __G You should normally use SDL_Init() or SDL_InitSubSystem(). } function SDL_AudioInit(driver_name: PChar): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_AudioInit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AudioInit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_AudioInit} procedure SDL_AudioQuit; -cdecl; external {$IFDEF __GPC__}name 'SDL_AudioQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AudioQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_AudioQuit} { This function fills the given character buffer with the name of the @@ -2289,7 +2488,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_AudioQuit'{$ELSE} SDLLibName{$ENDIF __ been initialized. It returns NULL if no driver has been initialized. } function SDL_AudioDriverName(namebuf: PChar; maxlen: Integer): PChar; -cdecl; external {$IFDEF __GPC__}name 'SDL_AudioDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AudioDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_AudioDriverName} { This function opens the audio device with the desired parameters, and @@ -2333,12 +2532,12 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_AudioDriverName'{$ELSE} SDLLibName{$EN any local mixing buffers after you open the audio device. } function SDL_OpenAudio(desired, obtained: PSDL_AudioSpec): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_OpenAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_OpenAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_OpenAudio} { Get the current audio state: } function SDL_GetAudioStatus: TSDL_Audiostatus; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetAudioStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetAudioStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetAudioStatus} { This function pauses and unpauses the audio callback processing. @@ -2348,7 +2547,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetAudioStatus'{$ELSE} SDLLibName{$END Silence will be written to the audio device during the pause. } procedure SDL_PauseAudio(pause_on: Integer); -cdecl; external {$IFDEF __GPC__}name 'SDL_PauseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PauseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_PauseAudio} { This function loads a WAVE from the data source, automatically freeing @@ -2369,7 +2568,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_PauseAudio'{$ELSE} SDLLibName{$ENDIF _ function SDL_LoadWAV_RW(src: PSDL_RWops; freesrc: Integer; spec: PSDL_AudioSpec; audio_buf: PUInt8; audiolen: PUInt32): PSDL_AudioSpec; -cdecl; external {$IFDEF __GPC__}name 'SDL_LoadWAV_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadWAV_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_LoadWAV_RW} // Compatibility convenience function -- loads a WAV from a file @@ -2380,7 +2579,7 @@ function SDL_LoadWAV(filename: PChar; spec: PSDL_AudioSpec; audio_buf: { This function frees data previously allocated with SDL_LoadWAV_RW() } procedure SDL_FreeWAV(audio_buf: PUInt8); -cdecl; external {$IFDEF __GPC__}name 'SDL_FreeWAV'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeWAV'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_FreeWAV} { This function takes a source format and rate and a destination format @@ -2391,7 +2590,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_FreeWAV'{$ELSE} SDLLibName{$ENDIF __GP function SDL_BuildAudioCVT(cvt: PSDL_AudioCVT; src_format: UInt16; src_channels: UInt8; src_rate: Integer; dst_format: UInt16; dst_channels: UInt8; dst_rate: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_BuildAudioCVT'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_BuildAudioCVT'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_BuildAudioCVT} { Once you have initialized the 'cvt' structure using SDL_BuildAudioCVT(), @@ -2402,7 +2601,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_BuildAudioCVT'{$ELSE} SDLLibName{$ENDI cvt->buf should be allocated after the cvt structure is initialized by SDL_BuildAudioCVT(), and should be cvt->len*cvt->len_mult bytes long. } function SDL_ConvertAudio(cvt: PSDL_AudioCVT): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_ConvertAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ConvertAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_ConvertAudio} { This takes two audio buffers of the playing audio format and mixes @@ -2412,7 +2611,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_ConvertAudio'{$ELSE} SDLLibName{$ENDIF This is provided for convenience -- you can mix your own audio data. } procedure SDL_MixAudio(dst, src: PUInt8; len: UInt32; volume: Integer); -cdecl; external {$IFDEF __GPC__}name 'SDL_MixAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_MixAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_MixAudio} { The lock manipulated by these functions protects the callback function. @@ -2420,16 +2619,16 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_MixAudio'{$ELSE} SDLLibName{$ENDIF __G callback function is not running. Do not call these from the callback function or you will cause deadlock. } procedure SDL_LockAudio; -cdecl; external {$IFDEF __GPC__}name 'SDL_LockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_LockAudio} procedure SDL_UnlockAudio; -cdecl; external {$IFDEF __GPC__}name 'SDL_UnlockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnlockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_UnlockAudio} { This function shuts down audio processing and closes the audio device. } procedure SDL_CloseAudio; -cdecl; external {$IFDEF __GPC__}name 'SDL_CloseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CloseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CloseAudio} {------------------------------------------------------------------------------} @@ -2440,7 +2639,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_CloseAudio'{$ELSE} SDLLibName{$ENDIF _ SDL_Init() has not been called with the SDL_INIT_CDROM flag. } function SDL_CDNumDrives: Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDNumDrives'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDNumDrives'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDNumDrives} { Returns a human-readable, system-dependent identifier for the CD-ROM. @@ -2450,7 +2649,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_CDNumDrives'{$ELSE} SDLLibName{$ENDIF "/dev/disk/ide/1/master" } function SDL_CDName(drive: Integer): PChar; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDName} { Opens a CD-ROM drive for access. It returns a drive handle on success, @@ -2460,7 +2659,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_CDName'{$ELSE} SDLLibName{$ENDIF __GPC Drives are numbered starting with 0. Drive 0 is the system default CD-ROM. } function SDL_CDOpen(drive: Integer): PSDL_CD; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDOpen} { This function returns the current status of the given drive. @@ -2468,7 +2667,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_CDOpen'{$ELSE} SDLLibName{$ENDIF __GPC play position of the CD will be stored in the SDL_CD structure. } function SDL_CDStatus(cdrom: PSDL_CD): TSDL_CDStatus; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDStatus} { Play the given CD starting at 'start_track' and 'start_frame' for 'ntracks' @@ -2495,7 +2694,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_CDStatus'{$ELSE} SDLLibName{$ENDIF __G function SDL_CDPlayTracks(cdrom: PSDL_CD; start_track: Integer; start_frame: Integer; ntracks: Integer; nframes: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDPlayTracks'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDPlayTracks'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDPlayTracks} @@ -2503,32 +2702,32 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_CDPlayTracks'{$ELSE} SDLLibName{$ENDIF It returns 0, or -1 if there was an error. } function SDL_CDPlay(cdrom: PSDL_CD; start: Integer; length: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDPlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDPlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDPlay} // Pause play -- returns 0, or -1 on error function SDL_CDPause(cdrom: PSDL_CD): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDPause'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDPause'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDPause} // Resume play -- returns 0, or -1 on error function SDL_CDResume(cdrom: PSDL_CD): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDResume'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDResume'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDResume} // Stop play -- returns 0, or -1 on error function SDL_CDStop(cdrom: PSDL_CD): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDStop'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDStop'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDStop} // Eject CD-ROM -- returns 0, or -1 on error function SDL_CDEject(cdrom: PSDL_CD): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CDEject'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDEject'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDEject} // Closes the handle for the CD-ROM drive procedure SDL_CDClose(cdrom: PSDL_CD); -cdecl; external {$IFDEF __GPC__}name 'SDL_CDClose'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDClose'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CDClose} // Given a status, returns true if there's a disk in the drive @@ -2548,14 +2747,14 @@ function MSF_TO_FRAMES(M: Integer; S: Integer; F: Integer): Integer; { Count the number of joysticks attached to the system } function SDL_NumJoysticks: Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_NumJoysticks'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_NumJoysticks'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_NumJoysticks} { Get the implementation dependent name of a joystick. This can be called before any joysticks are opened. If no name can be found, this function returns NULL. } function SDL_JoystickName(index: Integer): PChar; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickName} { Open a joystick for use - the index passed as an argument refers to @@ -2564,40 +2763,40 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickName'{$ELSE} SDLLibName{$ENDIF This function returns a joystick identifier, or NULL if an error occurred. } function SDL_JoystickOpen(index: Integer): PSDL_Joystick; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickOpen} { Returns 1 if the joystick has been opened, or 0 if it has not. } function SDL_JoystickOpened(index: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickOpened'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickOpened'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickOpened} { Get the device index of an opened joystick. } function SDL_JoystickIndex(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickIndex'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickIndex'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickIndex} { Get the number of general axis controls on a joystick } function SDL_JoystickNumAxes(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickNumAxes'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumAxes'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickNumAxes} { Get the number of trackballs on a joystick Joystick trackballs have only relative motion events associated with them and their state cannot be polled. } function SDL_JoystickNumBalls(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickNumBalls'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumBalls'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickNumBalls} { Get the number of POV hats on a joystick } function SDL_JoystickNumHats(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickNumHats'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumHats'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickNumHats} { Get the number of buttons on a joystick } function SDL_JoystickNumButtons(joystick: PSDL_Joystick): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickNumButtons'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumButtons'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickNumButtons} { Update the current state of the open joysticks. @@ -2605,7 +2804,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickNumButtons'{$ELSE} SDLLibName{ events are enabled. } procedure SDL_JoystickUpdate; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickUpdate'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickUpdate'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickUpdate;} { Enable/disable joystick event polling. @@ -2615,7 +2814,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickUpdate'{$ELSE} SDLLibName{$END The state can be one of SDL_QUERY, SDL_ENABLE or SDL_IGNORE. } function SDL_JoystickEventState(state: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickEventState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickEventState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickEventState} { Get the current state of an axis control on a joystick @@ -2623,13 +2822,13 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickEventState'{$ELSE} SDLLibName{ The axis indices start at index 0. } function SDL_JoystickGetAxis(joystick: PSDL_Joystick; axis: Integer) : SInt16; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickGetAxis'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetAxis'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickGetAxis} { The hat indices start at index 0. } function SDL_JoystickGetHat(joystick: PSDL_Joystick; hat: Integer): UInt8; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickGetHat'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetHat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickGetHat} { Get the ball axis change since the last poll @@ -2637,18 +2836,18 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickGetHat'{$ELSE} SDLLibName{$END The ball indices start at index 0. } function SDL_JoystickGetBall(joystick: PSDL_Joystick; ball: Integer; var dx: Integer; var dy: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickGetBall'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetBall'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickGetBall} { Get the current state of a button on a joystick The button indices start at index 0. } function SDL_JoystickGetButton( joystick: PSDL_Joystick; Button: Integer): UInt8; -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickGetButton'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetButton'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickGetButton} { Close a joystick previously opened with SDL_JoystickOpen() } procedure SDL_JoystickClose(joystick: PSDL_Joystick); -cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickClose'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickClose'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_JoystickClose} {------------------------------------------------------------------------------} @@ -2660,7 +2859,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_JoystickClose'{$ELSE} SDLLibName{$ENDI This should only be run in the thread that sets the video mode. } procedure SDL_PumpEvents; -cdecl; external {$IFDEF __GPC__}name 'SDL_PumpEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PumpEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_PumpEvents;} { Checks the event queue for messages and optionally returns them. @@ -2676,7 +2875,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_PumpEvents'{$ELSE} SDLLibName{$ENDIF _ if there was an error. This function is thread-safe. } function SDL_PeepEvents(events: PSDL_Event; numevents: Integer; action: TSDL_eventaction; mask: UInt32): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_PeepEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PeepEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_PeepEvents} { Polls for currently pending events, and returns 1 if there are any pending @@ -2684,7 +2883,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_PeepEvents'{$ELSE} SDLLibName{$ENDIF _ event is removed from the queue and stored in that area. } function SDL_PollEvent(event: PSDL_Event): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_PollEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PollEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_PollEvent} { Waits indefinitely for the next available event, returning 1, or 0 if there @@ -2692,11 +2891,11 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_PollEvent'{$ELSE} SDLLibName{$ENDIF __ event is removed from the queue and stored in that area. } function SDL_WaitEvent(event: PSDL_Event): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_WaitEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WaitEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WaitEvent} function SDL_PushEvent( event : PSDL_Event ) : Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_PushEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PushEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_PushEvent} { If the filter returns 1, then the event will be added to the internal queue. @@ -2714,14 +2913,14 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_PushEvent'{$ELSE} SDLLibName{$ENDIF __ If the quit event is generated by an interrupt signal, it will bypass the internal queue and be delivered to the application at the next event poll. } procedure SDL_SetEventFilter( filter : TSDL_EventFilter ); -cdecl; external {$IFDEF __GPC__}name 'SDL_SetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetEventFilter} { Return the current event filter - can be used to "chain" filters. If there is no event filter set, this function returns NULL. } function SDL_GetEventFilter: TSDL_EventFilter; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetEventFilter} { This function allows you to set the state of processing certain events. @@ -2732,7 +2931,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetEventFilter'{$ELSE} SDLLibName{$END current processing state of the specified event. } function SDL_EventState(type_: UInt8; state: Integer): UInt8; -cdecl; external {$IFDEF __GPC__}name 'SDL_EventState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_EventState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_EventState} {------------------------------------------------------------------------------} @@ -2764,7 +2963,7 @@ function SDL_VERSION_ATLEAST(X: Integer; Y: Integer; Z: Integer) : LongBool; use the SDL_Version() macro. } function SDL_Linked_Version: PSDL_version; -cdecl; external {$IFDEF __GPC__}name 'SDL_Linked_Version'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Linked_Version'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_Linked_Version} {------------------------------------------------------------------------------} @@ -2785,10 +2984,10 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_Linked_Version'{$ELSE} SDLLibName{$END you won't be able to set full-screen display modes. } function SDL_VideoInit(driver_name: PChar; flags: UInt32): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_VideoInit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoInit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_VideoInit} procedure SDL_VideoQuit; -cdecl; external {$IFDEF __GPC__}name 'SDL_VideoQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_VideoQuit} { This function fills the given character buffer with the name of the @@ -2796,7 +2995,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_VideoQuit'{$ELSE} SDLLibName{$ENDIF __ been initialized. It returns NULL if no driver has been initialized. } function SDL_VideoDriverName(namebuf: PChar; maxlen: Integer): PChar; -cdecl; external {$IFDEF __GPC__}name 'SDL_VideoDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_VideoDriverName} { This function returns a pointer to the current display surface. @@ -2805,7 +3004,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_VideoDriverName'{$ELSE} SDLLibName{$EN surface. } function SDL_GetVideoSurface: PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetVideoSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetVideoSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetVideoSurface} { This function returns a read-only pointer to information about the @@ -2813,7 +3012,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetVideoSurface'{$ELSE} SDLLibName{$EN member of the returned structure will contain the pixel format of the "best" video mode. } function SDL_GetVideoInfo: PSDL_VideoInfo; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetVideoInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetVideoInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetVideoInfo} { Check to see if a particular video mode is supported. @@ -2827,7 +3026,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetVideoInfo'{$ELSE} SDLLibName{$ENDIF SDL_SetVideoMode() } function SDL_VideoModeOK(width, height, bpp: Integer; flags: UInt32): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_VideoModeOK'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoModeOK'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_VideoModeOK} { Return a pointer to an array of available screen dimensions for the @@ -2839,7 +3038,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_VideoModeOK'{$ELSE} SDLLibName{$ENDIF by SDL_GetVideoInfo( ) - > vfmt } function SDL_ListModes(format: PSDL_PixelFormat; flags: UInt32): PPSDL_Rect; -cdecl; external {$IFDEF __GPC__}name 'SDL_ListModes'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ListModes'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_ListModes} @@ -2886,7 +3085,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_ListModes'{$ELSE} SDLLibName{$ENDIF __ This function returns the video framebuffer surface, or NULL if it fails. } function SDL_SetVideoMode(width, height, bpp: Integer; flags: UInt32): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'SDL_SetVideoMode'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetVideoMode'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetVideoMode} @@ -2896,10 +3095,10 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_SetVideoMode'{$ELSE} SDLLibName{$ENDIF These functions should not be called while 'screen' is locked. } procedure SDL_UpdateRects(screen: PSDL_Surface; numrects: Integer; rects: PSDL_Rect); -cdecl; external {$IFDEF __GPC__}name 'SDL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_UpdateRects} procedure SDL_UpdateRect(screen: PSDL_Surface; x, y: SInt32; w, h: UInt32); -cdecl; external {$IFDEF __GPC__}name 'SDL_UpdateRect'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UpdateRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_UpdateRect} @@ -2913,7 +3112,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_UpdateRect'{$ELSE} SDLLibName{$ENDIF _ This function returns 0 if successful, or -1 if there was an error.} function SDL_Flip(screen: PSDL_Surface): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_Flip'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Flip'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_Flip} { Set the gamma correction for each of the color channels. @@ -2924,7 +3123,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_Flip'{$ELSE} SDLLibName{$ENDIF __GPC__ function returns 0, otherwise it returns -1. } function SDL_SetGamma(redgamma: single; greengamma: single; bluegamma: single ): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SetGamma'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetGamma'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetGamma} { Set the gamma translation table for the red, green, and blue channels @@ -2939,7 +3138,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_SetGamma'{$ELSE} SDLLibName{$ENDIF __G this function will return -1. } function SDL_SetGammaRamp( redtable: PUInt16; greentable: PUInt16; bluetable: PUInt16): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetGammaRamp} { Retrieve the current values of the gamma translation tables. @@ -2951,7 +3150,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_SetGammaRamp'{$ELSE} SDLLibName{$ENDIF this function will return -1. } function SDL_GetGammaRamp( redtable: PUInt16; greentable: PUInt16; bluetable: PUInt16): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetGammaRamp} { Sets a portion of the colormap for the given 8-bit surface. If 'surface' @@ -2970,7 +3169,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetGammaRamp'{$ELSE} SDLLibName{$ENDIF function SDL_SetColors(surface: PSDL_Surface; colors: PSDL_Color; firstcolor : Integer; ncolors: Integer) : Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SetColors'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetColors'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetColors} { Sets a portion of the colormap for a given 8-bit surface. @@ -2989,27 +3188,27 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_SetColors'{$ELSE} SDLLibName{$ENDIF __ flags = (SDL_LOGPAL or SDL_PHYSPAL). } function SDL_SetPalette(surface: PSDL_Surface; flags: Integer; colors: PSDL_Color; firstcolor: Integer; ncolors: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SetPalette'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetPalette'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetPalette} { Maps an RGB triple to an opaque pixel value for a given pixel format } function SDL_MapRGB(format: PSDL_PixelFormat; r: UInt8; g: UInt8; b: UInt8) : UInt32; -cdecl; external {$IFDEF __GPC__}name 'SDL_MapRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_MapRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_MapRGB} { Maps an RGBA quadruple to a pixel value for a given pixel format } function SDL_MapRGBA(format: PSDL_PixelFormat; r: UInt8; g: UInt8; b: UInt8; a: UInt8): UInt32; -cdecl; external {$IFDEF __GPC__}name 'SDL_MapRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_MapRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_MapRGBA} { Maps a pixel value into the RGB components for a given pixel format } procedure SDL_GetRGB(pixel: UInt32; fmt: PSDL_PixelFormat; r: PUInt8; g: PUInt8; b: PUInt8); -cdecl; external {$IFDEF __GPC__}name 'SDL_GetRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetRGB} { Maps a pixel value into the RGBA components for a given pixel format } procedure SDL_GetRGBA(pixel: UInt32; fmt: PSDL_PixelFormat; r: PUInt8; g: PUInt8; b: PUInt8; a: PUInt8); -cdecl; external {$IFDEF __GPC__}name 'SDL_GetRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetRGBA} { Allocate and free an RGB surface (must be called after SDL_SetVideoMode) @@ -3050,16 +3249,16 @@ function SDL_AllocSurface(flags: UInt32; width, height, depth: Integer; {$EXTERNALSYM SDL_AllocSurface} function SDL_CreateRGBSurface(flags: UInt32; width, height, depth: Integer; RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'SDL_CreateRGBSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateRGBSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CreateRGBSurface} function SDL_CreateRGBSurfaceFrom(pixels: Pointer; width, height, depth, pitch : Integer; RMask, GMask, BMask, AMask: UInt32): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'SDL_CreateRGBSurfaceFrom'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateRGBSurfaceFrom'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CreateRGBSurfaceFrom} procedure SDL_FreeSurface(surface: PSDL_Surface); -cdecl; external {$IFDEF __GPC__}name 'SDL_FreeSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_FreeSurface} function SDL_MustLock(Surface: PSDL_Surface): Boolean; @@ -3081,11 +3280,11 @@ function SDL_MustLock(Surface: PSDL_Surface): Boolean; SDL_LockSurface() returns 0, or -1 if the surface couldn't be locked. } function SDL_LockSurface(surface: PSDL_Surface): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_LockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_LockSurface} procedure SDL_UnlockSurface(surface: PSDL_Surface); -cdecl; external {$IFDEF __GPC__}name 'SDL_UnlockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnlockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_UnlockSurface} { Load a surface from a seekable SDL data source (memory or file.) @@ -3093,7 +3292,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_UnlockSurface'{$ELSE} SDLLibName{$ENDI Returns the new surface, or NULL if there was an error. The new surface should be freed with SDL_FreeSurface(). } function SDL_LoadBMP_RW(src: PSDL_RWops; freesrc: Integer): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'SDL_LoadBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_LoadBMP_RW} // Convenience macro -- load a surface from a file @@ -3105,7 +3304,7 @@ function SDL_LoadBMP(filename: PChar): PSDL_Surface; Returns 0 if successful or -1 if there was an error. } function SDL_SaveBMP_RW(surface: PSDL_Surface; dst: PSDL_RWops; freedst: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SaveBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SaveBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SaveBMP_RW} // Convenience macro -- save a surface to a file @@ -3121,7 +3320,7 @@ function SDL_SaveBMP(surface: PSDL_Surface; filename: PChar): Integer; This function returns 0, or -1 if there was an error. } function SDL_SetColorKey(surface: PSDL_Surface; flag, key: UInt32) : Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SetColorKey'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetColorKey'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetColorKey} { This function sets the alpha value for the entire surface, as opposed to @@ -3138,7 +3337,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_SetColorKey'{$ELSE} SDLLibName{$ENDIF function SDL_SetAlpha(surface: PSDL_Surface; flag: UInt32; alpha: UInt8): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SetAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetAlpha} { Sets the clipping rectangle for the destination surface in a blit. @@ -3152,14 +3351,14 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_SetAlpha'{$ELSE} SDLLibName{$ENDIF __G Note that blits are automatically clipped to the edges of the source and destination surfaces. } procedure SDL_SetClipRect(surface: PSDL_Surface; rect: PSDL_Rect); cdecl; -external {$IFDEF __GPC__}name 'SDL_SetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}; +external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetClipRect} { Gets the clipping rectangle for the destination surface in a blit. 'rect' must be a pointer to a valid rectangle which will be filled with the correct values. } procedure SDL_GetClipRect(surface: PSDL_Surface; rect: PSDL_Rect); cdecl; -external {$IFDEF __GPC__}name 'SDL_GetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}; +external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetClipRect} { Creates a new surface of the specified format, and then copies and maps @@ -3174,7 +3373,7 @@ external {$IFDEF __GPC__}name 'SDL_GetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__ This function is used internally by SDL_DisplayFormat(). } function SDL_ConvertSurface(src: PSDL_Surface; fmt: PSDL_PixelFormat; flags: UInt32): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'SDL_ConvertSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ConvertSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_ConvertSurface} { @@ -3254,13 +3453,13 @@ function SDL_BlitSurface(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surfac { This is the public blit function, SDL_BlitSurface(), and it performs rectangle validation and clipping before passing it to SDL_LowerBlit() } function SDL_UpperBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_UpperBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UpperBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_UpperBlit} { This is a semi-private blit function and it performs low-level surface blitting only. } function SDL_LowerBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_LowerBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LowerBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_LowerBlit} { This function performs a fast fill of the given rectangle with 'color' @@ -3272,7 +3471,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_LowerBlit'{$ELSE} SDLLibName{$ENDIF __ This function returns 0 on success, or -1 on error. } function SDL_FillRect(dst: PSDL_Surface; dstrect: PSDL_Rect; color: UInt32) : Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_FillRect'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FillRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_FillRect} { This function takes a surface and copies it to a new surface of the @@ -3286,7 +3485,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_FillRect'{$ELSE} SDLLibName{$ENDIF __G If the conversion fails or runs out of memory, it returns NULL } function SDL_DisplayFormat(surface: PSDL_Surface): PSDL_Surface; cdecl; -external {$IFDEF __GPC__}name 'SDL_DisplayFormat'{$ELSE} SDLLibName{$ENDIF __GPC__}; +external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DisplayFormat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_DisplayFormat} { This function takes a surface and copies it to a new surface of the @@ -3302,7 +3501,7 @@ external {$IFDEF __GPC__}name 'SDL_DisplayFormat'{$ELSE} SDLLibName{$ENDIF __GPC function SDL_DisplayFormatAlpha(surface: PSDL_Surface): PSDL_Surface; cdecl; -external {$IFDEF __GPC__}name 'SDL_DisplayFormatAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}; +external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DisplayFormatAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_DisplayFormatAlpha} //* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ @@ -3315,16 +3514,16 @@ external {$IFDEF __GPC__}name 'SDL_DisplayFormatAlpha'{$ELSE} SDLLibName{$ENDIF is shown is undefined - it may be overwritten with the converted YUV data. } function SDL_CreateYUVOverlay(width: Integer; height: Integer; format: UInt32; display: PSDL_Surface): PSDL_Overlay; -cdecl; external {$IFDEF __GPC__}name 'SDL_CreateYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CreateYUVOverlay} // Lock an overlay for direct access, and unlock it when you are done function SDL_LockYUVOverlay(Overlay: PSDL_Overlay): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_LockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_LockYUVOverlay} procedure SDL_UnlockYUVOverlay(Overlay: PSDL_Overlay); cdecl; -external {$IFDEF __GPC__}name 'SDL_UnlockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnlockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_UnlockYUVOverlay} @@ -3335,12 +3534,12 @@ external {$IFDEF __GPC__}name 'SDL_UnlockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __ that of the overlay, but currently only 2x scaling is supported. } function SDL_DisplayYUVOverlay(Overlay: PSDL_Overlay; dstrect: PSDL_Rect) : Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_DisplayYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DisplayYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_DisplayYUVOverlay} // Free a video overlay procedure SDL_FreeYUVOverlay(Overlay: PSDL_Overlay); -cdecl; external {$IFDEF __GPC__}name 'SDL_FreeYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_FreeYUVOverlay} {------------------------------------------------------------------------------} @@ -3358,17 +3557,17 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_FreeYUVOverlay'{$ELSE} SDLLibName{$END function SDL_GL_LoadLibrary(filename: PChar): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_GL_LoadLibrary'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_LoadLibrary'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GL_LoadLibrary} { Get the address of a GL function (for extension functions) } function SDL_GL_GetProcAddress(procname: PChar) : Pointer; -cdecl; external {$IFDEF __GPC__}name 'SDL_GL_GetProcAddress'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_GetProcAddress'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GL_GetProcAddress} { Set an attribute of the OpenGL subsystem before intialization. } function SDL_GL_SetAttribute(attr: TSDL_GLAttr; value: Integer) : Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_GL_SetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_SetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GL_SetAttribute} { Get an attribute of the OpenGL subsystem from the windowing @@ -3380,26 +3579,26 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GL_SetAttribute'{$ELSE} SDLLibName{$EN themselves if they want to retrieve these values. } function SDL_GL_GetAttribute(attr: TSDL_GLAttr; var value: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_GL_GetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_GetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GL_GetAttribute} { Swap the OpenGL buffers, if double-buffering is supported. } procedure SDL_GL_SwapBuffers; -cdecl; external {$IFDEF __GPC__}name 'SDL_GL_SwapBuffers'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_SwapBuffers'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GL_SwapBuffers;} { Internal functions that should not be called unless you have read and understood the source code for these functions. } procedure SDL_GL_UpdateRects(numrects: Integer; rects: PSDL_Rect); -cdecl; external {$IFDEF __GPC__}name 'SDL_GL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GL_UpdateRects} procedure SDL_GL_Lock; -cdecl; external {$IFDEF __GPC__}name 'SDL_GL_Lock'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_Lock'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GL_Lock;} procedure SDL_GL_Unlock; -cdecl; external {$IFDEF __GPC__}name 'SDL_GL_Unlock'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_Unlock'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GL_Unlock;} {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} @@ -3408,10 +3607,10 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GL_Unlock'{$ELSE} SDLLibName{$ENDIF __ { Sets/Gets the title and icon text of the display window } procedure SDL_WM_GetCaption(var title : PChar; var icon : PChar); -cdecl; external {$IFDEF __GPC__}name 'SDL_WM_GetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_GetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WM_GetCaption} procedure SDL_WM_SetCaption( const title : PChar; const icon : PChar); -cdecl; external {$IFDEF __GPC__}name 'SDL_WM_SetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_SetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WM_SetCaption} { Sets the icon for the display window. @@ -3419,7 +3618,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_WM_SetCaption'{$ELSE} SDLLibName{$ENDI It takes an icon surface, and a mask in MSB format. If 'mask' is NULL, the entire icon surface will be used as the icon. } procedure SDL_WM_SetIcon(icon: PSDL_Surface; mask: UInt8); -cdecl; external {$IFDEF __GPC__}name 'SDL_WM_SetIcon'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_SetIcon'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WM_SetIcon} { This function iconifies the window, and returns 1 if it succeeded. @@ -3427,7 +3626,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_WM_SetIcon'{$ELSE} SDLLibName{$ENDIF _ This function is a noop and returns 0 in non-windowed environments. } function SDL_WM_IconifyWindow: Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_WM_IconifyWindow'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_IconifyWindow'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WM_IconifyWindow} { Toggle fullscreen mode without changing the contents of the screen. @@ -3445,7 +3644,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_WM_IconifyWindow'{$ELSE} SDLLibName{$E This is currently only implemented in the X11 video driver. } function SDL_WM_ToggleFullScreen(surface: PSDL_Surface): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_WM_ToggleFullScreen'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_ToggleFullScreen'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WM_ToggleFullScreen} { Grabbing means that the mouse is confined to the application window, @@ -3453,7 +3652,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_WM_ToggleFullScreen'{$ELSE} SDLLibName and not interpreted by a window manager, if any. } function SDL_WM_GrabInput(mode: TSDL_GrabMode): TSDL_GrabMode; -cdecl; external {$IFDEF __GPC__}name 'SDL_WM_GrabInput'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_GrabInput'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WM_GrabInput} {------------------------------------------------------------------------------} @@ -3466,7 +3665,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_WM_GrabInput'{$ELSE} SDLLibName{$ENDIF current mouse cursor position. You can pass NULL for either x or y. } function SDL_GetMouseState(var x: Integer; var y: Integer): UInt8; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetMouseState} { Retrieve the current state of the mouse. @@ -3474,12 +3673,12 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetMouseState'{$ELSE} SDLLibName{$ENDI be tested using the SDL_BUTTON(X) macros, and x and y are set to the mouse deltas since the last call to SDL_GetRelativeMouseState(). } function SDL_GetRelativeMouseState(var x: Integer; var y: Integer): UInt8; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetRelativeMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetRelativeMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetRelativeMouseState} { Set the position of the mouse cursor (generates a mouse motion event) } procedure SDL_WarpMouse(x, y: UInt16); -cdecl; external {$IFDEF __GPC__}name 'SDL_WarpMouse'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WarpMouse'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WarpMouse} { Create a cursor using the specified data and mask (in MSB format). @@ -3494,24 +3693,24 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_WarpMouse'{$ELSE} SDLLibName{$ENDIF __ Cursors created with this function must be freed with SDL_FreeCursor(). } function SDL_CreateCursor(data, mask: PUInt8; w, h, hot_x, hot_y: Integer): PSDL_Cursor; -cdecl; external {$IFDEF __GPC__}name 'SDL_CreateCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CreateCursor} { Set the currently active cursor to the specified one. If the cursor is currently visible, the change will be immediately represented on the display. } procedure SDL_SetCursor(cursor: PSDL_Cursor); -cdecl; external {$IFDEF __GPC__}name 'SDL_SetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetCursor} { Returns the currently active cursor. } function SDL_GetCursor: PSDL_Cursor; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetCursor} { Deallocates a cursor created with SDL_CreateCursor(). } procedure SDL_FreeCursor(cursor: PSDL_Cursor); -cdecl; external {$IFDEF __GPC__}name 'SDL_FreeCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_FreeCursor} { Toggle whether or not the cursor is shown on the screen. @@ -3520,7 +3719,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_FreeCursor'{$ELSE} SDLLibName{$ENDIF _ before the call, or 0 if it was not. You can query the current state by passing a 'toggle' value of -1. } function SDL_ShowCursor(toggle: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_ShowCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ShowCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_ShowCursor} function SDL_BUTTON( Button : Integer ) : Integer; @@ -3536,14 +3735,18 @@ function SDL_BUTTON( Button : Integer ) : Integer; If 'enable' is -1, the translation state is not changed. It returns the previous state of keyboard translation. } function SDL_EnableUNICODE(enable: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_EnableUNICODE'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_EnableUNICODE'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_EnableUNICODE} { If 'delay' is set to 0, keyboard repeat is disabled. } function SDL_EnableKeyRepeat(delay: Integer; interval: Integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_EnableKeyRepeat'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_EnableKeyRepeat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_EnableKeyRepeat} +procedure SDL_GetKeyRepeat(delay : PInteger; interval: PInteger); +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetKeyRepeat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; +{$EXTERNALSYM SDL_GetKeyRepeat} + { Get a snapshot of the current state of the keyboard. Returns an array of keystates, indexed by the SDLK_* syms. Used: @@ -3552,23 +3755,23 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_EnableKeyRepeat'{$ELSE} SDLLibName{$EN if ( keystate[SDLK_RETURN] ) ... is pressed } function SDL_GetKeyState(numkeys: PInt): PUInt8; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetKeyState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetKeyState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetKeyState} { Get the current key modifier state } function SDL_GetModState: TSDLMod; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetModState} { Set the current key modifier state This does not change the keyboard state, only the key modifier flags. } procedure SDL_SetModState(modstate: TSDLMod); -cdecl; external {$IFDEF __GPC__}name 'SDL_SetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SetModState} { Get the name of an SDL virtual keysym } function SDL_GetKeyName(key: TSDLKey): PChar; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetKeyName'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetKeyName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetKeyName} {------------------------------------------------------------------------------} @@ -3581,7 +3784,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetKeyName'{$ELSE} SDLLibName{$ENDIF _ see your application, otherwise it has been iconified or disabled. } function SDL_GetAppState: UInt8; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetAppState'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetAppState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetAppState} @@ -3590,13 +3793,13 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetAppState'{$ELSE} SDLLibName{$ENDIF { Create a mutex, initialized unlocked } function SDL_CreateMutex: PSDL_Mutex; -cdecl; external {$IFDEF __GPC__}name 'SDL_CreateMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CreateMutex} { Lock the mutex (Returns 0, or -1 on error) } function SDL_mutexP(mutex: PSDL_mutex): Integer; - cdecl; external {$IFDEF __GPC__}name 'SDL_mutexP'{$ELSE} SDLLibName{$ENDIF __GPC__}; + cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_mutexP'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; { $ EXTERNALSYM SDL_mutexP} function SDL_LockMutex(mutex: PSDL_mutex): Integer; @@ -3604,7 +3807,7 @@ function SDL_LockMutex(mutex: PSDL_mutex): Integer; { Unlock the mutex (Returns 0, or -1 on error) } function SDL_mutexV(mutex: PSDL_mutex): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_mutexV'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_mutexV'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_mutexV} function SDL_UnlockMutex(mutex: PSDL_mutex): Integer; @@ -3612,7 +3815,7 @@ function SDL_UnlockMutex(mutex: PSDL_mutex): Integer; { Destroy a mutex } procedure SDL_DestroyMutex(mutex: PSDL_mutex); -cdecl; external {$IFDEF __GPC__}name 'SDL_DestroyMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DestroyMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_DestroyMutex} { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } @@ -3620,13 +3823,13 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_DestroyMutex'{$ELSE} SDLLibName{$ENDIF { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } { Create a semaphore, initialized with value, returns NULL on failure. } function SDL_CreateSemaphore(initial_value: UInt32): PSDL_Sem; -cdecl; external {$IFDEF __GPC__}name 'SDL_CreateSemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateSemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CreateSemaphore} { Destroy a semaphore } procedure SDL_DestroySemaphore(sem: PSDL_sem); -cdecl; external {$IFDEF __GPC__}name 'SDL_DestroySemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DestroySemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_DestroySemaphore} { This function suspends the calling thread until the semaphore pointed @@ -3634,14 +3837,14 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_DestroySemaphore'{$ELSE} SDLLibName{$E count. } function SDL_SemWait(sem: PSDL_sem): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SemWait'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemWait'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SemWait} { Non-blocking variant of SDL_SemWait(), returns 0 if the wait succeeds, SDL_MUTEX_TIMEDOUT if the wait would block, and -1 on error. } function SDL_SemTryWait(sem: PSDL_sem): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SemTryWait'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemTryWait'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SemTryWait} { Variant of SDL_SemWait() with a timeout in milliseconds, returns 0 if @@ -3651,20 +3854,20 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_SemTryWait'{$ELSE} SDLLibName{$ENDIF _ of 1 ms, and so should be avoided if possible. } function SDL_SemWaitTimeout(sem: PSDL_sem; ms: UInt32): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SemWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SemTryWait} { Atomically increases the semaphore's count (not blocking), returns 0, or -1 on error. } function SDL_SemPost(sem: PSDL_sem): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_SemPost'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemPost'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SemTryWait} { Returns the current count of the semaphore } function SDL_SemValue(sem: PSDL_sem): UInt32; -cdecl; external {$IFDEF __GPC__}name 'SDL_SemValue'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemValue'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_SemValue} { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } @@ -3672,26 +3875,26 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_SemValue'{$ELSE} SDLLibName{$ENDIF __G { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } { Create a condition variable } function SDL_CreateCond: PSDL_Cond; -cdecl; external {$IFDEF __GPC__}name 'SDL_CreateCond'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateCond'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CreateCond} { Destroy a condition variable } procedure SDL_DestroyCond(cond: PSDL_Cond); -cdecl; external {$IFDEF __GPC__}name 'SDL_DestroyCond'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DestroyCond'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_DestroyCond} { Restart one of the threads that are waiting on the condition variable, returns 0 or -1 on error. } function SDL_CondSignal(cond: PSDL_cond): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CondSignal'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondSignal'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CondSignal} { Restart all threads that are waiting on the condition variable, returns 0 or -1 on error. } function SDL_CondBroadcast(cond: PSDL_cond): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CondBroadcast'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondBroadcast'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CondBroadcast} @@ -3700,7 +3903,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_CondBroadcast'{$ELSE} SDLLibName{$ENDI Returns 0 when it is signaled, or -1 on error. } function SDL_CondWait(cond: PSDL_cond; mut: PSDL_mutex): Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CondWait'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondWait'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CondWait} { Waits for at most 'ms' milliseconds, and returns 0 if the condition @@ -3710,7 +3913,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_CondWait'{$ELSE} SDLLibName{$ENDIF __G of 1 ms, and so should be avoided if possible. } function SDL_CondWaitTimeout(cond: PSDL_cond; mut: PSDL_mutex; ms: UInt32) : Integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_CondWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CondWaitTimeout} { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * } @@ -3719,18 +3922,18 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_CondWaitTimeout'{$ELSE} SDLLibName{$EN { Create a thread } function SDL_CreateThread(fn: PInt; data: Pointer): PSDL_Thread; -cdecl; external {$IFDEF __GPC__}name 'SDL_CreateThread'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateThread'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_CreateThread} { Get the 32-bit thread identifier for the current thread } function SDL_ThreadID: UInt32; -cdecl; external {$IFDEF __GPC__}name 'SDL_ThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_ThreadID} { Get the 32-bit thread identifier for the specified thread, equivalent to SDL_ThreadID() if the specified thread is NULL. } function SDL_GetThreadID(thread: PSDL_Thread): UInt32; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetThreadID} { Wait for a thread to finish. @@ -3738,18 +3941,18 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetThreadID'{$ELSE} SDLLibName{$ENDIF pointed to by 'status', if 'status' is not NULL. } procedure SDL_WaitThread(thread: PSDL_Thread; var status: Integer); -cdecl; external {$IFDEF __GPC__}name 'SDL_WaitThread'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WaitThread'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_WaitThread} { Forcefully kill a thread without worrying about its state } procedure SDL_KillThread(thread: PSDL_Thread); -cdecl; external {$IFDEF __GPC__}name 'SDL_KillThread'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_KillThread'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_KillThread} {------------------------------------------------------------------------------} { Get Environment Routines } {------------------------------------------------------------------------------} -{$IFDEF WIN32} +{$IFDEF WINDOWS} function _putenv( const variable : Pchar ): integer; cdecl; {$ENDIF} @@ -3762,7 +3965,7 @@ cdecl; external 'libc.so' name 'putenv'; {$ENDIF} { Put a variable of the form "name=value" into the environment } -//function SDL_putenv(const variable: PChar): integer; cdecl; external {$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name ''; +//function SDL_putenv(const variable: PChar): integer; cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name ''; function SDL_putenv(const variable: PChar): integer; {$EXTERNALSYM SDL_putenv} @@ -3771,14 +3974,14 @@ function SDL_putenv(const variable: PChar): integer; //function putenv(const variable: PChar): integer; //{$EXTERNALSYM putenv} -{$IFDEF WIN32} +{$IFDEF WINDOWS} {$IFNDEF __GPC__} function getenv( const name : Pchar ): PChar; cdecl; {$ENDIF} {$ENDIF} {* Retrieve a variable named "name" from the environment } -//function SDL_getenv(const name: PChar): PChar; cdecl; external {$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name ''; +//function SDL_getenv(const name: PChar): PChar; cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name ''; function SDL_getenv(const name: PChar): PChar; {$EXTERNALSYM SDL_getenv} @@ -3794,7 +3997,7 @@ function SDL_getenv(const name: PChar): PChar; * the version member of the 'info' structure is invalid, it returns 0. *} function SDL_GetWMInfo(info : PSDL_SysWMinfo) : integer; -cdecl; external {$IFDEF __GPC__}name 'SDL_GetWMInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetWMInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_GetWMInfo} {------------------------------------------------------------------------------} @@ -3805,7 +4008,7 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_GetWMInfo'{$ELSE} SDLLibName{$ENDIF __ * The 'sofile' parameter is a system dependent name of the object file. *} function SDL_LoadObject( const sofile : PChar ) : Pointer; -cdecl; external {$IFDEF __GPC__}name 'SDL_LoadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_LoadObject} {* Given an object handle, this function looks up the address of the @@ -3813,12 +4016,12 @@ cdecl; external {$IFDEF __GPC__}name 'SDL_LoadObject'{$ELSE} SDLLibName{$ENDIF _ * is no longer valid after calling SDL_UnloadObject(). *} function SDL_LoadFunction( handle : Pointer; const name : PChar ) : Pointer; -cdecl; external {$IFDEF __GPC__}name 'SDL_LoadFunction'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadFunction'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_LoadFunction} {* Unload a shared object from memory *} procedure SDL_UnloadObject( handle : Pointer ); -cdecl; external {$IFDEF __GPC__}name 'SDL_UnloadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}; +cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnloadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF}; {$EXTERNALSYM SDL_UnloadObject} @@ -3860,7 +4063,7 @@ end; procedure SDL_OutOfMemory; begin - {$IFNDEF WIN32} + {$IFNDEF WINDOWS} SDL_Error(SDL_ENOMEM); {$ENDIF} end; @@ -3981,7 +4184,7 @@ begin Result := SDL_mutexV(mutex); end; -{$IFDEF WIN32} +{$IFDEF WINDOWS} function _putenv( const variable : Pchar ): Integer; cdecl; external {$IFDEF __GPC__}name '_putenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF __GPC__}; {$ENDIF} @@ -3989,7 +4192,7 @@ cdecl; external {$IFDEF __GPC__}name '_putenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF __GPC_ function SDL_putenv(const variable: PChar): Integer; begin - {$IFDEF WIN32} + {$IFDEF WINDOWS} Result := _putenv(variable); {$ENDIF} @@ -4002,7 +4205,7 @@ begin {$ENDIF} end; -{$IFDEF WIN32} +{$IFDEF WINDOWS} {$IFNDEF __GPC__} function getenv( const name : Pchar ): PChar; cdecl; external {$IFDEF __GPC__}name 'getenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF}; @@ -4011,7 +4214,7 @@ cdecl; external {$IFDEF __GPC__}name 'getenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF}; function SDL_getenv(const name: PChar): PChar; begin - {$IFDEF WIN32} + {$IFDEF WINDOWS} {$IFDEF __GPC__} Result := getenv( string( name ) ); diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas index f8bf902c..cc95751d 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas @@ -1,6 +1,6 @@ unit sdlgameinterface; { - $Id: sdlgameinterface.pas,v 1.3 2004/10/17 18:41:49 savage Exp $ + $Id: sdlgameinterface.pas,v 1.4 2005/08/03 18:57:31 savage Exp $ } {******************************************************************************} @@ -62,6 +62,9 @@ unit sdlgameinterface; { 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 @@ -97,11 +100,11 @@ type procedure MouseWheelScroll( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual; procedure KeyDown( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ); virtual; public - MainWindow : TSDL2DWindow; + MainWindow : TSDLCustomWindow; procedure ResetInputManager; procedure LoadSurfaces; virtual; function PointIsInRect( Point : TPoint; x, y, x1, y1 : integer ) : Boolean; - constructor Create( const aMainWindow : TSDL2DWindow ); + constructor Create( const aMainWindow : TSDLCustomWindow ); destructor Destroy; override; property NextGameInterface : TGameInterfaceClass read FNextGameInterface write FNextGameInterface; end; @@ -114,7 +117,7 @@ begin FNextGameInterface := nil; end; -constructor TGameInterface.Create( const aMainWindow : TSDL2DWindow ); +constructor TGameInterface.Create( const aMainWindow : TSDLCustomWindow ); begin inherited Create; MainWindow := aMainWindow; @@ -176,14 +179,18 @@ begin 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; - MainWindow.OnRender := Render; - MainWindow.OnClose := Close; + temp := Render; + MainWindow.OnRender := temp; + temp := Close; + MainWindow.OnClose := temp; MainWindow.OnUpdate := Update; end; diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas index 4e91ecb8..8e00dd6f 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas @@ -1,7 +1,7 @@ unit sdlticks; { - $Id: sdlticks.pas,v 1.1 2004/09/30 22:35:47 savage Exp $ - + $Id: sdlticks.pas,v 1.2 2006/11/08 08:22:48 savage Exp $ + } {******************************************************************************} { } @@ -59,10 +59,12 @@ unit sdlticks; { 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. - } {******************************************************************************} @@ -71,49 +73,50 @@ interface uses sdl; - type TSDLTicks = class private - m_startTime : Int64; - m_ticksPerSecond : Int64; - s_lastTime : Int64; - + FStartTime : UInt32; + FTicksPerSecond : UInt32; + FElapsedLastTime : UInt32; + FFPSLastTime : UInt32; + FLockFPSLastTime : UInt32; public constructor Create; - destructor Destroy; override; // destructor + 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; - function GetElapsedSeconds( elapsedFrames : Cardinal = 1 ) : single; + {*************************************************************************** + GetGetElapsedSeconds + Returns the Elapsed time, since the function was last called. + ***************************************************************************} + function GetElapsedSeconds : Single; {*************************************************************************** GetFPS - - Returns the average frames per second over elapsedFrames, which defaults to - one. If this is not called every frame, the client should track the number + 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( elapsedFrames : Cardinal = 1 ) : single; + 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 <= targetFPS. + will be less than or equal to the targetFPS. ***************************************************************************} - function LockFPS( targetFPS : Byte ) : single; + procedure LockFPS( targetFPS : Byte ); end; implementation @@ -121,76 +124,74 @@ implementation { TSDLTicks } constructor TSDLTicks.Create; begin - + inherited; + FTicksPerSecond := 1000; end; destructor TSDLTicks.Destroy; begin - inherited; end; -function TSDLTicks.GetElapsedSeconds( elapsedFrames: Cardinal ): single; +function TSDLTicks.GetElapsedSeconds : Single; var - currentTime : Int64; + currentTime : Cardinal; begin - // s_lastTime := m_startTime; - currentTime := SDL_GetTicks; - //QueryPerformanceCounter( currentTime ); - result := (currentTime - s_lastTime) / m_ticksPerSecond; + result := ( currentTime - FElapsedLastTime ) / FTicksPerSecond; // reset the timer - s_lastTime := currentTime; + FElapsedLastTime := currentTime; end; -function TSDLTicks.GetFPS( elapsedFrames: Cardinal ): single; +function TSDLTicks.GetFPS : Single; var - currentTime : integer; - fps : single; + currentTime, FrameTime : UInt32; + fps : single; begin - // s_lastTime := m_startTime; - currentTime := SDL_GetTicks; - fps := elapsedFrames * m_ticksPerSecond / ( currentTime - s_lastTime); + FrameTime := ( currentTime - FFPSLastTime ); - // reset the timer - s_lastTime := currentTime; + if FrameTime = 0 then + FrameTime := 1; + fps := FTicksPerSecond / FrameTime; + + // reset the timer + FFPSLastTime := currentTime; result := fps; end; -function TSDLTicks.Init: boolean; +function TSDLTicks.Init : boolean; begin - m_startTime := SDL_GetTicks; - s_lastTime := m_startTime; - m_ticksPerSecond := 1000; + FStartTime := SDL_GetTicks; + FElapsedLastTime := FStartTime; + FFPSLastTime := FStartTime; + FLockFPSLastTime := FStartTime; result := true; end; -function TSDLTicks.LockFPS(targetFPS: Byte): single; +procedure TSDLTicks.LockFPS( targetFPS : Byte ); var - currentTime : integer; - fps : single; + currentTime : UInt32; + targetTime : single; begin - if (targetFPS = 0) then + if ( targetFPS = 0 ) then targetFPS := 1; - s_lastTime := m_startTime; + targetTime := FTicksPerSecond / targetFPS; // delay to maintain a constant frame rate repeat currentTime := SDL_GetTicks; - fps := m_ticksPerSecond / (currentTime - s_lastTime); - until (fps > targetFPS); + until ( ( currentTime - FLockFPSLastTime ) > targetTime ); // reset the timer - s_lastTime := m_startTime; - - result := fps; + 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 bef83cbc..b15fa9ba 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas @@ -1,7 +1,7 @@ unit sdlutils; { - $Id: sdlutils.pas,v 1.4 2004/06/02 19:38:53 savage Exp $ - + $Id: sdlutils.pas,v 1.5 2006/11/19 18:56:44 savage Exp $ + } {******************************************************************************} { } @@ -105,6 +105,9 @@ unit sdlutils; {******************************************************************************} { $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. @@ -119,12 +122,12 @@ unit sdlutils; Revision 1.1 2004/02/05 00:08:20 savage Module 1.0 release - + } interface -{$i jedi-sdl.inc} +{$I jedi-sdl.inc} uses {$IFDEF UNIX} @@ -157,7 +160,7 @@ procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Col cardinal ); overload; procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : - cardinal ; DashLength, DashSpace : byte ); overload; + cardinal; DashLength, DashSpace : byte ); overload; procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : cardinal ); @@ -217,16 +220,16 @@ procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color 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_2xBlit( Src, Dest : PSDL_Surface ); -procedure SDL_Scanline2xBlit(Src, Dest: PSDL_Surface); +procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface ); -procedure SDL_50Scanline2xBlit(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; + 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; @@ -242,7 +245,7 @@ procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : 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; +function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean; implementation @@ -256,13 +259,13 @@ var right1, bottom1 : integer; right2, bottom2 : integer; Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal; - Mod1, Mod2 : cardinal; + Mod1, Mod2 : cardinal; Addr1, Addr2 : cardinal; - BPP : cardinal; + BPP : cardinal; Pitch1, Pitch2 : cardinal; TransparentColor1, TransparentColor2 : cardinal; - tx, ty : cardinal; - StartTick : cardinal; + tx, ty : cardinal; + StartTick : cardinal; Color1, Color2 : cardinal; begin Result := false; @@ -438,9 +441,9 @@ end; procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : cardinal ); var - SrcColor : cardinal; - Addr : cardinal; - R, G, B : cardinal; + SrcColor : cardinal; + Addr : cardinal; + R, G, B : cardinal; begin if Color = 0 then exit; @@ -521,9 +524,9 @@ end; procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : cardinal ); var - SrcColor : cardinal; - Addr : cardinal; - R, G, B : cardinal; + SrcColor : cardinal; + Addr : cardinal; + R, G, B : cardinal; begin if Color = 0 then exit; @@ -608,12 +611,12 @@ 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; + Src, Dest : TSDL_Rect; + Diff : integer; SrcAddr, DestAddr : cardinal; WorkX, WorkY : word; SrcMod, DestMod : cardinal; - Bits : cardinal; + Bits : cardinal; begin if ( SrcSurface = nil ) or ( DestSurface = nil ) then exit; // Remove this to make it faster @@ -878,13 +881,13 @@ 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; + Src, Dest : TSDL_Rect; + Diff : integer; SrcAddr, DestAddr : cardinal; _ebx, _esi, _edi, _esp : cardinal; WorkX, WorkY : word; SrcMod, DestMod : cardinal; - Bits : cardinal; + Bits : cardinal; begin if ( SrcSurface = nil ) or ( DestSurface = nil ) then exit; // Remove this to make it faster @@ -1140,14 +1143,14 @@ 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; + Src, Dest : TSDL_Rect; + Diff : integer; SrcAddr, DestAddr : cardinal; _ebx, _esi, _edi, _esp : cardinal; WorkX, WorkY : word; SrcMod, DestMod : cardinal; TransparentColor, SrcColor : cardinal; - BPP : cardinal; + BPP : cardinal; begin if ( SrcSurface = nil ) or ( DestSurface = nil ) then exit; // Remove this to make it faster @@ -1312,14 +1315,14 @@ 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; + Src, Dest : TSDL_Rect; + Diff : integer; SrcAddr, DestAddr, TextAddr : cardinal; _ebx, _esi, _edi, _esp : cardinal; WorkX, WorkY : word; SrcMod, DestMod, TextMod : cardinal; SrcColor, TransparentColor, TextureColor : cardinal; - BPP : cardinal; + BPP : cardinal; begin if ( SrcSurface = nil ) or ( DestSurface = nil ) then exit; // Remove this to make it faster @@ -1496,10 +1499,10 @@ end; procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect ); var - xc, yc : cardinal; + xc, yc : cardinal; rx, wx, ry, wy, ry16 : cardinal; - color : cardinal; - modx, mody : cardinal; + color : cardinal; + modx, mody : cardinal; begin // Warning! No checks for surface pointers!!! if srcrect = nil then @@ -1540,13 +1543,13 @@ end; 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 + 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; + mx, my : cardinal; + cr : cardinal; begin // Does the destination area specify a single pixel? if ( ( abs( ul.x - ur.x ) < THRESH ) and @@ -1620,6 +1623,7 @@ 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 @@ -1673,8 +1677,9 @@ 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; + cardinal; DashLength, DashSpace : byte ); overload; var dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean; begin @@ -1682,10 +1687,12 @@ begin 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; + if ( DashLength < 1 ) + then + DashLength := 1; + if ( DashSpace < 1 ) + then + DashSpace := 0; dx := x2 - x1; dy := y2 - y1; @@ -1706,28 +1713,28 @@ begin if dx >= dy then begin for x := 0 to dx - 1 do - begin + 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 - SDL_PutPixel( DstSurface, px, py, Color ); - inc(counter); - if (counter > DashLength-1) and (DashSpace > 0) then - begin - drawdash := false; - counter := 0; - end; - end + drawdash := false; + counter := 0; + end; + end else //space + begin + inc( counter ); + if counter > DashSpace - 1 then begin - inc(counter); - if counter > DashSpace-1 then - begin - drawdash := true; - counter := 0; - end; + drawdash := true; + counter := 0; end; + end; y := y + dy; if y >= dx then @@ -1745,24 +1752,24 @@ 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 - SDL_PutPixel( DstSurface, px, py, Color ); - inc(counter); - if (counter > DashLength-1) and (DashSpace > 0) then - begin - drawdash := false; - counter := 0; - end; - end + drawdash := false; + counter := 0; + end; + end else //space + begin + inc( counter ); + if counter > DashSpace - 1 then begin - inc(counter); - if counter > DashSpace-1 then - begin - drawdash := true; - counter := 0; - end; + drawdash := true; + counter := 0; end; + end; x := x + dx; if x >= dy then @@ -1878,13 +1885,14 @@ begin end; // flips a rectangle vertically on given surface + procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); var - TmpRect : TSDL_Rect; - Locked : boolean; + TmpRect : TSDL_Rect; + Locked : boolean; y, FlipLength, RowLength : integer; - Row1, Row2 : Pointer; - OneRow : TByteArray; // Optimize it if you wish + Row1, Row2 : Pointer; + OneRow : TByteArray; // Optimize it if you wish begin if DstSurface <> nil then begin @@ -1920,6 +1928,7 @@ begin 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; @@ -1928,15 +1937,15 @@ type TLongWordArray = array[ 0..8191 ] of LongWord; PLongWordArray = ^TLongWordArray; var - TmpRect : TSDL_Rect; - Row8bit : PByteArray; - Row16bit : PWordArray; - Row24bit : P24bitArray; - Row32bit : PLongWordArray; + TmpRect : TSDL_Rect; + Row8bit : PByteArray; + Row16bit : PWordArray; + Row24bit : P24bitArray; + Row32bit : PLongWordArray; y, x, RightSide, FlipLength : integer; - Pixel : cardinal; - Pixel24 : T24bit; - Locked : boolean; + Pixel : cardinal; + Pixel24 : T24bit; + Locked : boolean; begin if DstSurface <> nil then begin @@ -2030,9 +2039,10 @@ 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; + Rect : PSDL_Rect; begin New( Rect ); with Rect^ do @@ -2103,10 +2113,11 @@ begin 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; + dst_surface : PSDL_Surface; dx, dy, e, d, dx2, srcx2, srcy2 : integer; destx1, desty1 : integer; begin @@ -2153,7 +2164,7 @@ end; procedure SDL_MoveLine( Surface : PSDL_Surface; x1, x2, y1, xofs, depth : integer ); var src_pixels, dst_pixels : PUint8; - i : integer; + i : integer; begin src_pixels := PUint8( integer( Surface^.pixels ) + Surface^.w * y1 * depth + x2 * depth ); @@ -2171,8 +2182,8 @@ 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; + bpp : UInt32; + p : PInteger; begin bpp := SrcSurface.format.BytesPerPixel; // Here p is the address to the pixel we want to retrieve @@ -2199,8 +2210,8 @@ end; procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel : Uint32 ); var - bpp : UInt32; - p : PInteger; + bpp : UInt32; + p : PInteger; begin bpp := DstSurface.format.BytesPerPixel; p := Pointer( Uint32( DstSurface.pixels ) + UInt32( y ) * DstSurface.pitch + UInt32( x ) @@ -2228,9 +2239,9 @@ end; procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer ); var - r1, r2 : TSDL_Rect; + r1, r2 : TSDL_Rect; //buffer: PSDL_Surface; - YPos : Integer; + YPos : Integer; begin if ( DstSurface <> nil ) and ( DifY <> 0 ) then begin @@ -2282,8 +2293,8 @@ end;} procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer ); var - r1, r2 : TSDL_Rect; - buffer : PSDL_Surface; + r1, r2 : TSDL_Rect; + buffer : PSDL_Surface; begin if ( DstSurface <> nil ) and ( DifX <> 0 ) then begin @@ -2310,14 +2321,14 @@ end; procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single ); var - aSin, aCos : Single; + 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; + MAXX, MAXY : Integer; begin // Rotate the surface to the target surface. TempTransparentColour := SrcSurface.format.colorkey; - if srcRect.w > srcRect.h then + {if srcRect.w > srcRect.h then begin Width := srcRect.w; Height := srcRect.w; @@ -2326,7 +2337,7 @@ begin begin Width := srcRect.h; Height := srcRect.h; - end; + end; } maxx := DstSurface.w; maxy := DstSurface.h; @@ -2384,8 +2395,8 @@ end; function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect; var - RealRect : TSDL_Rect; - OutOfRange : Boolean; + RealRect : TSDL_Rect; + OutOfRange : Boolean; begin OutOfRange := false; if dstrect = nil then @@ -2457,9 +2468,9 @@ end; procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); var - RealRect : TSDL_Rect; - Addr : pointer; - ModX, BPP : cardinal; + RealRect : TSDL_Rect; + Addr : pointer; + ModX, BPP : cardinal; x, y, R, G, B, SrcColor : cardinal; begin RealRect := ValidateSurfaceRect( DstSurface, DstRect ); @@ -2590,9 +2601,9 @@ end; procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); var - RealRect : TSDL_Rect; - Addr : pointer; - ModX, BPP : cardinal; + RealRect : TSDL_Rect; + Addr : pointer; + ModX, BPP : cardinal; x, y, R, G, B, SrcColor : cardinal; begin RealRect := ValidateSurfaceRect( DstSurface, DstRect ); @@ -2723,13 +2734,13 @@ 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; + 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; + TempRect : TSDL_Rect; begin // calc FBC @@ -2787,328 +2798,328 @@ begin end; end; -procedure SDL_2xBlit(Src, Dest: PSDL_Surface); +procedure SDL_2xBlit( Src, Dest : PSDL_Surface ); var - ReadAddr, WriteAddr, ReadRow, WriteRow: UInt32; - SrcPitch, DestPitch, x, y: UInt32; + ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32; + SrcPitch, DestPitch, x, y : UInt32; begin - if (Src = nil) or (Dest = nil) then + if ( Src = nil ) or ( Dest = nil ) then exit; - if (Src.w shl 1) < Dest.w then + if ( Src.w shl 1 ) < Dest.w then exit; - if (Src.h shl 1) < Dest.h then + 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); + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); - ReadRow := UInt32(Src.Pixels); - WriteRow := UInt32(Dest.Pixels); + ReadRow := UInt32( Src.Pixels ); + WriteRow := UInt32( 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(UInt32(ReadRow), SrcPitch); - inc(UInt32(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(UInt32(ReadRow), SrcPitch); - inc(UInt32(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(UInt32(ReadRow), SrcPitch); - inc(UInt32(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(UInt32(ReadRow), SrcPitch); - inc(UInt32(WriteRow), DestPitch * 2); - end; + 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; end; - if SDL_MustLock(Src) then - SDL_UnlockSurface(Src); - if SDL_MustLock(Dest) then - SDL_UnlockSurface(Dest); + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); end; -procedure SDL_Scanline2xBlit(Src, Dest: PSDL_Surface); +procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface ); var - ReadAddr, WriteAddr, ReadRow, WriteRow: UInt32; - SrcPitch, DestPitch, x, y: UInt32; + ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32; + SrcPitch, DestPitch, x, y : UInt32; begin - if (Src = nil) or (Dest = nil) then + if ( Src = nil ) or ( Dest = nil ) then exit; - if (Src.w shl 1) < Dest.w then + if ( Src.w shl 1 ) < Dest.w then exit; - if (Src.h shl 1) < Dest.h then + 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); + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); - ReadRow := UInt32(Src.Pixels); - WriteRow := UInt32(Dest.Pixels); + ReadRow := UInt32( Src.Pixels ); + WriteRow := UInt32( 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(UInt32(ReadRow), SrcPitch); - inc(UInt32(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(UInt32(ReadRow), SrcPitch); - inc(UInt32(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(UInt32(ReadRow), SrcPitch); - inc(UInt32(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(UInt32(ReadRow), SrcPitch); - inc(UInt32(WriteRow), DestPitch * 2); - end; + 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; end; - if SDL_MustLock(Src) then - SDL_UnlockSurface(Src); - if SDL_MustLock(Dest) then - SDL_UnlockSurface(Dest); + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); end; -procedure SDL_50Scanline2xBlit(Src, Dest: PSDL_Surface); +procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface ); var - ReadAddr, WriteAddr, ReadRow, WriteRow: UInt32; - SrcPitch, DestPitch, x, y, Color: UInt32; + ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32; + SrcPitch, DestPitch, x, y, Color : UInt32; begin - if (Src = nil) or (Dest = nil) then + if ( Src = nil ) or ( Dest = nil ) then exit; - if (Src.w shl 1) < Dest.w then + if ( Src.w shl 1 ) < Dest.w then exit; - if (Src.h shl 1) < Dest.h then + 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); + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); - ReadRow := UInt32(Src.Pixels); - WriteRow := UInt32(Dest.Pixels); + ReadRow := UInt32( Src.Pixels ); + WriteRow := UInt32( 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(UInt32(ReadRow), SrcPitch); - inc(UInt32(WriteRow), DestPitch * 2); - end; - 15: for y := 1 to Src.h do + 8 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w 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(UInt32(ReadRow), SrcPitch); - inc(UInt32(WriteRow), DestPitch * 2); + 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; - 16: for y := 1 to Src.h do + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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 - 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(UInt32(ReadRow), SrcPitch); - inc(UInt32(WriteRow), DestPitch * 2); + 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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; - 24: for y := 1 to Src.h do + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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 - 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(UInt32(ReadRow), SrcPitch); - inc(UInt32(WriteRow), DestPitch * 2); + 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; - 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(UInt32(ReadRow), SrcPitch); - inc(UInt32(WriteRow), DestPitch * 2); - end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( 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( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; end; - if SDL_MustLock(Src) then - SDL_UnlockSurface(Src); - if SDL_MustLock(Dest) then - SDL_UnlockSurface(Dest); + 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; + 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; + Scan1Start, {Scan2Start,} ScanWidth, ScanHeight : cardinal; + Mod1 : cardinal; + Addr1 : cardinal; + BPP : cardinal; + Pitch1 : cardinal; TransparentColor1 : cardinal; - tx, ty : cardinal; - StartTick : cardinal; - Color1 : cardinal; + tx, ty : cardinal; + StartTick : cardinal; + Color1 : cardinal; begin Result := false; if SrcRect1 = nil then @@ -3124,7 +3135,7 @@ begin else Src_Rect1 := SrcRect1^; - Src_Rect2 := SrcRect2^; + Src_Rect2 := SrcRect2^; with Src_Rect1 do begin Right1 := Left1 + w; @@ -3135,15 +3146,13 @@ begin Right2 := Left2 + w; Bottom2 := Top2 + h; end; - if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( -Bottom1 <= - Top2 ) then + 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; + //Scan2Start := Src_Rect2.x; ScanWidth := Right1 - Left2; with Src_Rect2 do if ScanWidth > w then @@ -3153,7 +3162,7 @@ Bottom1 <= begin // 1. right, 2. left Scan1Start := Src_Rect1.x; - Scan2Start := Src_Rect2.x + Left1 - Left2; + //Scan2Start := Src_Rect2.x + Left1 - Left2; ScanWidth := Right2 - Left1; with Src_Rect1 do if ScanWidth > w then @@ -3213,7 +3222,7 @@ Bottom1 <= begin for tx := 1 to ScanWidth do begin - if ( PWord( Addr1 )^ <> TransparentColor1 ) then + if ( PWord( Addr1 )^ <> TransparentColor1 ) then begin Result := true; exit; @@ -3248,7 +3257,7 @@ Bottom1 <= begin for tx := 1 to ScanWidth do begin - if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then + if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then begin Result := true; exit; @@ -3266,12 +3275,12 @@ procedure SDL_ORSurface( 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; + Src, Dest : TSDL_Rect; + Diff : integer; SrcAddr, DestAddr : cardinal; WorkX, WorkY : word; SrcMod, DestMod : cardinal; - Bits : cardinal; + Bits : cardinal; begin if ( SrcSurface = nil ) or ( DestSurface = nil ) then exit; // Remove this to make it faster @@ -3366,7 +3375,7 @@ begin if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then begin Pixel2 := PUInt8( DestAddr )^; - PUInt8( DestAddr )^ := Pixel2 OR Pixel1; + PUInt8( DestAddr )^ := Pixel2 or Pixel1; end; inc( SrcAddr ); inc( DestAddr ); @@ -3387,7 +3396,7 @@ begin begin Pixel2 := PUInt16( DestAddr )^; - PUInt16( DestAddr )^ := Pixel2 OR Pixel1; + PUInt16( DestAddr )^ := Pixel2 or Pixel1; end; inc( SrcAddr, 2 ); @@ -3409,7 +3418,7 @@ begin begin Pixel2 := PUInt16( DestAddr )^; - PUInt16( DestAddr )^ := Pixel2 OR Pixel1; + PUInt16( DestAddr )^ := Pixel2 or Pixel1; end; inc( SrcAddr, 2 ); @@ -3452,7 +3461,7 @@ begin begin Pixel2 := PUInt32( DestAddr )^; - PUInt32( DestAddr )^ := Pixel2 or Pixel1; + PUInt32( DestAddr )^ := Pixel2 or Pixel1; end; inc( SrcAddr, 4 ); inc( DestAddr, 4 ); @@ -3472,12 +3481,12 @@ procedure SDL_ANDSurface( 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; + Src, Dest : TSDL_Rect; + Diff : integer; SrcAddr, DestAddr : cardinal; WorkX, WorkY : word; SrcMod, DestMod : cardinal; - Bits : cardinal; + Bits : cardinal; begin if ( SrcSurface = nil ) or ( DestSurface = nil ) then exit; // Remove this to make it faster @@ -3615,7 +3624,7 @@ begin begin Pixel2 := PUInt16( DestAddr )^; - PUInt16( DestAddr )^ := Pixel2 and Pixel1; + PUInt16( DestAddr )^ := Pixel2 and Pixel1; end; inc( SrcAddr, 2 ); @@ -3658,7 +3667,7 @@ begin begin Pixel2 := PUInt32( DestAddr )^; - PUInt32( DestAddr )^ := Pixel2 and Pixel1; + PUInt32( DestAddr )^ := Pixel2 and Pixel1; end; inc( SrcAddr, 4 ); inc( DestAddr, 4 ); @@ -3680,12 +3689,12 @@ 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; + Src, Dest : TSDL_Rect; + Diff : integer; SrcAddr, DestAddr : cardinal; WorkX, WorkY : word; SrcMod, DestMod : cardinal; - Bits : cardinal; + Bits : cardinal; begin if ( SrcSurface = nil ) or ( DestSurface = nil ) then exit; // Remove this to make it faster @@ -3782,9 +3791,18 @@ 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 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; @@ -3818,9 +3836,18 @@ begin 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; + 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 @@ -3848,9 +3875,18 @@ begin 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; + 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 @@ -3878,9 +3914,18 @@ begin 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; + 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 @@ -3908,9 +3953,18 @@ begin 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; + 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 @@ -3936,12 +3990,12 @@ 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; + Src, Dest : TSDL_Rect; + Diff : integer; SrcAddr, DestAddr : cardinal; WorkX, WorkY : word; SrcMod, DestMod : cardinal; - Bits : cardinal; + Bits : cardinal; begin if ( SrcSurface = nil ) or ( DestSurface = nil ) then exit; // Remove this to make it faster @@ -4038,9 +4092,18 @@ 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 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; @@ -4074,9 +4137,18 @@ begin 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; + 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 @@ -4104,9 +4176,18 @@ begin 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; + 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 @@ -4134,9 +4215,18 @@ begin 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; + 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 @@ -4164,9 +4254,18 @@ begin 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; + 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 @@ -4188,69 +4287,75 @@ begin 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; +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; + 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); + 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 or flag2 ) = 0 then + Exit; // all in - if (flag1 and flag2) <> 0 then - begin - result := false; - Exit; // all out - end; + 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; + 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 + 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; + 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 - flag2 := ClipCode(x2, y2); + 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 ef290071..ba60714b 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas @@ -1,6 +1,6 @@ unit sdlwindow; { - $Id: sdlwindow.pas,v 1.7 2004/09/30 22:35:47 savage Exp $ + $Id: sdlwindow.pas,v 1.9 2006/10/22 18:55:25 savage Exp $ } {******************************************************************************} @@ -59,6 +59,12 @@ unit sdlwindow; { } { $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. @@ -171,15 +177,8 @@ type function Show : Boolean; virtual; end; - TSDL2DWindow = class( TSDLBaseWindow ) + TSDLCustomWindow = class( TSDLBaseWindow ) 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; property OnCreate; property OnDestroy; property OnClose; @@ -190,7 +189,18 @@ type property DisplaySurface; end; - TSDL3DWindow = class( TSDLBaseWindow ) + 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; @@ -199,14 +209,6 @@ type procedure InitialiseObjects; override; procedure RestoreObjects; override; procedure DeleteObjects; override; - property OnCreate; - property OnDestroy; - property OnClose; - property OnShow; - property OnResize; - property OnRender; - property OnUpdate; - property DisplaySurface; end; @@ -226,7 +228,7 @@ begin Log.LogError( Format('Could not set video mode: %s', [SDL_GetError]), 'Main'); exit; end; - + SetCaption( 'Made with JEDI-SDL', 'JEDI-SDL Icon' ); end; @@ -552,7 +554,7 @@ end; procedure TSDL3DWindow.Render; begin inherited; - + end; procedure TSDL3DWindow.RestoreObjects; -- cgit v1.2.3