renamed Jedi-SDL folder.

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

2 files changed, 888 insertions, 0 deletions

diff --git a/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas b/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas
new file mode 100644
index 00000000..eea69719
--- /dev/null
+++ b/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas
@@ -0,0 +1,451 @@
+unit sdl_ttf;

+{

+  $Id: sdl_ttf.pas,v 1.10 2005/01/02 19:07:32 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.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}

+

+{$ALIGN ON}

+

+interface

+

+uses

+{$IFDEF __GPC__}

+  gpc,

+{$ENDIF}

+

+{$IFDEF WIN32}

+  {$IFNDEF __GPC__}

+  Windows,

+  {$ENDIF}

+{$ENDIF}

+  sdl;

+

+const

+{$IFDEF WIN32}

+  SDLttfLibName = 'SDL_ttf.dll';

+{$ENDIF}

+

+{$IFDEF UNIX}

+{$IFDEF DARWIN}

+  SDLttfLibName = 'libSDL_ttf.dylib';

+{$ELSE}

+  SDLttfLibName = 'libSDL_ttf.so';

+{$ENDIF}

+{$ENDIF}

+

+{$IFDEF MACOS}

+  SDLttfLibName = 'SDL_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 = 7;

+{$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;

+cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__};

+{$EXTERNALSYM TTF_RenderText_Solid}

+

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

+

+end.

diff --git a/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas b/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas
new file mode 100644
index 00000000..4b53ddd9
--- /dev/null
+++ b/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas
@@ -0,0 +1,437 @@
+unit sdltruetypefont;

+{

+  $Id: sdltruetypefont.pas,v 1.1 2004/09/30 22:39:50 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.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;

+    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 := rtUTF8;

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

+          strChopped := Copy( strChopped, 0, i );

+          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 ] := strChopped;

+              strChopped := Copy( aText, i + 2, Length( aText ) - ( 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;

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

+          strChopped := Copy( strChopped, 0, i );

+          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 ] := strChopped;

+              strChopped := Copy( aText, i + 2, Length( aText ) - ( 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;

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

+          strChopped := Copy( strChopped, 0, i );

+          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 ] := strChopped;

+              strChopped := Copy( aText, i + 2, Length( aText ) - ( 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;

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

+

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

+