diff options
| -rw-r--r-- | src/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas | 506 | ||||
| -rw-r--r-- | src/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas | 565 |
2 files changed, 0 insertions, 1071 deletions
diff --git a/src/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas b/src/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas deleted file mode 100644 index 5c626372..00000000 --- a/src/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas +++ /dev/null @@ -1,506 +0,0 @@ -unit sdl_ttf; -{ - $Id: sdl_ttf.pas,v 1.19 2007/12/05 22:54:20 savage Exp $ - -} -{******************************************************************************} -{ } -{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } -{ Conversion of the Simple DirectMedia Layer 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_ttf.h } -{ } -{ The initial developer of this Pascal code was : } -{ Dominqiue Louis <Dominique@SavageSoftware.com.au> } -{ } -{ Portions created by Dominqiue Louis are } -{ Copyright (C) 2000 - 2001 Dominqiue Louis. } -{ } -{ } -{ Contributor(s) } -{ -------------- } -{ Tom Jones <tigertomjones@gmx.de> His Project inspired this conversion } -{ } -{ 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 } -{ ---------------- } -{ December 08 2002 - DL : Fixed definition of TTF_RenderUnicode_Solid } -{ } -{ 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 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_ttf.pas,v $ - Revision 1.19 2007/12/05 22:54:20 savage - Better Mac OS X support for Frameworks. - - 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 ) - - Revision 1.9 2005/01/01 02:15:20 savage - Updated to v2.0.7 - - Revision 1.8 2004/10/07 21:02:32 savage - Fix for FPC - - Revision 1.7 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. - - 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:24 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/16 22:16:40 savage - v1.0 changes - - -} -{******************************************************************************} - -{$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 __GPC__} - gpc, -{$ENDIF} - -{$IFDEF WINDOWS} - {$IFNDEF __GPC__} - Windows, - {$ENDIF} -{$ENDIF} - sdl; - -const -{$IFDEF WINDOWS} - SDLttfLibName = 'SDL_ttf.dll'; -{$ENDIF} - -{$IFDEF UNIX} -{$IFDEF DARWIN} - SDLttfLibName = 'libSDL_ttf-2.0.0.dylib'; - {$linklib libSDL_ttf} -{$ELSE} - {$IFDEF FPC} - SDLttfLibName = 'libSDL_ttf.so'; - {$ELSE} - SDLttfLibName = 'libSDL_ttf-2.0.so.0'; - {$ENDIF} -{$ENDIF} -{$ENDIF} - -{$IFDEF MACOS} - SDLttfLibName = 'SDL_ttf'; - {$linklib libSDL_ttf} -{$ENDIF} - - {* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *} - SDL_TTF_MAJOR_VERSION = 2; -{$EXTERNALSYM SDL_TTF_MAJOR_VERSION} - SDL_TTF_MINOR_VERSION = 0; -{$EXTERNALSYM SDL_TTF_MINOR_VERSION} - SDL_TTF_PATCHLEVEL = 9; -{$EXTERNALSYM SDL_TTF_PATCHLEVEL} - - // Backwards compatibility - TTF_MAJOR_VERSION = SDL_TTF_MAJOR_VERSION; - TTF_MINOR_VERSION = SDL_TTF_MINOR_VERSION; - TTF_PATCHLEVEL = SDL_TTF_PATCHLEVEL; - -{* - Set and retrieve the font style - This font style is implemented by modifying the font glyphs, and - doesn't reflect any inherent properties of the truetype font file. -*} - TTF_STYLE_NORMAL = $00; - TTF_STYLE_BOLD = $01; - TTF_STYLE_ITALIC = $02; - TTF_STYLE_UNDERLINE = $04; - -// ZERO WIDTH NO-BREAKSPACE (Unicode byte order mark) - UNICODE_BOM_NATIVE = $FEFF; - UNICODE_BOM_SWAPPED = $FFFE; - -type - PTTF_Font = ^TTTF_font; - TTTF_Font = record - end; - -{ This macro can be used to fill a version structure with the compile-time - version of the SDL_ttf library. } -procedure SDL_TTF_VERSION( var X : TSDL_version ); -{$EXTERNALSYM SDL_TTF_VERSION} - -{ This function gets the version of the dynamically linked SDL_ttf library. - It should NOT be used to fill a version structure, instead you should use the - SDL_TTF_VERSION() macro. } -function TTF_Linked_Version : PSDL_version; -cdecl; external {$IFDEF __GPC__}name 'TTF_Linked_Version'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_Linked_Version} - -{ This function tells the library whether UNICODE text is generally - byteswapped. A UNICODE BOM character in a string will override - this setting for the remainder of that string. -} -procedure TTF_ByteSwappedUNICODE( swapped : integer ); -cdecl; external {$IFDEF __GPC__}name 'TTF_ByteSwappedUNICODE'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_ByteSwappedUNICODE} - -//returns 0 on succes, -1 if error occurs -function TTF_Init : integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_Init'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_Init} - -{ - Open a font file and create a font of the specified point size. - Some .fon fonts will have several sizes embedded in the file, so the - point size becomes the index of choosing which size. If the value - is too high, the last indexed size will be the default. -} -function TTF_OpenFont( const filename : Pchar; ptsize : integer ) : PTTF_Font; -cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFont'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_OpenFont} - -function TTF_OpenFontIndex( const filename : Pchar; ptsize : integer; index : Longint ): PTTF_Font; -cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFontIndex'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_OpenFontIndex} - -function TTF_OpenFontRW( src : PSDL_RWops; freesrc : integer; ptsize : integer ): PTTF_Font; -cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFontRW'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_OpenFontRW} - -function TTF_OpenFontIndexRW( src : PSDL_RWops; freesrc : integer; ptsize : integer; index : Longint ): PTTF_Font; -cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFontIndexRW'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_OpenFontIndexRW} - -function TTF_GetFontStyle( font : PTTF_Font) : integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_GetFontStyle'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_GetFontStyle} - -procedure TTF_SetFontStyle( font : PTTF_Font; style : integer ); -cdecl; external {$IFDEF __GPC__}name 'TTF_SetFontStyle'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_SetFontStyle} - -{ Get the total height of the font - usually equal to point size } -function TTF_FontHeight( font : PTTF_Font ) : Integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_FontHeight'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_FontHeight} - -{ Get the offset from the baseline to the top of the font - This is a positive value, relative to the baseline. -} -function TTF_FontAscent( font : PTTF_Font ) : Integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_FontAscent'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_FontAscent} -{ Get the offset from the baseline to the bottom of the font - This is a negative value, relative to the baseline. -} -function TTF_FontDescent( font : PTTF_Font ) : Integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_FontDescent'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_FontDescent} - -{ Get the recommended spacing between lines of text for this font } -function TTF_FontLineSkip( font : PTTF_Font ): Integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_FontLineSkip'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_FontLineSkip} - -{ Get the number of faces of the font } -function TTF_FontFaces( font : PTTF_Font ) : Longint; -cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaces'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_FontFaces} - -{ Get the font face attributes, if any } -function TTF_FontFaceIsFixedWidth( font : PTTF_Font ): Integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaceIsFixedWidth'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_FontFaceIsFixedWidth} - -function TTF_FontFaceFamilyName( font : PTTF_Font ): PChar; -cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaceFamilyName'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_FontFaceFamilyName} - -function TTF_FontFaceStyleName( font : PTTF_Font ): PChar; -cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaceStyleName'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_FontFaceStyleName} - -{ Get the metrics (dimensions) of a glyph } -function TTF_GlyphMetrics( font : PTTF_Font; ch : Uint16; - var minx : integer; var maxx : integer; - var miny : integer; var maxy : integer; - var advance : integer ): Integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_GlyphMetrics'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_GlyphMetrics} - -{ Get the dimensions of a rendered string of text } -function TTF_SizeText( font : PTTF_Font; const text : PChar; var w : integer; var y : integer ): Integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_SizeText'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_SizeText} - -function TTF_SizeUTF8( font : PTTF_Font; const text : PChar; var w : integer; var y : integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_SizeUTF8'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_SizeUTF8} - -function TTF_SizeUNICODE( font : PTTF_Font; const text : PUint16; var w : integer; var y : integer): Integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_SizeUNICODE'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_SizeUNICODE} - -{ Create an 8-bit palettized surface and render the given text at - fast quality with the given font and color. The 0 pixel is the - colorkey, giving a transparent background, and the 1 pixel is set - to the text color. - This function returns the new surface, or NULL if there was an error. -} -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; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUTF8_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderUTF8_Solid} - -function TTF_RenderUNICODE_Solid( font : PTTF_Font; - const text :PUint16; fg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUNICODE_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderUNICODE_Solid} - -{ -Create an 8-bit palettized surface and render the given glyph at - fast quality with the given font and color. The 0 pixel is the - colorkey, giving a transparent background, and the 1 pixel is set - to the text color. The glyph is rendered without any padding or - centering in the X direction, and aligned normally in the Y direction. - This function returns the new surface, or NULL if there was an error. -} -function TTF_RenderGlyph_Solid( font : PTTF_Font; - ch : Uint16; fg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderGlyph_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderGlyph_Solid} - -{ Create an 8-bit palettized surface and render the given text at - high quality with the given font and colors. The 0 pixel is background, - while other pixels have varying degrees of the foreground color. - This function returns the new surface, or NULL if there was an error. -} -function TTF_RenderText_Shaded( font : PTTF_Font; - const text : PChar; fg : TSDL_Color; bg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderText_Shaded} -function TTF_RenderUTF8_Shaded( font : PTTF_Font; - const text : PChar; fg : TSDL_Color; bg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUTF8_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderUTF8_Shaded} -function TTF_RenderUNICODE_Shaded( font : PTTF_Font; - const text : PUint16; fg : TSDL_Color; bg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUNICODE_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderUNICODE_Shaded} - -{ Create an 8-bit palettized surface and render the given glyph at - high quality with the given font and colors. The 0 pixel is background, - while other pixels have varying degrees of the foreground color. - The glyph is rendered without any padding or centering in the X - direction, and aligned normally in the Y direction. - This function returns the new surface, or NULL if there was an error. -} -function TTF_RenderGlyph_Shaded( font : PTTF_Font; ch : Uint16; fg : TSDL_Color; - bg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderGlyph_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderGlyph_Shaded} - -{ Create a 32-bit ARGB surface and render the given text at high quality, - using alpha blending to dither the font with the given color. - This function returns the new surface, or NULL if there was an error. -} -function TTF_RenderText_Blended( font : PTTF_Font; - const text : PChar; fg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderText_Blended} -function TTF_RenderUTF8_Blended( font : PTTF_Font; - const text : PChar; fg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUTF8_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderUTF8_Blended} -function TTF_RenderUNICODE_Blended( font : PTTF_Font; - const text: PUint16; fg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUNICODE_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderUNICODE_Blended} - -{ Create a 32-bit ARGB surface and render the given glyph at high quality, - using alpha blending to dither the font with the given color. - The glyph is rendered without any padding or centering in the X - direction, and aligned normally in the Y direction. - This function returns the new surface, or NULL if there was an error. -} -function TTF_RenderGlyph_Blended( font : PTTF_Font; ch : Uint16; fg : TSDL_Color ): PSDL_Surface; -cdecl; external {$IFDEF __GPC__}name 'TTF_RenderGlyph_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_RenderGlyph_Blended} - -{ For compatibility with previous versions, here are the old functions } -{#define TTF_RenderText(font, text, fg, bg) - TTF_RenderText_Shaded(font, text, fg, bg) -#define TTF_RenderUTF8(font, text, fg, bg) - TTF_RenderUTF8_Shaded(font, text, fg, bg) -#define TTF_RenderUNICODE(font, text, fg, bg) - TTF_RenderUNICODE_Shaded(font, text, fg, bg)} - -{ Close an opened font file } -procedure TTF_CloseFont( font : PTTF_Font ); -cdecl; external {$IFDEF __GPC__}name 'TTF_CloseFont'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_CloseFont} - -//De-initialize TTF engine -procedure TTF_Quit; -cdecl; external {$IFDEF __GPC__}name 'TTF_Quit'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_Quit} - -// Check if the TTF engine is initialized -function TTF_WasInit : integer; -cdecl; external {$IFDEF __GPC__}name 'TTF_WasInit'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; -{$EXTERNALSYM TTF_WasInit} - -// We'll use SDL for reporting errors -procedure TTF_SetError( fmt : PChar ); - -function TTF_GetError : PChar; - -implementation - -{$IFDEF __GPC__} - {$L 'sdl_ttf'} { link sdl_ttf.dll.a or libsdl_ttf.so or libsdl_ttf.a } -{$ENDIF} - -procedure SDL_TTF_VERSION( var X : TSDL_version ); -begin - X.major := SDL_TTF_MAJOR_VERSION; - X.minor := SDL_TTF_MINOR_VERSION; - X.patch := SDL_TTF_PATCHLEVEL; -end; - -procedure TTF_SetError( fmt : PChar ); -begin - SDL_SetError( fmt ); -end; - -function TTF_GetError : PChar; -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. diff --git a/src/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas b/src/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas deleted file mode 100644 index a457c1d9..00000000 --- a/src/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas +++ /dev/null @@ -1,565 +0,0 @@ -unit sdltruetypefont; -{ - $Id: sdltruetypefont.pas,v 1.5 2005/05/26 21:22:28 savage Exp $ - -} -{******************************************************************************} -{ } -{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } -{ Wrapper class for SDL_ttf } -{ } -{ The initial developer of this Pascal code was : } -{ Dominqiue Louis <Dominique@SavageSoftware.com.au> } -{ } -{ Portions created by Dominqiue Louis are } -{ Copyright (C) 2000 - 2001 Dominqiue Louis. } -{ } -{ } -{ Contributor(s) } -{ -------------- } -{ } -{ } -{ Obtained through: } -{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } -{ } -{ You may retrieve the latest version of this file at the Project } -{ JEDI home page, located at http://delphi-jedi.org } -{ } -{ The contents of this file are used with permission, subject to } -{ the Mozilla Public License Version 1.1 (the "License"); you may } -{ not use this file except in compliance with the License. You may } -{ obtain a copy of the License at } -{ http://www.mozilla.org/MPL/MPL-1.1.html } -{ } -{ Software distributed under the License is distributed on an } -{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } -{ implied. See the License for the specific language governing } -{ rights and limitations under the License. } -{ } -{ Description } -{ ----------- } -{ } -{ } -{ } -{ } -{ } -{ } -{ } -{ Requires } -{ -------- } -{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } -{ They are available from... } -{ http://www.libsdl.org . } -{ } -{ Programming Notes } -{ ----------------- } -{ } -{ } -{ } -{ } -{ Revision History } -{ ---------------- } -{ September 23 2004 - DL : Initial Creation } -{ - $Log: 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. - - -} -{******************************************************************************} - -interface - -uses - sdl, - sdl_ttf; - -type - TRenderType = ( rtLatin1, rtUTF8, rtUnicode ); - TSDLFontStyle = ( fsBold, fsItalic, fsUnderline, fsStrikeOut ); - - TSDLFontStyles = set of TSDLFontStyle; - - TTrueTypeFont = class( TObject ) - private - FFont : PTTF_Font; - FSolid : Boolean; - FBackGroundColour : TSDL_Color; - FForeGroundColour : TSDL_Color; - FRenderType : TRenderType; - FStyle : TSDLFontStyles; - FFontFile : string; - FFontSize : integer; - procedure PrepareFont; - - protected - - public - constructor Create( aFontFile : string; aRenderStyle : TSDLFontStyles = [ ]; aFontSize : integer = 14 ); - 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; - property RenderType : TRenderType read FRenderType write FRenderType; - property Solid : Boolean read FSolid write FSolid; - property Style : TSDLFontStyles read FStyle write FStyle; - property FontSize : integer read FFontSize write FFontSize; - end; - - -implementation - -uses - SysUtils; - -{ TTrueTypeFont } - -constructor TTrueTypeFont.Create( aFontFile : string; aRenderStyle : TSDLFontStyles; aFontSize : integer ); -begin - inherited Create; - if FileExists( aFontFile ) then - begin - FStyle := aRenderStyle; - FFontSize := aFontSize; - FSolid := false; - FBackGroundColour.r := 255; - FBackGroundColour.g := 255; - FBackGroundColour.b := 255; - FForeGroundColour.r := 0; - FForeGroundColour.g := 0; - FForeGroundColour.b := 0; - FRenderType := rtUnicode; - if ( TTF_Init >= 0 ) then - begin - FFontFile := aFontFile; - end - else - raise Exception.Create( 'Failed to Initialiase SDL_TTF' ); - end - else - raise Exception.Create( 'Font File does not exist' ); -end; - -destructor TTrueTypeFont.Destroy; -begin - if FFont <> nil then - TTF_CloseFont( FFont ); - TTF_Quit; - inherited; -end; - -function TTrueTypeFont.DrawText( aText : WideString ) : PSDL_Surface; -begin - PrepareFont; - - result := nil; - - case FRenderType of - rtLatin1 : - begin - if ( FSolid ) then - begin - result := TTF_RenderText_Solid( FFont, PChar( string( aText ) ), FForeGroundColour ); - end - else - begin - result := TTF_RenderText_Shaded( FFont, PChar( string( aText ) ), FForeGroundColour, FBackGroundColour ); - end; - end; - - rtUTF8 : - begin - if ( FSolid ) then - begin - result := TTF_RenderUTF8_Solid( FFont, PChar( string( aText ) ), FForeGroundColour ); - end - else - begin - result := TTF_RenderUTF8_Shaded( FFont, PChar( string( aText ) ), FForeGroundColour, FBackGroundColour ); - end; - end; - - rtUnicode : - begin - if ( FSolid ) then - begin - result := TTF_RenderUNICODE_Solid( FFont, PUInt16( aText ), FForeGroundColour ); - end - else - begin - result := TTF_RenderUNICODE_Shaded( FFont, PUInt16( aText ), FForeGroundColour, FBackGroundColour ); - end; - end; - end; -end; - -function TTrueTypeFont.DrawText( aText : WideString; aWidth, aHeight : Integer ) : PSDL_Surface; -var - textw, texth, i, yPos : integer; - strChopped : WideString; - SurfaceList : array of PSDL_Surface; - strlist : array of WideString; - ReturnedSurface : PSDL_Surface; - BltRect : TSDL_Rect; -begin - PrepareFont; - - // Do an initial check to see if it already fits - case FRenderType of - rtLatin1 : - begin - if TTF_SizeText( FFont, PChar( string( aText ) ), textw, texth ) = 0 then - begin - if ( textw < aWidth ) - and ( texth < aHeight ) then - begin - result := DrawText( aText ); - exit; - end - end; - end; - - rtUTF8 : - begin - if TTF_SizeUTF8( FFont, PChar( string( aText ) ), textw, texth ) = 0 then - begin - if ( textw < aWidth ) - and ( texth < aHeight ) then - begin - result := DrawText( aText ); - exit; - end - end; - end; - - rtUnicode : - begin - if TTF_SizeUNICODE( FFont, PUInt16( aText ), textw, texth ) = 0 then - begin - if ( textw < aWidth ) - and ( texth < aHeight ) then - begin - result := DrawText( aText ); - exit; - end - end; - end; - end; - - // Create the Surface we will be returning - ReturnedSurface := SDL_DisplayFormat( SDL_CreateRGBSurface( SDL_SRCCOLORKEY or SDL_RLEACCEL or SDL_HWACCEL, aWidth, aHeight, 16, 0, 0, 0, 0 ) ); - - // If we are still here there is some serious parsing to do - case FRenderType of - rtLatin1 : - begin - strChopped := aText; - i := Length( strChopped ); - while ( i <> 0 ) do - begin - if ( string( strChopped[ i ] ) <> ' ' ) and ( Integer( string( strChopped[ i ] ) ) <> 13 ) then - dec( i ) - else - begin - dec( i ); - if TTF_SizeText( FFont, PChar( string( Copy( strChopped, 0, i ) ) ), textw, texth ) = 0 then - begin - 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 ); - if TTF_SizeText( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then - begin - 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 - if ( FSolid ) then - begin - SurfaceList[ i ] := TTF_RenderText_Solid( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour ); - end - else - begin - SurfaceList[ i ] := TTF_RenderText_Shaded( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour, FBackGroundColour ); - end; - end; - end; - - rtUTF8 : - begin - strChopped := aText; - i := Length( strChopped ); - while ( i <> 0 ) do - begin - if ( string( strChopped[ i ] ) <> ' ' ) and ( Integer( string( strChopped[ i ] ) ) <> 13 ) then - dec( i ) - else - begin - dec( i ); - if TTF_SizeUTF8( FFont, PChar( string( Copy( strChopped, 0, i ) ) ), textw, texth ) = 0 then - begin - 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 ); - if TTF_SizeUTF8( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then - begin - 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 - if ( FSolid ) then - begin - SurfaceList[ i ] := TTF_RenderUTF8_Solid( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour ); - end - else - begin - SurfaceList[ i ] := TTF_RenderUTF8_Shaded( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour, FBackGroundColour ); - end; - end; - end; - - rtUnicode : - begin - strChopped := aText; - i := Length( strChopped ); - while ( i <> 0 ) do - begin - if ( string( strChopped[ i ] ) <> ' ' ) and ( Integer( string( strChopped[ i ] ) ) <> 13 ) then - dec( i ) - else - begin - dec( i ); - if TTF_SizeUNICODE( FFont, PUInt16( Copy( strChopped, 0, i ) ), textw, texth ) = 0 then - begin - 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 ); - if TTF_SizeUNICODE( FFont, PUInt16( strChopped ), textw, texth ) = 0 then - begin - 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 - if ( FSolid ) then - begin - SurfaceList[ i ] := TTF_RenderUNICODE_Solid( FFont, PUInt16( strlist[ i ] ), FForeGroundColour ); - end - else - begin - SurfaceList[ i ] := TTF_RenderUNICODE_Shaded( FFont, PUInt16( strlist[ i ] ), FForeGroundColour, FBackGroundColour ); - end; - end; - end; - end; - - // Now Draw the SurfaceList onto the resulting Surface - yPos := 6; - for i := Low( SurfaceList ) to High( SurfaceList ) do - begin - BltRect.x := 6; - BltRect.y := yPos; - BltRect.w := SurfaceList[ i ].w; - BltRect.h := SurfaceList[ i ].h; - SDL_BlitSurface( SurfaceList[ i ], nil, ReturnedSurface, @BltRect ); - yPos := yPos + TTF_FontHeight( FFont ); - end; - result := ReturnedSurface; - - for i := Low( SurfaceList ) to High( SurfaceList ) do - begin - SDL_FreeSurface( SurfaceList[ i ] ); - end; - SetLength( SurfaceList, 0 ); - 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; -begin - if FFont <> nil then - TTF_CloseFont( FFont ); - - FFont := TTF_OpenFont( PChar( FFontFile ), FFontSize ); - - renderstyle := TTF_STYLE_NORMAL; - if ( fsBold in FStyle ) then - renderstyle := renderstyle or TTF_STYLE_BOLD; - - if ( fsItalic in FStyle ) then - renderstyle := renderstyle or TTF_STYLE_ITALIC; - - if ( fsUnderline in FStyle ) then - renderstyle := renderstyle or TTF_STYLE_UNDERLINE; - - TTF_SetFontStyle( FFont, renderstyle ); -end; - -end. - |