paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 18:49:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronize with JEDI-SDL release

Browse Source 
git-svn-id: trunk@7899 -
This commit is contained in:
Almindor 2007-07-01 11:17:10 +00:00
parent 790490f833
commit 2986623dba
14 changed files with 3950 additions and 2930 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

282
packages/extra/sdl/jedi-sdl.inc
View File

@ -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.
@ -103,6 +121,199 @@
{.$define Debug} { uncomment for debugging }
{$IFNDEF FPC}
{$IFDEF __GPC__}
{$I-}
{$W-} // turn off GPC warnings
{$X+}
{$ELSE} {__GPC__}
{$IFDEF Debug}
{$F+,D+,Q-,L+,R+,I-,S+,Y+,A+}
{$ELSE}
{$F+,Q-,R-,S-,I-,A+}
{$ENDIF}
{$ENDIF} {__GPC__}
{$ELSE} {FPC}
//{$M+}
{$ENDIF} {FPC}
{$IFDEF LINUX}
{$DEFINE UNIX}
{$ENDIF}
{$IFDEF ver70}
{$IFDEF Windows}
{$DEFINE Win16}
{$ENDIF Windows}
{$IFDEF MSDOS}
{$DEFINE NO_EXPORTS}
{$ENDIF MSDOS}
{$IFDEF DPMI}
{$DEFINE BP_DPMI}
{$ENDIF}
{$DEFINE OS_16_BIT}
{$DEFINE __OS_DOS__}
{$ENDIF ver70}
{$IFDEF ver80}
{$DEFINE Delphi} {Delphi 1.x}
{$DEFINE Delphi16}
{$DEFINE Win16}
{$DEFINE OS_16_BIT}
{$DEFINE __OS_DOS__}
{$ENDIF ver80}
{$IFDEF ver90}
{$DEFINE Delphi} {Delphi 2.x}
{$DEFINE Delphi32}
{$DEFINE WIN32}
{$DEFINE WINDOWS}
{$ENDIF ver90}
{$IFDEF ver100}
{$DEFINE Delphi} {Delphi 3.x}
{$DEFINE Delphi32}
{$DEFINE WIN32}
{$DEFINE WINDOWS}
{$ENDIF ver100}
{$IFDEF ver93}
{$DEFINE Delphi} {C++ Builder 1.x}
{$DEFINE Delphi32}
{$DEFINE WINDOWS}
{$ENDIF ver93}
{$IFDEF ver110}
{$DEFINE Delphi} {C++ Builder 3.x}
{$DEFINE Delphi32}
{$DEFINE WINDOWS}
{$ENDIF ver110}
{$IFDEF ver120}
{$DEFINE Delphi} {Delphi 4.x}
{$DEFINE Delphi32}
{$DEFINE Delphi4UP}
{$DEFINE Has_Int64}
{$DEFINE WINDOWS}
{$ENDIF ver120}
{$IFDEF ver130}
{$DEFINE Delphi} {Delphi 5.x}
{$DEFINE Delphi32}
{$DEFINE Delphi4UP}
{$DEFINE Delphi5UP}
{$DEFINE Has_Int64}
{$DEFINE WINDOWS}
{$ENDIF ver130}
{$IFDEF ver140}
{$DEFINE Delphi} {Delphi 6.x}
{$DEFINE Delphi32}
{$DEFINE Delphi4UP}
{$DEFINE Delphi5UP}
{$DEFINE Delphi6UP}
{$DEFINE Has_Int64}
{$DEFINE HAS_TYPES}
{$ENDIF ver140}
{$IFDEF ver150}
{$DEFINE Delphi} {Delphi 7.x}
{$DEFINE Delphi32}
{$DEFINE Delphi4UP}
{$DEFINE Delphi5UP}
{$DEFINE Delphi6UP}
{$DEFINE Delphi7UP}
{$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
{$DEFINE Has_Int64}
{$DEFINE HAS_TYPES}
{$ENDIF ver150}
{$IFDEF ver160}
{$DEFINE Delphi} {Delphi 8}
{$DEFINE Delphi32}
{$DEFINE Delphi4UP}
{$DEFINE Delphi5UP}
{$DEFINE Delphi6UP}
{$DEFINE Delphi7UP}
{$DEFINE Delphi8UP}
{$DEFINE Has_Int64}
{$DEFINE HAS_TYPES}
{$ENDIF ver160}
{$IFDEF ver170}
{$DEFINE Delphi} {Delphi 2005}
{$DEFINE Delphi32}
{$DEFINE Delphi4UP}
{$DEFINE Delphi5UP}
{$DEFINE Delphi6UP}
{$DEFINE Delphi7UP}
{$DEFINE Delphi8UP}
{$DEFINE Delphi9UP}
{$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
{$DEFINE Has_Int64}
{$DEFINE HAS_TYPES}
{$ENDIF ver170}
{$IFDEF ver180}
{$DEFINE Delphi} {Delphi 2006}
{$DEFINE Delphi32}
{$DEFINE Delphi4UP}
{$DEFINE Delphi5UP}
{$DEFINE Delphi6UP}
{$DEFINE Delphi7UP}
{$DEFINE Delphi8UP}
{$DEFINE Delphi9UP}
{$DEFINE Delphi10UP}
{$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
{$DEFINE Has_Int64}
{$DEFINE HAS_TYPES}
{$ENDIF ver180}
{$IFDEF ver185}
{$DEFINE Delphi} {Delphi 2007}
{$DEFINE Delphi32}
{$DEFINE Delphi4UP}
{$DEFINE Delphi5UP}
{$DEFINE Delphi6UP}
{$DEFINE Delphi7UP}
{$DEFINE Delphi8UP}
{$DEFINE Delphi9UP}
{$DEFINE Delphi10UP}
{$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
{$DEFINE Has_Int64}
{$DEFINE HAS_TYPES}
{$ENDIF ver180}
{$IFDEF UNIX}
{$ifdef VER140} // Kylix 1 & 2
{$DEFINE KYLIX}
{$DEFINE KYLIX1UP}
{$DEFINE KYLIX2UP}
{$DEFINE HAS_TYPES}
{$endif}
{$ifdef VER150} // Kylix 3
{$DEFINE KYLIX}
{$DEFINE KYLIX1UP}
{$DEFINE KYLIX2UP}
{$DEFINE KYLIX3UP}
{$DEFINE HAS_TYPES}
{$endif}
{$ENDIF UNIX}
{$IFDEF VirtualPascal} { Virtual Pascal 2.x }
{$DEFINE Delphi} { Use Delphi Syntax }
{$DEFINE VP2}
{&Delphi+}
{$ENDIF VirtualPascal}
{$IFDEF Delphi}
{$DEFINE Windows}
{$DEFINE USE_STDCALL}
//{$ALIGN ON}
{$ENDIF Delphi}
{$IFDEF FPC}
{$MODE Delphi} { use Delphi compatibility mode }
{$H+}
{$PACKRECORDS C} // Added for record
@ -114,14 +325,20 @@
{$DEFINE NO_EXPORTS}
{$DEFINE Has_Int64}
{$DEFINE NOCRT}
{$IFDEF unix}
{$IFDEF UNIX}
{$DEFINE fpc_unix}
{$ELSE}
{$DEFINE __OS_DOS__}
{$ENDIF}
{$IFDEF windows}
{$IFDEF WIN32}
{$DEFINE UseWin}
{$ENDIF}
{$DEFINE HAS_TYPES}
{$ENDIF FPC}
{$IFDEF Win16}
{$K+} {smart callbacks}
{$ENDIF Win16}
{$IFDEF OS2}
{$UNDEF Windows}
@ -129,13 +346,45 @@
{$DEFINE OS_BigMem}
{$ENDIF OS2}
{$IFDEF windows}
{$IFDEF __GPC__}
{$UNDEF UseWin}
{$UNDEF USE_STDCALL}
{$DEFINE OS_BigMem}
{$ELSE windows}
{$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 windows}
{$ENDIF Win32}
{ ************************** dos/dos-like platforms **************}
{$IFDEF Windows}
@ -166,3 +415,24 @@
{$DEFINE BY_NAME}
{$ENDIF}
{$ENDIF}
{$IFNDEF ver70}
{$UNDEF assembler}
{$ENDIF}
{*************** define LITTLE ENDIAN platforms ********************}
{$IFDEF Delphi}
{$DEFINE IA32}
{$ENDIF}
{$IFDEF KYLIX}
{$DEFINE IA32}
{$ENDIF}
{$IFDEF FPC}
{$IFDEF FPC_LITTLE_ENDIAN}
{$DEFINE IA32}
{$ENDIF}
{$ENDIF}

17
packages/extra/sdl/logger.pas
View File

@ -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} );*)

2
packages/extra/sdl/moduleloader.pas
View File

@ -59,7 +59,7 @@ interface
// each OS gets its own IFDEFed complete code block to make reading easier
{$IFDEF windows}
{$IFDEF WIN32}
uses
Windows;

661
packages/extra/sdl/sdl.pas
View File

File diff suppressed because it is too large Load Diff

1376
packages/extra/sdl/sdl_gfx.pas
View File

File diff suppressed because it is too large Load Diff

630
packages/extra/sdl/sdl_image.pas
View File

@ -1,285 +1,345 @@
unit sdl_image;
{
$Id: sdl_image.pas,v 1.7 2005/01/01 02:03:12 savage Exp $
}
{******************************************************************************}
{ }
{ Borland Delphi SDL_Image - An example image loading library for use }
{ with SDL }
{ Conversion of the Simple DirectMedia Layer Image Headers }
{ }
{ Portions created by Sam Lantinga <slouken@devolution.com> are }
{ Copyright (C) 1997, 1998, 1999, 2000, 2001 Sam Lantinga }
{ 5635-34 Springhouse Dr. }
{ Pleasanton, CA 94588 (USA) }
{ }
{ All Rights Reserved. }
{ }
{ The original files are : SDL_image.h }
{ }
{ The initial developer of this Pascal code was : }
{ Matthias Thoma <ma.thoma@gmx.de> }
{ }
{ Portions created by Matthias Thoma are }
{ Copyright (C) 2000 - 2001 Matthias Thoma. }
{ }
{ }
{ Contributor(s) }
{ -------------- }
{ Dominique Louis <Dominique@SavageSoftware.com.au> }
{ }
{ Obtained through: }
{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
{ }
{ You may retrieve the latest version of this file at the Project }
{ JEDI home page, located at http://delphi-jedi.org }
{ }
{ The contents of this file are used with permission, subject to }
{ the Mozilla Public License Version 1.1 (the "License"); you may }
{ not use this file except in compliance with the License. You may }
{ obtain a copy of the License at }
{ http://www.mozilla.org/MPL/MPL-1.1.html }
{ }
{ Software distributed under the License is distributed on an }
{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
{ implied. See the License for the specific language governing }
{ rights and limitations under the License. }
{ }
{ Description }
{ ----------- }
{ A simple library to load images of various formats as SDL surfaces }
{ }
{ Requires }
{ -------- }
{ SDL.pas in your search path. }
{ }
{ Programming Notes }
{ ----------------- }
{ See the Aliens Demo on how to make use of this libaray }
{ }
{ Revision History }
{ ---------------- }
{ April 02 2001 - MT : Initial Translation }
{ }
{ May 08 2001 - DL : Added ExternalSym derectives and copyright header }
{ }
{ 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_image.pas,v $
Revision 1.7 2005/01/01 02:03:12 savage
Updated to v1.2.4
Revision 1.6 2004/08/14 22:54:30 savage
Updated so that Library name defines are correctly defined for MacOS X.
Revision 1.5 2004/05/10 14:10:04 savage
Initial MacOS X support. Fixed defines for MACOS ( Classic ) and DARWIN ( MacOS X ).
Revision 1.4 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.3 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.2 2004/03/30 20:23:28 savage
Tidied up use of UNIX compiler directive.
Revision 1.1 2004/02/14 23:35:42 savage
version 1 of sdl_image, sdl_mixer and smpeg.
}
{******************************************************************************}
{$I jedi-sdl.inc}
interface
uses
{$IFDEF __GPC__}
gpc,
{$ENDIF}
sdl;
const
{$IFDEF windows}
SDL_ImageLibName = 'SDL_Image.dll';
{$ENDIF}
{$IFDEF UNIX}
{$IFDEF DARWIN}
SDL_ImageLibName = 'libSDL_image.dylib';
{$ELSE}
SDL_ImageLibName = 'libSDL_image.so';
{$ENDIF}
{$ENDIF}
{$IFDEF MACOS}
SDL_ImageLibName = 'SDL_image';
{$ENDIF}
// Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL
SDL_IMAGE_MAJOR_VERSION = 1;
{$EXTERNALSYM SDL_IMAGE_MAJOR_VERSION}
SDL_IMAGE_MINOR_VERSION = 2;
{$EXTERNALSYM SDL_IMAGE_MINOR_VERSION}
SDL_IMAGE_PATCHLEVEL = 4;
{$EXTERNALSYM SDL_IMAGE_PATCHLEVEL}
{ This macro can be used to fill a version structure with the compile-time
version of the SDL_image library. }
procedure SDL_IMAGE_VERSION( var X : TSDL_Version );
{$EXTERNALSYM SDL_IMAGE_VERSION}
{ This function gets the version of the dynamically linked SDL_image library.
it should NOT be used to fill a version structure, instead you should
use the SDL_IMAGE_VERSION() macro.
}
function IMG_Linked_Version : PSDL_version;
external {$IFDEF __GPC__}name 'IMG_Linked_Version'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_Linked_Version}
{ Load an image from an SDL data source.
The 'type' may be one of: "BMP", "GIF", "PNG", etc.
If the image format supports a transparent pixel, SDL will set the
colorkey for the surface. You can enable RLE acceleration on the
surface afterwards by calling:
SDL_SetColorKey(image, SDL_RLEACCEL, image.format.colorkey);
}
function IMG_LoadTyped_RW(src: PSDL_RWops; freesrc: Integer; _type: PChar): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTyped_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadTyped_RW}
{ Convenience functions }
function IMG_Load(const _file: PChar): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_Load'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_Load}
function IMG_Load_RW(src: PSDL_RWops; freesrc: Integer): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_Load_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_Load_RW}
{ Invert the alpha of a surface for use with OpenGL
This function is now a no-op, and only provided for backwards compatibility. }
function IMG_InvertAlpha(_on: Integer): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_InvertAlpha'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_InvertAlpha}
{ Functions to detect a file type, given a seekable source }
function IMG_isBMP(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isBMP'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isBMP}
function IMG_isPNM(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isPNM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isPNM}
function IMG_isXPM(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isXPM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isXPM}
function IMG_isXCF(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isXCF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isXCF}
function IMG_isPCX(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isPCX'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isPCX}
function IMG_isGIF(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isGIF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isGIF}
function IMG_isJPG(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isJPG'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isJPG}
function IMG_isTIF(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isTIF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isTIF}
function IMG_isPNG(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isPNG'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isPNG}
function IMG_isLBM(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isLBM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isLBM}
{ Individual loading functions }
function IMG_LoadBMP_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadBMP_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadBMP_RW}
function IMG_LoadPNM_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPNM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadPNM_RW}
function IMG_LoadXPM_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXPM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadXPM_RW}
function IMG_LoadXCF_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXCF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadXCF_RW}
function IMG_LoadPCX_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPCX_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadPCX_RW}
function IMG_LoadGIF_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadGIF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadGIF_RW}
function IMG_LoadJPG_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadJPG_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadJPG_RW}
function IMG_LoadTIF_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTIF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadTIF_RW}
function IMG_LoadPNG_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPNG_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadPNG_RW}
function IMG_LoadTGA_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTGA_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadTGA_RW}
function IMG_LoadLBM_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadLBM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadLBM_RW}
{ used internally, NOT an exported function }
//function IMG_string_equals( const str1 : PChar; const str2 : PChar ) : integer;
//cdecl; external {$IFDEF __GPC__}name 'IMG_string_equals'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
//{ $ EXTERNALSYM IMG_string_equals}
{ Error Macros }
{ We'll use SDL for reporting errors }
procedure IMG_SetError( fmt : PChar );
function IMG_GetError : PChar;
implementation
{$IFDEF __GPC__}
{$L 'sdl_image'} { link sdl_image.dll.a or libsdl_image.so or libsdl_image.a }
{$ENDIF}
procedure SDL_IMAGE_VERSION( var X : TSDL_Version );
begin
X.major := SDL_IMAGE_MAJOR_VERSION;
X.minor := SDL_IMAGE_MINOR_VERSION;
X.patch := SDL_IMAGE_PATCHLEVEL;
end;
procedure IMG_SetError( fmt : PChar );
begin
SDL_SetError( fmt );
end;
function IMG_GetError : PChar;
begin
result := SDL_GetError;
end;
end.
unit sdl_image;
{
$Id: sdl_image.pas,v 1.14 2007/05/29 21:31:13 savage Exp $
}
{******************************************************************************}
{ }
{ Borland Delphi SDL_Image - An example image loading library for use }
{ with SDL }
{ Conversion of the Simple DirectMedia Layer Image Headers }
{ }
{ Portions created by Sam Lantinga <slouken@devolution.com> are }
{ Copyright (C) 1997, 1998, 1999, 2000, 2001 Sam Lantinga }
{ 5635-34 Springhouse Dr. }
{ Pleasanton, CA 94588 (USA) }
{ }
{ All Rights Reserved. }
{ }
{ The original files are : SDL_image.h }
{ }
{ The initial developer of this Pascal code was : }
{ Matthias Thoma <ma.thoma@gmx.de> }
{ }
{ Portions created by Matthias Thoma are }
{ Copyright (C) 2000 - 2001 Matthias Thoma. }
{ }
{ }
{ Contributor(s) }
{ -------------- }
{ Dominique Louis <Dominique@SavageSoftware.com.au> }
{ }
{ Obtained through: }
{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
{ }
{ You may retrieve the latest version of this file at the Project }
{ JEDI home page, located at http://delphi-jedi.org }
{ }
{ The contents of this file are used with permission, subject to }
{ the Mozilla Public License Version 1.1 (the "License"); you may }
{ not use this file except in compliance with the License. You may }
{ obtain a copy of the License at }
{ http://www.mozilla.org/MPL/MPL-1.1.html }
{ }
{ Software distributed under the License is distributed on an }
{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
{ implied. See the License for the specific language governing }
{ rights and limitations under the License. }
{ }
{ Description }
{ ----------- }
{ A simple library to load images of various formats as SDL surfaces }
{ }
{ Requires }
{ -------- }
{ SDL.pas in your search path. }
{ }
{ Programming Notes }
{ ----------------- }
{ See the Aliens Demo on how to make use of this libaray }
{ }
{ Revision History }
{ ---------------- }
{ April 02 2001 - MT : Initial Translation }
{ }
{ May 08 2001 - DL : Added ExternalSym derectives and copyright header }
{ }
{ 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_image.pas,v $
Revision 1.14 2007/05/29 21:31:13 savage
Changes as suggested by Almindor for 64bit compatibility.
Revision 1.13 2007/05/20 20:30:54 savage
Initial Changes to Handle 64 Bits
Revision 1.12 2006/12/02 00:14:40 savage
Updated to latest version
Revision 1.11 2005/04/10 18:22:59 savage
Changes as suggested by Michalis, thanks.
Revision 1.10 2005/04/10 11:48:33 savage
Changes as suggested by Michalis, thanks.
Revision 1.9 2005/01/05 01:47:07 savage
Changed LibName to reflect what MacOS X should have. ie libSDL*-1.2.0.dylib respectively.
Revision 1.8 2005/01/04 23:14:44 savage
Changed LibName to reflect what most Linux distros will have. ie libSDL*-1.2.so.0 respectively.
Revision 1.7 2005/01/01 02:03:12 savage
Updated to v1.2.4
Revision 1.6 2004/08/14 22:54:30 savage
Updated so that Library name defines are correctly defined for MacOS X.
Revision 1.5 2004/05/10 14:10:04 savage
Initial MacOS X support. Fixed defines for MACOS ( Classic ) and DARWIN ( MacOS X ).
Revision 1.4 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.3 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.2 2004/03/30 20:23:28 savage
Tidied up use of UNIX compiler directive.
Revision 1.1 2004/02/14 23:35:42 savage
version 1 of sdl_image, sdl_mixer and smpeg.
}
{******************************************************************************}
{$I jedi-sdl.inc}
interface
uses
{$IFDEF __GPC__}
gpc,
{$ENDIF}
sdl;
const
{$IFDEF WINDOWS}
SDL_ImageLibName = 'SDL_Image.dll';
{$ENDIF}
{$IFDEF UNIX}
{$IFDEF DARWIN}
SDL_ImageLibName = 'libSDL_image-1.2.0.dylib';
{$ELSE}
{$IFDEF FPC}
SDL_ImageLibName = 'libSDL_image.so';
{$ELSE}
SDL_ImageLibName = 'libSDL_image-1.2.so.0';
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$IFDEF MACOS}
SDL_ImageLibName = 'SDL_image';
{$ENDIF}
// Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL
SDL_IMAGE_MAJOR_VERSION = 1;
{$EXTERNALSYM SDL_IMAGE_MAJOR_VERSION}
SDL_IMAGE_MINOR_VERSION = 2;
{$EXTERNALSYM SDL_IMAGE_MINOR_VERSION}
SDL_IMAGE_PATCHLEVEL = 5;
{$EXTERNALSYM SDL_IMAGE_PATCHLEVEL}
{ This macro can be used to fill a version structure with the compile-time
version of the SDL_image library. }
procedure SDL_IMAGE_VERSION( var X : TSDL_Version );
{$EXTERNALSYM SDL_IMAGE_VERSION}
{ This function gets the version of the dynamically linked SDL_image library.
it should NOT be used to fill a version structure, instead you should
use the SDL_IMAGE_VERSION() macro.
}
function IMG_Linked_Version : PSDL_version;
external {$IFDEF __GPC__}name 'IMG_Linked_Version'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_Linked_Version}
{ Load an image from an SDL data source.
The 'type' may be one of: "BMP", "GIF", "PNG", etc.
If the image format supports a transparent pixel, SDL will set the
colorkey for the surface. You can enable RLE acceleration on the
surface afterwards by calling:
SDL_SetColorKey(image, SDL_RLEACCEL, image.format.colorkey);
}
function IMG_LoadTyped_RW(src: PSDL_RWops; freesrc: Integer; _type: PChar): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTyped_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadTyped_RW}
{ Convenience functions }
function IMG_Load(const _file: PChar): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_Load'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_Load}
function IMG_Load_RW(src: PSDL_RWops; freesrc: Integer): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_Load_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_Load_RW}
{ Invert the alpha of a surface for use with OpenGL
This function is now a no-op, and only provided for backwards compatibility. }
function IMG_InvertAlpha(_on: Integer): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_InvertAlpha'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_InvertAlpha}
{ Functions to detect a file type, given a seekable source }
function IMG_isBMP(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isBMP'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isBMP}
function IMG_isGIF(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isGIF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isGIF}
function IMG_isJPG(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isJPG'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isJPG}
function IMG_isLBM(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isLBM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isLBM}
function IMG_isPCX(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isPCX'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isPCX}
function IMG_isPNG(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isPNG'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isPNG}
function IMG_isPNM(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isPNM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isPNM}
function IMG_isTIF(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isTIF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isTIF}
function IMG_isXCF(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isXCF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isXCF}
function IMG_isXPM(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isXPM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isXPM}
function IMG_isXV(src: PSDL_RWops): Integer;
cdecl; external {$IFDEF __GPC__}name 'IMG_isXV'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_isXV}
{ Individual loading functions }
function IMG_LoadBMP_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadBMP_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadBMP_RW}
function IMG_LoadGIF_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadGIF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadGIF_RW}
function IMG_LoadJPG_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadJPG_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadJPG_RW}
function IMG_LoadLBM_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadLBM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadLBM_RW}
function IMG_LoadPCX_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPCX_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadPCX_RW}
function IMG_LoadPNM_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPNM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadPNM_RW}
function IMG_LoadPNG_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPNG_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadPNG_RW}
function IMG_LoadTGA_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTGA_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadTGA_RW}
function IMG_LoadTIF_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTIF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadTIF_RW}
function IMG_LoadXCF_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXCF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadXCF_RW}
function IMG_LoadXPM_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXPM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadXPM_RW}
function IMG_LoadXV_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXV_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_LoadXV_RW}
function IMG_ReadXPMFromArray( xpm : PPChar ): PSDL_Surface;
cdecl; external {$IFDEF __GPC__}name 'IMG_ReadXPMFromArray'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
{$EXTERNALSYM IMG_ReadXPMFromArray}
{ used internally, NOT an exported function }
//function IMG_string_equals( const str1 : PChar; const str2 : PChar ) : integer;
//cdecl; external {$IFDEF __GPC__}name 'IMG_string_equals'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
//{ $ EXTERNALSYM IMG_string_equals}
{ Error Macros }
{ We'll use SDL for reporting errors }
procedure IMG_SetError( fmt : PChar );
function IMG_GetError : PChar;
implementation
{$IFDEF __GPC__}
{$L 'sdl_image'} { link sdl_image.dll.a or libsdl_image.so or libsdl_image.a }
{$ENDIF}
procedure SDL_IMAGE_VERSION( var X : TSDL_Version );
begin
X.major := SDL_IMAGE_MAJOR_VERSION;
X.minor := SDL_IMAGE_MINOR_VERSION;
X.patch := SDL_IMAGE_PATCHLEVEL;
end;
procedure IMG_SetError( fmt : PChar );
begin
SDL_SetError( fmt );
end;
function IMG_GetError : PChar;
begin
result := SDL_GetError;
end;
end.

2194
packages/extra/sdl/sdl_mixer.pas
View File

File diff suppressed because it is too large Load Diff

70
packages/extra/sdl/sdl_ttf.pas
View File

@ -1,6 +1,6 @@
unit sdl_ttf;
{
$Id: sdl_ttf.pas,v 1.10 2005/01/02 19:07:32 savage Exp $
$Id: sdl_ttf.pas,v 1.18 2007/06/01 11:16:33 savage Exp $
}
{******************************************************************************}
@ -87,6 +87,30 @@ unit sdl_ttf;
{ }
{
$Log: sdl_ttf.pas,v $
Revision 1.18 2007/06/01 11:16:33 savage
Added IFDEF UNIX for Workaround.
Revision 1.17 2007/06/01 08:38:21 savage
Added TTF_RenderText_Solid workaround as suggested by Michalis Kamburelis
Revision 1.16 2007/05/29 21:32:14 savage
Changes as suggested by Almindor for 64bit compatibility.
Revision 1.15 2007/05/20 20:32:45 savage
Initial Changes to Handle 64 Bits
Revision 1.14 2006/12/02 00:19:01 savage
Updated to latest version
Revision 1.13 2005/04/10 11:48:33 savage
Changes as suggested by Michalis, thanks.
Revision 1.12 2005/01/05 01:47:14 savage
Changed LibName to reflect what MacOS X should have. ie libSDL*-1.2.0.dylib respectively.
Revision 1.11 2005/01/04 23:14:57 savage
Changed LibName to reflect what most Linux distros will have. ie libSDL*-1.2.so.0 respectively.
Revision 1.10 2005/01/02 19:07:32 savage
Slight bug fix to use LongInt instead of Long ( Thanks Michalis Kamburelis )
@ -124,24 +148,46 @@ unit sdl_ttf;
{$I jedi-sdl.inc}
{
Define this to workaround a known bug in some freetype versions.
The error manifests as TTF_RenderGlyph_Solid returning nil (error)
and error message (in SDL_Error) is
"Failed loading DPMSDisable: /usr/lib/libX11.so.6: undefined symbol: DPMSDisable"
See [http://lists.libsdl.org/pipermail/sdl-libsdl.org/2007-March/060459.html]
}
{$IFDEF UNIX}
{$DEFINE Workaround_TTF_RenderText_Solid}
{$ENDIF}
interface
uses
{$IFDEF windows}
{$IFDEF __GPC__}
gpc,
{$ENDIF}
{$IFDEF WINDOWS}
{$IFNDEF __GPC__}
Windows,
{$ENDIF}
{$ENDIF}
sdl;
const
{$IFDEF windows}
{$IFDEF WINDOWS}
SDLttfLibName = 'SDL_ttf.dll';
{$ENDIF}
{$IFDEF UNIX}
{$IFDEF DARWIN}
SDLttfLibName = 'libSDL_ttf.dylib';
SDLttfLibName = 'libSDL_ttf-2.0.0.dylib';
{$ELSE}
SDLttfLibName = 'libSDL_ttf.so';
{$IFDEF FPC}
SDLttfLibName = 'libSDL_ttf.so';
{$ELSE}
SDLttfLibName = 'libSDL_ttf-2.0.so.0';
{$ENDIF}
{$ENDIF}
{$ENDIF}
@ -154,7 +200,7 @@ const
{$EXTERNALSYM SDL_TTF_MAJOR_VERSION}
SDL_TTF_MINOR_VERSION = 0;
{$EXTERNALSYM SDL_TTF_MINOR_VERSION}
SDL_TTF_PATCHLEVEL = 7;
SDL_TTF_PATCHLEVEL = 8;
{$EXTERNALSYM SDL_TTF_PATCHLEVEL}
// Backwards compatibility
@ -306,8 +352,10 @@ cdecl; external {$IFDEF __GPC__}name 'TTF_SizeUNICODE'{$ELSE} SDLttfLibName{$END
}
function TTF_RenderText_Solid( font : PTTF_Font;
const text : PChar; fg : TSDL_Color ): PSDL_Surface;
{$IFNDEF Workaround_TTF_RenderText_Solid}
cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
{$EXTERNALSYM TTF_RenderText_Solid}
{$ENDIF}
function TTF_RenderUTF8_Solid( font : PTTF_Font;
const text : PChar; fg : TSDL_Color ): PSDL_Surface;
@ -440,4 +488,14 @@ begin
result := SDL_GetError;
end;
{$IFDEF Workaround_TTF_RenderText_Solid}
function TTF_RenderText_Solid( font : PTTF_Font;
const text : PChar; fg : TSDL_Color ): PSDL_Surface;
const
Black: TSDL_Color = (r: 0; g: 0; b: 0; unused: 0);
begin
Result := TTF_RenderText_Shaded(font, text, fg, Black);
end;
{$ENDIF Workaround_TTF_RenderText_Solid}
end.

19
packages/extra/sdl/sdlgameinterface.pas
View File

@ -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;

251
packages/extra/sdl/sdlinput.pas
View File

@ -1,6 +1,6 @@
unit sdlinput;
{
$Id: sdlinput.pas,v 1.7 2004/09/30 22:32:04 savage Exp $
$Id: sdlinput.pas,v 1.8 2005/08/03 18:57:32 savage Exp $
}
{******************************************************************************}
@ -60,6 +60,9 @@ unit sdlinput;
{ February 02 2004 - DL : Added Custom Cursor Support to the Mouse class }
{
$Log: sdlinput.pas,v $
Revision 1.8 2005/08/03 18:57:32 savage
Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class
Revision 1.7 2004/09/30 22:32:04 savage
Updated with slightly different header comments
@ -187,6 +190,41 @@ type
TSDLMouseMoveEvent = procedure ( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
TSDLMouseWheelEvent = procedure ( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
TSDLCustomCursor = class( TObject )
private
FFileName : string;
FHotPoint: TPoint;
procedure SetFileName(const aValue: string );
function ScanForChar( str : string; ch : Char; startPos : Integer; lookFor : Boolean ) : Integer;
public
constructor Create( const aFileName : string; aHotPoint: TPoint );
procedure LoadFromFile( const aFileName : string ); virtual; abstract;
procedure LoadFromStream( aStream : TStream ); virtual; abstract;
procedure Show; virtual; abstract;
property FileName : string read FFileName write SetFileName;
property HotPoint : TPoint read FHotPoint write FHotPoint;
end;
TSDLXPMCursor = class( TSDLCustomCursor )
private
FCursor : PSDL_Cursor;
procedure FreeCursor;
public
destructor Destroy; override;
procedure LoadFromFile( const aFileName : string ); override;
procedure LoadFromStream( aStream : TStream ); override;
procedure Show; override;
end;
TSDLCursorList = class( TStringList )
protected
function GetObject( aIndex : Integer ): TSDLCustomCursor; reintroduce;
procedure PutObject( aIndex : Integer; AObject : TSDLCustomCursor); reintroduce;
public
constructor Create;
function AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer; virtual;
end;
TSDLMouse = class( TSDLCustomInput )
private
FDragging : Boolean;
@ -195,7 +233,7 @@ type
FOnMouseDown: TSDLMouseButtonEvent;
FOnMouseMove: TSDLMouseMoveEvent;
FOnMouseWheel: TSDLMouseWheelEvent;
FCursor : PSDL_Cursor; // Cursor Pointer
FCursorList : TSDLCursorList; // Cursor Pointer
procedure DoMouseMove( Event: TSDL_Event );
procedure DoMouseDown( Event: TSDL_Event );
procedure DoMouseUp( Event: TSDL_Event );
@ -207,7 +245,6 @@ type
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;
@ -215,6 +252,7 @@ type
property OnMouseMove : TSDLMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseWheel : TSDLMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
property MousePosition : TPoint read GetMousePosition write SetMousePosition;
property Cursors : TSDLCursorList read FCursorList write FCursorList;
end;
TSDLInputManager = class( TObject )
@ -235,6 +273,9 @@ type
implementation
uses
SysUtils;
{ TSDLCustomInput }
constructor TSDLCustomInput.Create;
begin
@ -355,8 +396,7 @@ end;
{ TSDLMouse }
destructor TSDLMouse.Destroy;
begin
if FCursor <> nil then
SDL_FreeCursor( FCursor );
inherited;
end;
@ -442,17 +482,6 @@ begin
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 );
@ -689,4 +718,194 @@ begin
end;
end;
{ TSDLCustomCursor }
constructor TSDLCustomCursor.Create(const aFileName: string; aHotPoint: TPoint);
begin
inherited Create;
FHotPoint := aHotPoint;
LoadFromFile( aFileName );
end;
function TSDLCustomCursor.ScanForChar(str: string; ch: Char;
startPos: Integer; lookFor: Boolean): Integer;
begin
Result := -1;
while ( ( ( str[ startPos ] = ch ) <> lookFor ) and ( startPos < Length( str ) ) ) do
inc( startPos );
if startPos <> Length( str ) then
Result := startPos;
end;
procedure TSDLCustomCursor.SetFileName(const aValue: string);
begin
LoadFromFile( aValue );
end;
{ TSDLXPMCursor }
destructor TSDLXPMCursor.Destroy;
begin
FreeCursor;
inherited;
end;
procedure TSDLXPMCursor.FreeCursor;
begin
if FCursor <> nil then
begin
SDL_FreeCursor( FCursor );
FFileName := '';
end;
end;
procedure TSDLXPMCursor.LoadFromFile(const aFileName: string);
var
xpmFile : Textfile;
step : Integer;
holdPos : Integer;
counter : Integer;
dimensions : array[ 1..3 ] of Integer;
clr, clrNone, clrBlack, clrWhite : Char;
data, mask : array of UInt8;
i, col : Integer;
LineString : string;
begin
FreeCursor;
AssignFile( xpmFile, aFileName );
Reset( xpmFile );
step := 0;
i := -1;
clrBlack := 'X';
clrWhite := ',';
clrNone := ' ';
counter := 0;
while not ( eof( xpmFile ) ) do
begin
Readln( xpmFile, LineString );
// scan for strings
if LineString[ 1 ] = '"' then
begin
case step of
0 : // Get dimensions (should be width height number-of-colors ???)
begin
HoldPos := 2;
counter := ScanForChar( LineString, ' ', HoldPos, False );
counter := ScanForChar( LineString, ' ', counter, True );
dimensions[ 1 ] := StrToInt( Copy( LineString, HoldPos, counter - HoldPos ) );
counter := ScanForChar( LineString, ' ', counter, False );
holdPos := counter;
counter := ScanForChar( LineString, ' ', counter, True );
dimensions[ 2 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );
counter := ScanForChar( LineString, ' ', counter, False );
holdPos := counter;
counter := ScanForChar( LineString, ' ', counter, True );
dimensions[ 3 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );
step := 1;
SetLength( data, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );
SetLength( mask, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );
//Log.LogStatus( 'Length = ' + IntToStr( ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 ), 'LoadCursorFromFile' );
end;
1 : // get the symbols for transparent, black and white
begin
// get the symbol for the color
clr := LineString[ 2 ];
// look for the 'c' symbol
counter := ScanForChar( LineString, 'c', 3, True );
inc( counter );
counter := ScanForChar( LineString, ' ', counter, False );
if LowerCase( Copy( LineString, counter, 4 ) ) = 'none' then
begin
clrNone := clr;
end;
if LowerCase( Copy( LineString, counter, 7 ) ) = '#ffffff' then
begin
clrWhite := clr;
end;
if LowerCase( Copy( LineString, counter, 7 ) ) = '#000000' then
begin
clrBlack := clr;
end;
dec( dimensions[ 3 ] );
if dimensions[ 3 ] = 0 then
begin
step := 2;
counter := 0;
end;
end;
2 : // get cursor information -- modified from the SDL
// documentation of SDL_CreateCursor.
begin
for col := 1 to dimensions[1] do
begin
if ( ( col mod 8 ) <> 1 ) then
begin
data[ i ] := data[ i ] shl 1;
mask[ i ] := mask[ i ] shl 1;
end
else
begin
inc( i );
data[ i ] := 0;
mask[ i ] := 0;
end;
if LineString[ col ] = clrWhite then
begin
mask[ i ] := mask[ i ] or $01;
end
else if LineString[ col ] = clrBlack then
begin
data[ i ] := data[ i ] or $01;
mask[ i ] := mask[ i ] or $01;
end
else if LineString[ col + 1 ] = clrNone then
begin
//
end;
end;
inc(counter);
if counter = dimensions[2] then
step := 4;
end;
end;
end;
end;
CloseFile( xpmFile );
FCursor := SDL_CreateCursor( PUInt8( data ), PUInt8( mask ), dimensions[ 1 ], dimensions[ 2 ], FHotPoint.x, FHotPoint.y );
end;
procedure TSDLXPMCursor.LoadFromStream(aStream: TStream);
begin
inherited;
end;
procedure TSDLXPMCursor.Show;
begin
inherited;
SDL_SetCursor( FCursor );
end;
{ TSDLCursorList }
function TSDLCursorList.AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer;
begin
result := inherited AddObject( aName, aObject );
end;
constructor TSDLCursorList.Create;
begin
inherited;
Duplicates := dupIgnore;
end;
function TSDLCursorList.GetObject(aIndex: Integer): TSDLCustomCursor;
begin
result := TSDLCustomCursor( inherited GetObject( aIndex ) );
end;
procedure TSDLCursorList.PutObject(aIndex: Integer; aObject: TSDLCustomCursor);
begin
inherited PutObject( aIndex, aObject );
end;
end.

99
packages/extra/sdl/sdlticks.pas
View File

@ -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 );
if FrameTime = 0 then
FrameTime := 1;
fps := FTicksPerSecond / FrameTime;
// reset the timer
s_lastTime := currentTime;
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.

180
packages/extra/sdl/sdltruetypefont.pas
View File

@ -1,6 +1,6 @@
unit sdltruetypefont;
{
$Id: sdltruetypefont.pas,v 1.1 2004/09/30 22:39:50 savage Exp $
$Id: sdltruetypefont.pas,v 1.5 2005/05/26 21:22:28 savage Exp $
}
{******************************************************************************}
@ -62,6 +62,21 @@ unit sdltruetypefont;
{ September 23 2004 - DL : Initial Creation }
{
$Log: sdltruetypefont.pas,v $
Revision 1.5 2005/05/26 21:22:28 savage
Update to Input code.
Revision 1.1 2005/05/25 23:15:42 savage
Latest Changes
Revision 1.4 2005/05/25 22:55:01 savage
Added InputRect support.
Revision 1.3 2005/05/13 14:02:49 savage
Made it use UniCode rendering by default.
Revision 1.2 2005/05/13 11:37:52 savage
Improved wordwrapping algorithm
Revision 1.1 2004/09/30 22:39:50 savage
Added a true type font class which contains a wrap text function.
Changed the sdl_ttf.pas header to reflect the future of jedi-sdl.
@ -93,6 +108,7 @@ type
FFontFile : string;
FFontSize : integer;
procedure PrepareFont;
protected
public
@ -100,6 +116,7 @@ type
destructor Destroy; override;
function DrawText( aText : WideString ) : PSDL_Surface; overload;
function DrawText( aText : WideString; aWidth, aHeight : Integer ) : PSDL_Surface; overload;
function Input(aDestination: PSDL_Surface; aX, aY, aWidth, aHeight: integer; var aText: string; aMaxChars: integer = 10 ): PSDL_Surface;
property BackGroundColour : TSDL_Color read FBackGroundColour write FBackGroundColour;
property ForeGroundColour : TSDL_Color read FForeGroundColour write FForeGroundColour;
property FontFile : string read FFontFile write FFontFile;
@ -131,7 +148,7 @@ begin
FForeGroundColour.r := 0;
FForeGroundColour.g := 0;
FForeGroundColour.b := 0;
FRenderType := rtUTF8;
FRenderType := rtUnicode;
if ( TTF_Init >= 0 ) then
begin
FFontFile := aFontFile;
@ -265,26 +282,31 @@ begin
else
begin
dec( i );
strChopped := Copy( strChopped, 0, i );
if TTF_SizeText( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then
if TTF_SizeText( FFont, PChar( string( Copy( strChopped, 0, i ) ) ), textw, texth ) = 0 then
begin
if ( textw < aWidth )
and ( texth < aHeight ) then
and ( texth < aHeight ) then
begin
SetLength( strlist, Length( strlist ) + 1 );
strlist[ Length( strlist ) - 1 ] := strChopped;
strChopped := Copy( aText, i + 2, Length( aText ) - ( i - 1 ) );
strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
i := Length( strChopped );
if TTF_SizeText( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then
begin
SetLength( strlist, Length( strlist ) + 1 );
strlist[ Length( strlist ) - 1 ] := strChopped;
break;
if ( textw < aWidth )
and ( texth < aHeight ) then
begin
SetLength( strlist, Length( strlist ) + 1 );
strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
i := Length( strChopped );
end;
end;
end;
end;
end;
end;
SetLength( SurfaceList, Length( strlist ) );
for i := Low( strlist ) to High( strlist ) do
begin
@ -310,26 +332,31 @@ begin
else
begin
dec( i );
strChopped := Copy( strChopped, 0, i );
if TTF_SizeUTF8( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then
if TTF_SizeUTF8( FFont, PChar( string( Copy( strChopped, 0, i ) ) ), textw, texth ) = 0 then
begin
if ( textw < aWidth )
and ( texth < aHeight ) then
and ( texth < aHeight ) then
begin
SetLength( strlist, Length( strlist ) + 1 );
strlist[ Length( strlist ) - 1 ] := strChopped;
strChopped := Copy( aText, i + 2, Length( aText ) - ( i - 1 ) );
strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
i := Length( strChopped );
if TTF_SizeUTF8( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then
begin
SetLength( strlist, Length( strlist ) + 1 );
strlist[ Length( strlist ) - 1 ] := strChopped;
break;
if ( textw < aWidth )
and ( texth < aHeight ) then
begin
SetLength( strlist, Length( strlist ) + 1 );
strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
i := Length( strChopped );
end;
end;
end;
end;
end;
end;
SetLength( SurfaceList, Length( strlist ) );
for i := Low( strlist ) to High( strlist ) do
begin
@ -355,21 +382,25 @@ begin
else
begin
dec( i );
strChopped := Copy( strChopped, 0, i );
if TTF_SizeUNICODE( FFont, PUInt16( strChopped ), textw, texth ) = 0 then
if TTF_SizeUNICODE( FFont, PUInt16( Copy( strChopped, 0, i ) ), textw, texth ) = 0 then
begin
if ( textw < aWidth )
and ( texth < aHeight ) then
and ( texth < aHeight ) then
begin
SetLength( strlist, Length( strlist ) + 1 );
strlist[ Length( strlist ) - 1 ] := strChopped;
strChopped := Copy( aText, i + 2, Length( aText ) - ( i - 1 ) );
strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
i := Length( strChopped );
if TTF_SizeUNICODE( FFont, PUInt16( strChopped ), textw, texth ) = 0 then
begin
SetLength( strlist, Length( strlist ) + 1 );
strlist[ Length( strlist ) - 1 ] := strChopped;
break;
if ( textw < aWidth )
and ( texth < aHeight ) then
begin
SetLength( strlist, Length( strlist ) + 1 );
strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
i := Length( strChopped );
end;
end;
end;
end;
@ -411,6 +442,103 @@ begin
SetLength( strlist, 0 );
end;
function TTrueTypeFont.Input(aDestination: PSDL_Surface; aX, aY, aWidth: integer; aHeight : integer; var aText : string; aMaxChars: integer): PSDL_Surface;
var
event : TSDL_Event;
ch : integer;
BackSurface, TextSurface : PSDL_Surface;
rect : SDL_Rect;
textw, texth : integer;
Done : boolean;
PassedInText : string;
begin
PassedInText := aText;
BackSurface := SDL_AllocSurface( aDestination.flags,
aDestination.w,
aDestination.h,
aDestination.format.BitsPerPixel,
aDestination.format.Rmask,
aDestination.format.Gmask,
aDestination.format.Bmask, 0 );
rect.x := aX;
rect.y := aY;
rect.w := aWidth;
rect.h := aHeight;
SDL_BlitSurface( aDestination, nil, BackSurface, nil );
SDL_FillRect( BackSurface, @rect, SDL_MapRGB( aDestination.format, 0, 0, 0 ) );
TextSurface := DrawText( aText + '|' );
// start input
SDL_EnableUNICODE( 1 );
Done := false;
while ( not Done ) and ( SDL_WaitEvent( @event ) > 0 ) do
begin
if event.type_ = SDL_KEYDOWN then
begin
ch := event.key.keysym.unicode;
case ch of
SDLK_RETURN :
begin
Done := true;
end;
SDLK_ESCAPE :
begin
aText := PassedInText;
Done := true;
end;
SDLK_BACKSPACE :
begin
if ( Length( aText ) > 0 ) then
begin
aText := Copy( aText, 0, Length( aText ) - 1 );
if TextSurface <> nil then
SDL_FreeSurface( TextSurface );
TextSurface := DrawText( aText + '|' );
end;
end;
else
begin
if Length( aText ) < aMaxChars then
begin
if ( chr( ch ) <> '' ) then
begin
aText := aText + chr( ch );
if ( aText <> '' )
and ( TTF_SizeUNICODE( FFont, PUInt16( aText ), textw, texth ) = 0 ) then
begin
if ( textw > aWidth ) then
aText := Copy( aText, 0, Length( aText ) - 1 );
end;
if TextSurface <> nil then
SDL_FreeSurface( TextSurface );
TextSurface := DrawText( aText + '|' );
end;
end;
end;
end;
end;
SDL_BlitSurface( BackSurface, nil, aDestination, nil );
SDL_BlitSurface( TextSurface, nil, aDestination, @rect );
SDL_Flip( aDestination );
end;
if TextSurface <> nil then
SDL_FreeSurface( TextSurface );
if aText <> '' then
TextSurface := DrawText( aText );
SDL_FreeSurface( BackSurface );
result := TextSurface;
end;
procedure TTrueTypeFont.PrepareFont;
var
renderstyle : integer;

1057
packages/extra/sdl/sdlutils.pas
View File

File diff suppressed because it is too large Load Diff

42
packages/extra/sdl/sdlwindow.pas
View File

@ -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;