opengl
/
TextSuite
1
0
Fork 0
Código Incidencias 0 Pull Requests 0 Lanzamientos 0 Wiki Actividad
No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.
11 Commits
1 Rama
3.7 MiB
 
Árbol: ddc79b5b1b
Ramas Etiquetas
${ item.name }
Crear rama ${ searchTerm }
desde 'ddc79b5b1b'
${ noResults }
TextSuite/old/TextSuite.pas

3651 líneas
111 KiB
Original Blame Histórico 

  1. {

  2. TextSuite (C) Steffen Xonna (aka Lossy eX)

  3. http://www.opengl24.de/

  4. -----------------------------------------------------------------------

  5. For copyright informations see file copyright.txt.

  6. }

  7. 

  8. {$I TextSuiteOptions.inc}

  9. 

  10. unit TextSuite;

  11. 

  12. 

  13. interface

  14. 

  15. 

  16. type

  17.   tsBool = Cardinal;

  18.   tsByte = Byte;

  19.   tsInt = Integer;

  20.   tsFloat = Single;

  21.   tsEnum = Cardinal;

  22.   tsBitmask = Cardinal;

  23.   tsError = Cardinal;

  24. 

  25.   ptsBool = ^tsBool;

  26.   ptsByte = ^tsByte;

  27.   ptsInt = ^tsInt;

  28.   ptsEnum = ^tsEnum;

  29. 

  30.   tsContextID = Cardinal;

  31.   tsFontID = Cardinal;

  32.   tsImageID = Cardinal;

  33. 

  34.   ptsContextID = ^tsContextID;

  35.   ptsFontID = ^tsFontID;

  36.   ptsImageID = ^tsImageID;

  37. 

  38.   PPointer = ^Pointer;

  39. 

  40.   tsPostProcessProc = procedure(ImageID: tsImageID; CharCode: WideChar; Data: Pointer); cdecl;

  41. 

  42. 

  43.   // these types are more internally.

  44. 

  45.   ptsColor = ^tsColor;

  46.   tsColor = packed record

  47.     Red: Byte;

  48.     Green: Byte;

  49.     Blue: Byte;

  50.     Alpha: Byte;

  51.   end;

  52. 

  53.   ptsRect = ^tsRect;

  54.   tsRect = packed record

  55.     Left: Integer;

  56.     Top: Integer;

  57.     Right: Integer;

  58.     Bottom: Integer;

  59.   end;

  60. 

  61.   ptsPoint = ^tsPoint;

  62.   tsPoint = packed record

  63.     X: Integer;

  64.     Y: Integer;

  65.   end;

  66. 

  67.   

  68.   

  69. const

  70. {$ifdef TS_EXTERN_STATIC}

  71.   {$ifdef WINDOWS}

  72.     TS_LIBRARY = 'libTextSuite.dll';

  73.   {$else}

  74.     {$ifdef darwin}

  75.     TS_LIBRARY = 'libTextSuite.dylib';

  76.     {$else}

  77.     TS_LIBRARY = 'libTextSuite.so';

  78.     {$endif}

  79.   {$endif}

  80. {$endif}

  81. 

  82.   // Booleans

  83.   TS_TRUE = 1;

  84.   TS_FALSE = 0;

  85. 

  86.   TS_DEFAULT = 0;

  87. 

  88.   // Inits

  89.   TS_INIT_TEXTSUITE = $01;

  90.   TS_INIT_SDL_TTF = $02;

  91.   TS_INIT_SDL_IMAGE = $04;

  92.   TS_INIT_GDI = $08;

  93.   TS_INIT_OPENGL = $10;

  94. //  TS_INIT_FREETYPE2 = $20;

  95. 

  96.   // library infos

  97.   TS_INFO_MAYOR_VERSION = $01;

  98.   TS_INFO_MINOR_VERSION = $02;

  99.   TS_INFO_BUILD_NUMBER = $03;

  100.   TS_INFO_VERSION = $04;

  101.   TS_INFO_COPYRIGHT = $05;

  102. 

  103.   TS_GLOBAL_ANTIALIASING = $11;

  104.   TS_GLOBAL_FORMAT = $12;

  105. 

  106.   // debug infos

  107.   TS_DEBUG_DRAW_CHAR_RECTS = $30;

  108. 

  109.   // context

  110.   TS_CONTEXT_BINDING = $40;

  111. 

  112.   // Renderer

  113.   TS_RENDERER = $50;

  114.   TS_RENDERER_NULL = $51;

  115.   TS_RENDERER_OPENGL = $52;

  116. 

  117.   TS_RENDERER_NULL_SAVE_IMAGES = $60;

  118. 

  119.   TS_RENDERER_OPENGL_TEXTURE_SIZE = $70;

  120.   TS_RENDERER_OPENGL_TEXTURE_SIZE_128 = $71;

  121.   TS_RENDERER_OPENGL_TEXTURE_SIZE_256 = $72;

  122.   TS_RENDERER_OPENGL_TEXTURE_SIZE_512 = $73;

  123.   TS_RENDERER_OPENGL_TEXTURE_SIZE_1024 = $74;

  124. 

  125.   // Font

  126.   TS_FONT_BINDING = $100;

  127.   TS_FONT_COPYRIGHT = $101;

  128.   TS_FONT_FACE_NAME = $102;

  129.   TS_FONT_STYLE_NAME = $103;

  130.   TS_FONT_FULL_NAME = $104;

  131.   TS_FONT_SIZE = $105;

  132.   TS_FONT_STYLE = $106;

  133.   TS_FONT_FILE_STYLE = $107;

  134.   TS_FONT_FIXED_WIDTH = $108;

  135.   TS_FONT_ANTIALIASING = $109;

  136.   TS_FONT_FORMAT = $10A;

  137.   TS_FONT_ASCENT = $10B;

  138.   TS_FONT_DESCENT = $113;

  139.   TS_FONT_EXTERNAL_LEADING = $114;

  140.   TS_FONT_LINESKIP = $10C;

  141.   TS_FONT_CHAR_SPACING = $10D;

  142.   TS_FONT_LINE_SPACING = $10E;

  143.   TS_FONT_UNDERLINE_POSITION = $10F;

  144.   TS_FONT_UNDERLINE_SIZE = $110;

  145.   TS_FONT_STRIKEOUT_POSITION = $111;

  146.   TS_FONT_STRIKEOUT_SIZE = $112;

  147.   TS_FONT_BASELINE_OFFSET = $115;

  148. 

  149.   // Char parameters

  150.   TS_CHAR_ADVANCE = $131;

  151.   TS_CHAR_GLYPHORIGIN = $132;

  152.   TS_CHAR_GLYPHORIGIN_X = $133;

  153.   TS_CHAR_GLYPHORIGIN_Y = $134;

  154.   TS_CHAR_GLYPHRECT = $135;

  155.   TS_CHAR_GLYPHRECT_TOP = $136;

  156.   TS_CHAR_GLYPHRECT_LEFT = $137;

  157.   TS_CHAR_GLYPHRECT_RIGHT = $138;

  158.   TS_CHAR_GLYPHRECT_BOTTOM = $139;

  159. 

  160.   // Creator

  161.   TS_CREATOR = $200;

  162.   TS_CREATOR_SDL = $201;

  163.   TS_CREATOR_GDI = $202;

  164.   TS_CREATOR_GDI_FACENAME = $203;

  165. //  TS_CREATOR_FREETYPE2 = $204;

  166.   TS_CREATOR_GDI_STREAM = $205;

  167. 

  168.   TS_CREATOR_CREATE_CHARS = $210;

  169.   TS_CREATOR_ADD_RESIZING_BORDER = $211;

  170. 

  171.   // Font Style

  172.   TS_STYLE_NORMAL = $00;

  173.   TS_STYLE_BOLD = $01;

  174.   TS_STYLE_ITALIC = $02;

  175.   TS_STYLE_UNDERLINE = $04;

  176.   TS_STYLE_STRIKEOUT = $08;

  177. 

  178.   // AntiAliasing

  179.   TS_ANTIALIASING_NONE = $221;

  180.   TS_ANTIALIASING_NORMAL = $222;

  181. 

  182.   // Formats

  183.   TS_FORMAT_EMPTY = $231;

  184.   TS_FORMAT_RGBA8 = $232;

  185. 

  186.   // PostProcessing usage type

  187.   TS_POST_INDEX_ALL = -2;

  188.   TS_POST_INDEX_LAST = -1;

  189.   TS_POST_USAGE_INCLUDE = $291;

  190.   TS_POST_USAGE_EXCLUDE = $292;

  191. 

  192.   // output consts

  193.   // Single line

  194.   TS_SINGLE_LINE = $300;

  195.   TS_SINGLE_LINE_TOP = $301;

  196.   TS_SINGLE_LINE_BASELINE = $302;

  197. 

  198.   // Textalign

  199.   TS_ALIGN = $310;

  200.   TS_ALIGN_LEFT = $311;

  201.   TS_ALIGN_CENTER = $312;

  202.   TS_ALIGN_RIGHT = $313;

  203.   TS_ALIGN_BLOCK = $314;

  204. 

  205.   TS_VALIGN = $320;

  206.   TS_VALIGN_TOP = $321;

  207.   TS_VALIGN_CENTER = $322;

  208.   TS_VALIGN_BOTTOM = $323;

  209. 

  210.   // Textblockflags

  211.   TS_BLOCK_OFFSET_X = $331;

  212.   TS_BLOCK_OFFSET_Y = $332;

  213. 

  214.   TS_BLOCKFLAG_NONE = $00;

  215.   TS_BLOCKFLAG_NO_CLIP = $01;

  216.   TS_BLOCKFLAG_CALC_SIZE = $02;

  217.   TS_BLOCKFLAG_WORD_WRAP = $04;

  218. //  TS_BF_SINGLE_LINE = $08;

  219. //  TS_BF_END_ELLIPSIS = $10;

  220. 

  221.   TS_CLIP = $340;

  222.   TS_CLIP_COMPLETE = $341;

  223.   TS_CLIP_BORDER = $342;

  224. 

  225. {

  226.   TS_TAB = $350;

  227.   TS_TAB_FIXED = $351;

  228.   TS_TAB_ABSOLUTE = $352;

  229.   TS_TAB_FIXED_WIDTH = $353;

  230.   TS_TAB_ABSOLUTE_POSITIONS = $354;

  231. }

  232. 

  233.   // Code pages

  234.   TS_EMPTY_CP_ENTRY = $1000;

  235.   TS_EMPTY_CP_ENTRY_IGNORE = $1001;

  236.   TS_EMPTY_CP_ENTRY_USE_DEFAULT = $1002;

  237. 

  238.   TS_CODEPAGE = $1100;

  239.   TS_CODEPAGE_UTF8 = TS_CODEPAGE + 1;

  240.   TS_CODEPAGE_8859_1 = TS_CODEPAGE + 11;

  241.   TS_CODEPAGE_8859_2 = TS_CODEPAGE + 12;

  242.   TS_CODEPAGE_8859_3 = TS_CODEPAGE + 13;

  243.   TS_CODEPAGE_8859_4 = TS_CODEPAGE + 14;

  244.   TS_CODEPAGE_8859_5 = TS_CODEPAGE + 15;

  245.   TS_CODEPAGE_8859_6 = TS_CODEPAGE + 16;

  246.   TS_CODEPAGE_8859_7 = TS_CODEPAGE + 17;

  247.   TS_CODEPAGE_8859_8 = TS_CODEPAGE + 18;

  248.   TS_CODEPAGE_8859_9 = TS_CODEPAGE + 19;

  249.   TS_CODEPAGE_8859_10 = TS_CODEPAGE + 20;

  250.   TS_CODEPAGE_8859_11 = TS_CODEPAGE + 21;

  251.   TS_CODEPAGE_8859_13 = TS_CODEPAGE + 22;

  252.   TS_CODEPAGE_8859_14 = TS_CODEPAGE + 23;

  253.   TS_CODEPAGE_8859_15 = TS_CODEPAGE + 24;

  254.   TS_CODEPAGE_8859_16 = TS_CODEPAGE + 25;

  255.   TS_CODEPAGE_037 = TS_CODEPAGE + 31;

  256.   TS_CODEPAGE_437 = TS_CODEPAGE + 32;

  257.   TS_CODEPAGE_500 = TS_CODEPAGE + 33;

  258.   TS_CODEPAGE_737 = TS_CODEPAGE + 34;

  259.   TS_CODEPAGE_775 = TS_CODEPAGE + 35;

  260.   TS_CODEPAGE_850 = TS_CODEPAGE + 36;

  261.   TS_CODEPAGE_852 = TS_CODEPAGE + 37;

  262.   TS_CODEPAGE_855 = TS_CODEPAGE + 38;

  263.   TS_CODEPAGE_857 = TS_CODEPAGE + 39;

  264.   TS_CODEPAGE_860 = TS_CODEPAGE + 40;

  265.   TS_CODEPAGE_861 = TS_CODEPAGE + 41;

  266.   TS_CODEPAGE_862 = TS_CODEPAGE + 42;

  267.   TS_CODEPAGE_863 = TS_CODEPAGE + 43;

  268.   TS_CODEPAGE_864 = TS_CODEPAGE + 44;

  269.   TS_CODEPAGE_865 = TS_CODEPAGE + 45;

  270.   TS_CODEPAGE_866 = TS_CODEPAGE + 46;

  271.   TS_CODEPAGE_869 = TS_CODEPAGE + 47;

  272.   TS_CODEPAGE_874 = TS_CODEPAGE + 48;

  273.   TS_CODEPAGE_875 = TS_CODEPAGE + 49;

  274.   TS_CODEPAGE_1026 = TS_CODEPAGE + 50;

  275.   TS_CODEPAGE_1250 = TS_CODEPAGE + 51;

  276.   TS_CODEPAGE_1251 = TS_CODEPAGE + 52;

  277.   TS_CODEPAGE_1252 = TS_CODEPAGE + 53;

  278.   TS_CODEPAGE_1253 = TS_CODEPAGE + 54;

  279.   TS_CODEPAGE_1254 = TS_CODEPAGE + 55;

  280.   TS_CODEPAGE_1255 = TS_CODEPAGE + 56;

  281.   TS_CODEPAGE_1256 = TS_CODEPAGE + 57;

  282.   TS_CODEPAGE_1257 = TS_CODEPAGE + 58;

  283.   TS_CODEPAGE_1258 = TS_CODEPAGE + 59;

  284. 

  285.   // channel masks

  286.   TS_CHANNEL_RED = $01;

  287.   TS_CHANNEL_GREEN = $02;

  288.   TS_CHANNEL_BLUE = $04;

  289.   TS_CHANNEL_ALPHA = $08;

  290.   TS_CHANNEL_LUMINANCE = $10;

  291. 

  292.   TS_CHANNELS_RGB = TS_CHANNEL_RED or TS_CHANNEL_GREEN or TS_CHANNEL_BLUE;

  293.   TS_CHANNELS_RGBA = TS_CHANNELS_RGB or TS_CHANNEL_ALPHA;

  294.   TS_CHANNELS_LUMINANCE_ALPHA = TS_CHANNEL_LUMINANCE or TS_CHANNEL_ALPHA;

  295. 

  296.   TS_IMAGE_RED_MODE = $401;

  297.   TS_IMAGE_GREEN_MODE = $402;

  298.   TS_IMAGE_BLUE_MODE = $403;

  299.   TS_IMAGE_ALPHA_MODE = $404;

  300.   TS_IMAGE_LUMINANCE_MODE = $405;

  301. 

  302.   TS_MODE_REPLACE = $411;

  303.   TS_MODE_MODULATE = $412;

  304. 

  305.   // Imagelibrary

  306.   TS_IMAGE_LIBRARY = $420;

  307.   TS_IMAGE_LIBRARY_SDL = $421;

  308. 

  309. 

  310.   // Errorcode

  311.   TS_NO_ERROR = $0000;

  312.   TS_ERROR = $8000;

  313.   TS_NO_ACTIVE_CONTEXT = TS_ERROR + $1;

  314.   TS_NO_ACTIVE_RENDERER = TS_ERROR + $2;

  315.   TS_NO_ACTIVE_FONT = TS_ERROR + $3;

  316.   TS_INVALID_OPERATION = TS_ERROR + $4;

  317.   TS_INVALID_ENUM = TS_ERROR + $5;

  318.   TS_INVALID_VALUE = TS_ERROR + $6;

  319.   TS_OUT_OF_MEMORY = TS_ERROR + $7;

  320.   TS_NOT_INITIALIZED = TS_ERROR + $8;

  321. 

  322.   TS_NO_FUNC = $0000;

  323.   TS_FUNC = $4000;

  324.   TS_FUNC_INIT = TS_FUNC + $01;

  325.   TS_FUNC_QUIT = TS_FUNC + $02;

  326.   TS_FUNC_SET_PARAMETER = TS_FUNC + $03;

  327.   TS_FUNC_GET_PARAMETER = TS_FUNC + $04;

  328.   TS_FUNC_GET_STRING = TS_FUNC + $05;

  329.   TS_FUNC_CONTEXT_CREATE = TS_FUNC + $06;

  330.   TS_FUNC_CONTEXT_DESTROY = TS_FUNC + $07;

  331.   TS_FUNC_CONTEXT_BIND = TS_FUNC + $08;

  332.   TS_FUNC_FONT_CREATE_CREATOR = TS_FUNC + $09;

  333.   TS_FUNC_FONT_DESTROY = TS_FUNC + $0A;

  334.   TS_FUNC_FONT_BIND = TS_FUNC + $0B;

  335.   TS_FUNC_FONT_ADD_CHAR = TS_FUNC + $0C;

  336.   TS_FUNC_FONT_DELETE_CHAR = TS_FUNC + $0D;

  337.   TS_FUNC_FONT_SET_CHAR_PARAMETER = TS_FUNC + $0E;

  338.   TS_FUNC_FONT_GET_CHAR_PARAMETER = TS_FUNC + $0F;

  339.   TS_FUNC_POST_ADD_FILL_COLOR = TS_FUNC + $10;

  340.   TS_FUNC_POST_ADD_FILL_PATTERN = TS_FUNC + $11;

  341.   TS_FUNC_POST_ADD_BORDER = TS_FUNC + $12;

  342.   TS_FUNC_POST_ADD_SHADOW = TS_FUNC + $13;

  343.   TS_FUNC_POST_ADD_CUSTOM = TS_FUNC + $14;

  344.   TS_FUNC_POST_DELETE = TS_FUNC + $15;

  345.   TS_FUNC_POST_ADD_USAGE = TS_FUNC + $16;

  346.   TS_FUNC_POST_CLEAR_USAGE = TS_FUNC + $17;

  347.   TS_FUNC_STRING_ANSI_TO_WIDE = TS_FUNC + $18;

  348.   TS_FUNC_STRING_ALLOC = TS_FUNC + $19;

  349.   TS_FUNC_STRING_DISPOSE = TS_FUNC + $1A;

  350.   TS_FUNC_TEXT_BEGIN_BLOCK = TS_FUNC + $1B;

  351.   TS_FUNC_TEXT_END_BLOCK = TS_FUNC + $1C;

  352.   TS_FUNC_TEXT_COLOR = TS_FUNC + $1D;

  353.   TS_FUNC_TEXT_OUT = TS_FUNC + $1E;

  354.   TS_FUNC_TEXT_GET_WIDTH = TS_FUNC + $1F;

  355.   TS_FUNC_TEXT_GET_HEIGHT = TS_FUNC + $20;

  356.   TS_FUNC_IMAGE_CREATE = TS_FUNC + $21;

  357.   TS_FUNC_IMAGE_DESTROY = TS_FUNC + $22;

  358.   TS_FUNC_IMAGE_LOAD = TS_FUNC + $23;

  359.   TS_FUNC_IMAGE_ASSIGN_FROM = TS_FUNC + $24;

  360.   TS_FUNC_IMAGE_NEW = TS_FUNC + $25;

  361.   TS_FUNC_IMAGE_GET_INFO = TS_FUNC + $26;

  362.   TS_FUNC_IMAGE_SCANLINE = TS_FUNC + $27;

  363.   TS_FUNC_IMAGE_RESIZE = TS_FUNC + $28;

  364.   TS_FUNC_IMAGE_BLEND = TS_FUNC + $29;

  365.   TS_FUNC_IMAGE_BLUR = TS_FUNC + $2A;

  366.   TS_FUNC_IMAGE_FILL_COLOR = TS_FUNC + $2B;

  367.   TS_FUNC_IMAGE_FILL_PATTERN = TS_FUNC + $2C;

  368. 

  369. 

  370. 

  371.   // *** global functions ***

  372.   function tsInit(Names: tsEnum): tsBool; cdecl;

  373.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsInit'; {$endif}

  374.   function tsWasInit(Names: tsEnum): tsBool; cdecl;

  375.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsWasInit'; {$endif}

  376.   procedure tsQuit; cdecl;

  377.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsQuit'; {$endif}

  378.   function tsGetError: tsEnum; cdecl;

  379.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetError'; {$endif}

  380.   function tsGetErrorFunction: tsEnum; cdecl;

  381.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetErrorFunction'; {$endif}

  382.   function tsGetErrorStringA(ErrorCode: tsEnum): pAnsiChar; cdecl;

  383.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetErrorStringA'; {$endif}

  384. 

  385.   procedure tsSetParameteri(ParamName: tsEnum; Param: tsInt); cdecl;

  386.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsSetParameteri'; {$endif}

  387.   procedure tsSetParameteriv(ParamName: tsEnum; pParam: ptsInt); cdecl;

  388.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsSetParameteriv'; {$endif}

  389.   function tsGetParameteri(ParamName: tsEnum): tsInt; cdecl;

  390.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetParameteri'; {$endif}

  391.   procedure tsGetParameteriv(ParamName: tsEnum; pParam: ptsInt); cdecl;

  392.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetParameteriv'; {$endif}

  393. 

  394.   function tsGetStringA(ParamName: tsEnum): pAnsiChar; cdecl;

  395.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetStringA'; {$endif}

  396. 

  397.   // *** context functions ***

  398.   procedure tsContextCreate(pContextID: ptsContextID); cdecl;

  399.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsContextCreate'; {$endif}

  400.   procedure tsContextDestroy(ContextID: tsContextID); cdecl;

  401.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsContextDestroy'; {$endif}

  402.   procedure tsContextBind(ContextID: tsContextID); cdecl;

  403.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsContextBind'; {$endif}

  404. 

  405.   // *** font functions ***

  406. //  procedure tsFontCreate(pFontID: ptsFontID); cdecl;

  407. //    {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name ; {$endif}

  408.   procedure tsFontCreateCreatorA(Name: pAnsiChar; Size: tsInt; Style: tsBitmask; AntiAliasing: tsEnum; Format: tsEnum; pFontID: ptsFontID); cdecl;

  409.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontCreateCreatorA'; {$endif}

  410.   procedure tsFontDestroy(FontID: tsFontID); cdecl;

  411.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontDestroy'; {$endif}

  412.   procedure tsFontBind(FontID: tsFontID); cdecl;

  413.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontBind'; {$endif}

  414. 

  415.   procedure tsFontAddCharRange(CharStart: WideChar; CharEnd: WideChar); cdecl;

  416.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontAddCharRange'; {$endif}

  417.   procedure tsFontAddChars(Chars: pWideChar); cdecl;

  418.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontAddChars'; {$endif}

  419.   procedure tsFontAddChar(Char: WideChar); cdecl;

  420.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontAddChar'; {$endif}

  421. 

  422.   procedure tsFontDeleteCharRange(CharStart: WideChar; CharEnd: WideChar); cdecl;

  423.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontDeleteCharRange'; {$endif}

  424.   procedure tsFontDeleteChars(Chars: pWideChar); cdecl;

  425.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontDeleteChars'; {$endif}

  426.   procedure tsFontDeleteChar(Char: WideChar); cdecl;

  427.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontDeleteChar'; {$endif}

  428. 

  429.   procedure tsFontSetCharParameteri(Char: WideChar; ParamName: tsEnum; Param: tsInt); cdecl;

  430.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontSetCharParameteri'; {$endif}

  431.   procedure tsFontSetCharParameteriv(Char: WideChar; ParamName: tsEnum; pParam: ptsInt); cdecl;

  432.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontSetCharParameteri'; {$endif}

  433.   function tsFontGetCharParameteri(Char: WideChar; ParamName: tsEnum): tsInt; cdecl;

  434.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontGetCharParameteri'; {$endif}

  435.   procedure tsFontGetCharParameteriv(Char: WideChar; ParamName: tsEnum; pParam: ptsInt); cdecl;

  436.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontGetCharParameteri'; {$endif}

  437. 

  438.   procedure tsPostAddFillColor3ub(Red, Green, Blue: tsByte; ChannelMask: tsBitmask); cdecl;

  439.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillColor3ub'; {$endif}

  440.   procedure tsPostAddFillColor3f(Red, Green, Blue: tsFloat; ChannelMask: tsBitmask); cdecl;

  441.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillColor3f'; {$endif}

  442.   procedure tsPostAddFillColor4ub(Red, Green, Blue, Alpha: tsByte; ChannelMask: tsBitmask); cdecl;

  443.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillColor4ub'; {$endif}

  444.   procedure tsPostAddFillColor4f(Red, Green, Blue, Alpha: tsFloat; ChannelMask: tsBitmask); cdecl;

  445.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillColor4f'; {$endif}

  446. 

  447.   procedure tsPostAddFillPattern(PatternImageID: tsImageID; X, Y: tsInt; ChannelMask: tsBitmask); cdecl;

  448.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillPattern'; {$endif}

  449. 

  450.   procedure tsPostAddBorder3ub(Width, Strength: tsFloat; Red, Green, Blue: tsByte); cdecl;

  451.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddBorder3ub'; {$endif}

  452.   procedure tsPostAddBorder3f(Width, Strength: tsFloat; Red, Green, Blue: tsFloat); cdecl;

  453.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddBorder3f'; {$endif}

  454.   procedure tsPostAddBorder4ub(Width, Strength: tsFloat; Red, Green, Blue, Alpha: tsByte); cdecl;

  455.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddBorder4ub'; {$endif}

  456.   procedure tsPostAddBorder4f(Width, Strength: tsFloat; Red, Green, Blue, Alpha: tsFloat); cdecl;

  457.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddBorder4f'; {$endif}

  458. 

  459.   procedure tsPostAddShadow3ub(Radius: tsFloat; X, Y: tsInt; Red, Green, Blue: tsByte); cdecl;

  460.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddShadow3ub'; {$endif}

  461.   procedure tsPostAddShadow3f(Radius: tsFloat; X, Y: tsInt; Red, Green, Blue: tsFloat); cdecl;

  462.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddShadow3f'; {$endif}

  463.   procedure tsPostAddShadow4ub(Radius: tsFloat; X, Y: tsInt; Red, Green, Blue, Alpha: tsByte); cdecl;

  464.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddShadow4ub'; {$endif}

  465.   procedure tsPostAddShadow4f(Radius: tsFloat; X, Y: tsInt; Red, Green, Blue, Alpha: tsFloat); cdecl;

  466.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddShadow4f'; {$endif}

  467. 

  468. //  procedure tsPostAddKerning; cdecl;

  469. //    {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddKerning'; {$endif}

  470.   procedure tsPostAddCustom(PostProcessProc: tsPostProcessProc; Data: Pointer); cdecl;

  471.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddCustom'; {$endif}

  472. 

  473.   procedure tsPostDelete(PostIndex: tsInt); cdecl;

  474.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostDelete'; {$endif}

  475. 

  476.   procedure tsPostAddUsageRange(PostIndex: tsInt; UsageType: tsEnum; CharStart, CharEnd: WideChar); cdecl;

  477.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddUsageRange'; {$endif}

  478.   procedure tsPostAddUsageChars(PostIndex: tsInt; UsageType: tsEnum; Chars: pWideChar); cdecl;

  479.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddUsageChars'; {$endif}

  480. 

  481.   procedure tsPostClearUsage(PostIndex: tsInt); cdecl;

  482.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostClearUsage'; {$endif}

  483. 

  484.   // *** string functions ***

  485.   function tsStringAnsiToWide(pText: pAnsiChar): pWideChar; cdecl;

  486.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsStringAnsiToWide'; {$endif}

  487.   function tsStringAlloc(Size: tsInt): pWideChar; cdecl;

  488.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsStringAlloc'; {$endif}

  489.   procedure tsStringDispose(pText: pWideChar); cdecl;

  490.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsStringDispose'; {$endif}

  491. 

  492.   // *** drawing functions ***

  493.   procedure tsTextBeginBlock(Left, Top, Width, Height: tsInt; Flags: tsBitmask); cdecl;

  494.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextBeginBlock'; {$endif}

  495.   procedure tsTextEndBlock; cdecl;

  496.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextEndBlock'; {$endif}

  497. 

  498.   procedure tsTextColor3ub(Red, Green, Blue: tsByte); cdecl;

  499.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextColor3ub'; {$endif}

  500.   procedure tsTextColor3f(Red, Green, Blue: tsFloat); cdecl;

  501.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextColor3f'; {$endif}

  502.   procedure tsTextColor4ub(Red, Green, Blue, Alpha: tsByte); cdecl;

  503.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextColor4ub'; {$endif}

  504.   procedure tsTextColor4f(Red, Green, Blue, Alpha: tsFloat); cdecl;

  505.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextColor4f'; {$endif}

  506. 

  507.   procedure tsTextOutA(pText: pAnsiChar); cdecl;

  508.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextOutA'; {$endif}

  509.   procedure tsTextOutW(pText: pWideChar); cdecl;

  510.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextOutW'; {$endif}

  511.   function tsTextGetWidthA(pText: pAnsiChar): tsInt; cdecl;

  512.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextGetWidthA'; {$endif}

  513.   function tsTextGetWidthW(pText: pWideChar): tsInt; cdecl;

  514.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextGetWidthW'; {$endif}

  515.   function tsTextGetHeightA(pText: pAnsiChar): tsInt; cdecl;

  516.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextGetHeightA'; {$endif}

  517.   function tsTextGetHeightW(pText: pWideChar): tsInt; cdecl;

  518.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextGetHeightW'; {$endif}

  519. 

  520.   procedure tsCharOutW(CharCode: WideChar); cdecl;

  521.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsCharOutW'; {$endif}

  522. 

  523.   // *** Image functions ***

  524.   procedure tsImageCreate(pImageID: ptsImageID); cdecl;

  525.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageCreate'; {$endif}

  526.   procedure tsImageDestroy(ImageID: tsImageID); cdecl; 

  527.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageDestroy'; {$endif}

  528.   procedure tsImageLoadA(ImageID: tsImageID; Filename: pAnsiChar); cdecl;

  529.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageLoadA'; {$endif}

  530.   procedure tsImageAssignFrom(ImageID: tsImageID; FromImageID: tsImageID); cdecl;

  531.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageAssignFrom'; {$endif}

  532.   procedure tsImageNew(ImageID: tsImageID; Width: tsInt; Height: tsInt; Format: tsEnum); cdecl;

  533.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageNew'; {$endif}

  534. 

  535.   procedure tsImageGetInfo(ImageID: tsImageID; pisEmpty: ptsBool; pWidth: ptsInt; pHeight: ptsInt; pFormat: ptsEnum; pData: PPointer); cdecl;

  536.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetInfo'; {$endif}

  537.   function tsImageGetIsEmpty(ImageID: tsImageID): tsBool; cdecl;

  538.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetIsEmpty'; {$endif}

  539.   function tsImageGetWidth(ImageID: tsImageID): tsInt; cdecl;

  540.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetWidth'; {$endif}

  541.   function tsImageGetHeight(ImageID: tsImageID): tsInt; cdecl;

  542.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetHeight'; {$endif}

  543.   function tsImageGetFormat(ImageID: tsImageID): tsEnum; cdecl;

  544.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetFormat'; {$endif}

  545.   function tsImageGetData(ImageID: tsImageID): Pointer; cdecl;

  546.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetData'; {$endif}

  547.   function tsImageScanline(ImageID: tsImageID; Scanline: tsInt): Pointer; cdecl; 

  548.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageScanline'; {$endif}

  549. 

  550.   procedure tsImageResize(ImageID: tsImageID; Width, Height, X, Y: tsInt); cdecl;

  551.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageResize'; {$endif}

  552.   procedure tsImageBlend(ImageID, OverImageID: tsImageID; X, Y: tsInt; AutoExpand: tsBool); cdecl; 

  553.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageBlend'; {$endif}

  554.   procedure tsImageBlur(ImageID: tsImageID; X, Y: tsFloat; ChannelMask: tsBitmask; AutoExpand: tsBool; ExpandSizeX, ExpandSizeY: ptsInt); cdecl;

  555.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageBlur'; {$endif}

  556. 

  557.   procedure tsImageFillColor3ub(ImageID: tsImageID; Red, Green, Blue: tsByte; ChannelMask: tsBitmask); cdecl;

  558.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillColor3ub'; {$endif}

  559.   procedure tsImageFillColor3f(ImageID: tsImageID; Red, Green, Blue: tsFloat; ChannelMask: tsBitmask); cdecl;

  560.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillColor3f'; {$endif}

  561.   procedure tsImageFillColor4ub(ImageID: tsImageID; Red, Green, Blue, Alpha: tsByte; ChannelMask: tsBitmask); cdecl;

  562.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillColor4ub'; {$endif}

  563.   procedure tsImageFillColor4f(ImageID: tsImageID; Red, Green, Blue, Alpha: tsFloat; ChannelMask: tsBitmask); cdecl;

  564.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillColor4f'; {$endif}

  565. 

  566.   procedure tsImageFillPattern(ImageID, PatternImageID: tsImageID; X, Y: tsInt; ChannelMask: tsBitmask); cdecl;

  567.     {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillPattern'; {$endif}

  568. 

  569. 

  570. 

  571. implementation

  572. 

  573. { This define ignores implementations of all functions }

  574. {$ifndef TS_EXTERN_STATIC}

  575. 

  576. uses

  577.   Classes,

  578.   SysUtils,

  579.   SyncObjs,

  580.   TextSuiteClasses,

  581.   TextSuitePostProcess,

  582.   TextSuiteImports,

  583.   {$ifndef TS_PURE_PASCAL}

  584.   TextSuiteCPUUtils,

  585.   {$endif}

  586.   TextSuiteVersion,

  587.   TextSuiteWideUtils;

  588. 

  589. 

  590. // string consts

  591. const

  592.   TS_COPYRIGHT_STR = 'TextSuite (c) 2007-2009 by Steffen Xonna';

  593. 

  594. 

  595. // error consts

  596. const

  597.   TS_NO_ERROR_STR = 'no error';

  598.   TS_ERROR_STR = 'unknown error';

  599.   TS_NO_ACTIVE_CONTEXT_STR = 'no active context';

  600.   TS_NO_ACTIVE_RENDERER_STR = 'no active renderer';

  601.   TS_NO_ACTIVE_FONT_STR = 'no active font';

  602.   TS_INVALID_OPERATION_STR = 'invalid operation';

  603.   TS_INVALID_ENUM_STR = 'invalid enum';

  604.   TS_INVALID_VALUE_STR = 'invalid value';

  605.   TS_OUT_OF_MEMORY_STR = 'out of memory';

  606.   TS_NOT_INITIALIZED_STR = 'not initialized';

  607. 

  608. 

  609. // global variables

  610. var

  611.   TextSuite_initialized: Boolean;

  612.   TextSuite_initialized_count: Integer; 

  613. 

  614.   gCriticalSection: TCriticalSection;

  615.   gContexts: TtsHash;

  616.   gStrings: TtsStringHash;

  617. 

  618. 

  619.   

  620. // globals for the threads

  621. threadvar

  622.   gError: tsEnum;

  623.   gErrorFunction: tsEnum;

  624. 

  625.   gContext: TtsContext;

  626. 

  627. 

  628. 

  629. procedure SetError(Error, ErrorFunction: tsEnum);

  630. begin

  631.   gError := Error;

  632.   gErrorFunction := ErrorFunction;

  633. end;

  634. 

  635.   

  636. procedure ClearContexts;

  637. var

  638.   List: TList;

  639.   Context: TtsContext;

  640.   Idx: Integer;

  641. begin

  642.   List := TList.Create;

  643.   try

  644.     gContexts.GetValues(List);

  645.     gContexts.Clear;

  646.     gContext := nil;

  647. 

  648.     for Idx := 0 to List.Count - 1 do begin

  649.       Context := List[Idx];

  650. 

  651.       Context.Free;

  652.     end;

  653.   finally

  654.     List.Free;

  655.   end;

  656. end;

  657. 

  658. 

  659. function Init_TextSuite: boolean;

  660. begin

  661.   if (TextSuite_initialized_count = 0) or (not TextSuite_initialized) then begin

  662.     {$ifndef TS_PURE_PASCAL}

  663.     ReadCPUFlags;

  664. 

  665.     if supportFPU and supportCMOV and supportMMX then begin

  666.     {$endif}

  667.       // global section

  668.       if gCriticalSection = nil then

  669.         gCriticalSection := TCriticalSection.Create;

  670. 

  671.       // Context management

  672.       if gContexts = nil then

  673.         gContexts := TtsHash.Create(113);

  674. 

  675.       // string management

  676.       if gStrings = nil then

  677.         gStrings := TtsStringHash.Create(4219);

  678. 

  679.       TextSuite_initialized :=

  680.         (gCriticalSection <> nil) and

  681.         (gContexts <> nil) and

  682.         (gStrings <> nil);

  683.     {$ifndef TS_PURE_PASCAL}

  684.     end;

  685.     {$endif}

  686.   end;

  687. 

  688.   Inc(TextSuite_initialized_count);

  689. 

  690.   Result := TextSuite_initialized;

  691. end;

  692. 

  693. 

  694. procedure Quit_TextSuite;

  695. begin

  696.   Dec(TextSuite_initialized_count);

  697. 

  698.   if TextSuite_initialized_count = 0 then begin

  699.     // destroy all contexts

  700.     ClearContexts;

  701. 

  702.     // destroy hash

  703.     gStrings.Free;

  704.     gStrings := nil;

  705. 

  706.     gContexts.Free;

  707.     gContexts := nil;

  708. 

  709.     gCriticalSection.Free;

  710.     gCriticalSection := nil;

  711. 

  712.     gContext := nil;

  713. 

  714.     TextSuite_initialized := False;

  715.   end;

  716. end;

  717. 

  718. 

  719. 

  720. // *** global functions

  721. function tsInit(Names: tsEnum): tsBool;

  722. var

  723.   ResNames: tsEnum;

  724. begin

  725.   Result := TS_FALSE;

  726.   try

  727.     ResNames := 0;

  728. 

  729.     if (Names and TS_INIT_TEXTSUITE) > 0 then

  730.       if Init_TextSuite then

  731.         ResNames := ResNames or TS_INIT_TEXTSUITE;

  732. 

  733.     if (Names and TS_INIT_SDL_TTF) > 0 then

  734.       if Init_SDL_TTF then

  735.         ResNames := ResNames or TS_INIT_SDL_TTF;

  736. 

  737.     if (Names and TS_INIT_SDL_IMAGE) > 0 then

  738.       if Init_SDL_IMAGE then

  739.         ResNames := ResNames or TS_INIT_SDL_IMAGE;

  740. 

  741.     if (Names and TS_INIT_GDI) > 0 then

  742.       if Init_GDI then

  743.         ResNames := ResNames or TS_INIT_GDI;

  744. 

  745.     if (Names and TS_INIT_OPENGL) > 0 then

  746.       if Init_OpenGL then

  747.         ResNames := ResNames or TS_INIT_OPENGL;

  748. 

  749.     if ResNames = Names then

  750.       Result := TS_TRUE;

  751. 

  752.     if Result = TS_FALSE then

  753.       SetError(TS_NOT_INITIALIZED, TS_FUNC_INIT);

  754.   except

  755.     SetError(TS_ERROR, TS_FUNC_INIT);

  756.   end;

  757. end;

  758. 

  759. 

  760. function tsWasInit(Names: tsEnum): tsBool;

  761. var

  762.   ResNames: tsEnum;

  763. begin

  764.   ResNames := 0;

  765. 

  766.   if (Names and TS_INIT_TEXTSUITE) > 0 then

  767.     if TextSuite_initialized then

  768.       ResNames := ResNames or TS_INIT_TEXTSUITE;

  769. 

  770.   if (Names and TS_INIT_SDL_TTF) > 0 then

  771.     if SDL_TTF_initialized then

  772.       ResNames := ResNames or TS_INIT_SDL_TTF;

  773. 

  774.   if (Names and TS_INIT_SDL_IMAGE) > 0 then

  775.     if SDL_IMAGE_initialized then

  776.       ResNames := ResNames or TS_INIT_SDL_IMAGE;

  777. 

  778.   if (Names and TS_INIT_GDI) > 0 then

  779.     if GDI_initialized then

  780.       ResNames := ResNames or TS_INIT_GDI;

  781. 

  782.   if (Names and TS_INIT_OPENGL) > 0 then

  783.     if OpenGL_initialized then

  784.       ResNames := ResNames or TS_INIT_OPENGL;

  785. 

  786.   if ResNames = Names then

  787.     Result := TS_TRUE

  788.   else

  789.     Result := TS_FALSE;

  790. end;

  791. 

  792. 

  793. procedure tsQuit;

  794. begin

  795.   try

  796.     // maybe quit library if count is zero 

  797.     if TextSuite_initialized then

  798.       Quit_TextSuite;

  799. 

  800.     // if count is zero then quit all other systems

  801.     if TextSuite_initialized_count = 0 then begin

  802.       if SDL_TTF_initialized then

  803.         Quit_SDL_TTF;

  804. 

  805.       if SDL_IMAGE_initialized then

  806.         Quit_SDL_IMAGE;

  807. 

  808.       if GDI_initialized then

  809.         Quit_GDI;

  810. 

  811.       if OpenGL_initialized then

  812.         Quit_OpenGL;

  813. 

  814.       Quit_SDL;

  815.     end;

  816.   except

  817.     SetError(TS_ERROR, TS_FUNC_QUIT);

  818.   end;

  819. end;

  820. 

  821. 

  822. function tsGetError: tsEnum;

  823. begin

  824.   Result := gError;

  825. 

  826.   gError := TS_NO_ERROR;

  827. end;

  828. 

  829. 

  830. function tsGetErrorFunction: tsEnum;

  831. begin

  832.   Result := gErrorFunction;

  833. 

  834.   gErrorFunction := TS_NO_FUNC;

  835. end;

  836. 

  837. 

  838. function tsGetErrorStringA(ErrorCode: tsEnum): pAnsiChar;

  839. begin

  840.   case ErrorCode of

  841.     TS_NO_ERROR:

  842.       Result := pAnsiChar(TS_NO_ERROR_STR);

  843.     TS_ERROR:

  844.       Result := pAnsiChar(TS_ERROR_STR);

  845.     TS_NO_ACTIVE_CONTEXT:

  846.       Result := pAnsiChar(TS_NO_ACTIVE_CONTEXT_STR);

  847.     TS_NO_ACTIVE_RENDERER:

  848.       Result := pAnsiChar(TS_NO_ACTIVE_RENDERER_STR);

  849.     TS_NO_ACTIVE_FONT:

  850.       Result := pAnsiChar(TS_NO_ACTIVE_FONT_STR);

  851.     TS_INVALID_OPERATION:

  852.       Result := pAnsiChar(TS_INVALID_OPERATION_STR);

  853.     TS_INVALID_ENUM:

  854.       Result := pAnsiChar(TS_INVALID_ENUM_STR);

  855.     TS_INVALID_VALUE:

  856.       Result := pAnsiChar(TS_INVALID_VALUE_STR);

  857.     TS_OUT_OF_MEMORY:

  858.       Result := pAnsiChar(TS_OUT_OF_MEMORY_STR);

  859.     TS_NOT_INITIALIZED:

  860.       Result := pAnsiChar(TS_NOT_INITIALIZED_STR);

  861.   else

  862.     if ErrorCode and TS_ERROR = TS_ERROR then

  863.       Result := pAnsiChar(TS_ERROR_STR)

  864.     else

  865.       Result := pAnsiChar(TS_NO_ERROR);

  866.   end;

  867. end;

  868. 

  869. 

  870. procedure SetCodePage(CodePage: tsEnum; CodePageFunc: TtsAnsiToWideCharFunc; pCodePage: Pointer);

  871. var

  872.   Context: TtsContext;

  873. begin

  874.   Context := gContext;

  875. 

  876.   Context.gCodePage     := CodePage;

  877.   Context.gCodePageFunc := CodePageFunc;

  878.   Context.gCodePagePtr  := pCodePage;

  879. end;

  880. 

  881. 

  882. procedure tsSetParameteri(ParamName: tsEnum; Param: tsInt);

  883. begin

  884.   tsSetParameteriv(ParamName, @Param);

  885. end;

  886. 

  887. 

  888. procedure tsSetParameteriv(ParamName: tsEnum; pParam: ptsInt);

  889. var

  890.   Context: TtsContext;

  891. begin

  892.   Context := gContext;

  893. 

  894.   if Context <> nil then begin

  895.     if pParam <> nil then begin

  896.       case ParamName of

  897.         // font

  898.         TS_FONT_ASCENT:

  899.           if not Context.IsLocked then begin

  900.             if Context.ActiveFont <> nil then begin

  901.               Context.ActiveFont.Ascent := pParam^;

  902.             end else

  903.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  904.           end else

  905.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  906. 

  907.         TS_FONT_DESCENT:

  908.           if not Context.IsLocked then begin

  909.             if Context.ActiveFont <> nil then begin

  910.               Context.ActiveFont.Descent := pParam^;

  911.             end else

  912.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  913.           end else

  914.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  915. 

  916.         TS_FONT_EXTERNAL_LEADING:

  917.           if not Context.IsLocked then begin

  918.             if Context.ActiveFont <> nil then begin

  919.               Context.ActiveFont.ExternalLeading := pParam^;

  920.             end else

  921.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  922.           end else

  923.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  924. 

  925.         TS_FONT_BASELINE_OFFSET:

  926.           if not Context.IsLocked then begin

  927.             if Context.ActiveFont <> nil then begin

  928.               Context.ActiveFont.BaselineOffset := pParam^;

  929.             end else

  930.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  931.           end else

  932.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  933. 

  934.         TS_FONT_CHAR_SPACING:

  935.           if not Context.IsLocked then begin

  936.             if Context.ActiveFont <> nil then begin

  937.               Context.ActiveFont.CharSpacing := pParam^;

  938.             end else

  939.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  940.           end else

  941.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  942. 

  943.         TS_FONT_LINE_SPACING:

  944.           if not Context.IsLocked then begin

  945.             if Context.ActiveFont <> nil then begin

  946.               Context.ActiveFont.LineSpacing := pParam^;

  947.             end else

  948.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  949.           end else

  950.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  951. 

  952.         TS_FONT_UNDERLINE_POSITION:

  953.           if not Context.IsLocked then begin

  954.             if Context.ActiveFont <> nil then begin

  955.               Context.ActiveFont.UnderlinePosition := pParam^;

  956.             end else

  957.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  958.           end else

  959.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  960. 

  961.         TS_FONT_UNDERLINE_SIZE:

  962.           if not Context.IsLocked then begin

  963.             if Context.ActiveFont <> nil then begin

  964.               Context.ActiveFont.UnderlineSize := pParam^;

  965.             end else

  966.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  967.           end else

  968.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  969. 

  970.         TS_FONT_STRIKEOUT_POSITION:

  971.           if not Context.IsLocked then begin

  972.             if Context.ActiveFont <> nil then begin

  973.               Context.ActiveFont.StrikeoutPosition := pParam^;

  974.             end else

  975.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  976.           end else

  977.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  978. 

  979.         TS_FONT_STRIKEOUT_SIZE:

  980.           if not Context.IsLocked then begin

  981.             if Context.ActiveFont <> nil then begin

  982.               Context.ActiveFont.StrikeoutSize := pParam^;

  983.             end else

  984.               SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  985.           end else

  986.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  987. 

  988.         // globals

  989.         TS_GLOBAL_ANTIALIASING:

  990.           case pParam^ of

  991.             TS_ANTIALIASING_NONE:

  992.               Context.gGlobalAntiAliasing := TS_ANTIALIASING_NONE;

  993.             TS_ANTIALIASING_NORMAL:

  994.               Context.gGlobalAntiAliasing := TS_ANTIALIASING_NORMAL;

  995.           else

  996.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  997.           end;

  998. 

  999.         TS_GLOBAL_FORMAT:

  1000.           case pParam^ of

  1001.             TS_FORMAT_RGBA8:

  1002.               Context.gGlobalFormat := TS_FORMAT_RGBA8;

  1003.           else

  1004.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1005.           end;

  1006. 

  1007.         // creator

  1008.         TS_CREATOR:

  1009.           case pParam^ of

  1010.             TS_CREATOR_SDL:

  1011.               Context.gCreator := TS_CREATOR_SDL;

  1012.             TS_CREATOR_GDI:

  1013.               Context.gCreator := TS_CREATOR_GDI;

  1014.             TS_CREATOR_GDI_FACENAME:

  1015.               Context.gCreator := TS_CREATOR_GDI_FACENAME;

  1016.             TS_CREATOR_GDI_STREAM:

  1017.               Context.gCreator := TS_CREATOR_GDI_STREAM;

  1018.           else

  1019.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1020.           end;

  1021. 

  1022.         TS_CREATOR_CREATE_CHARS:

  1023.           if Context.ActiveFont <> nil then begin

  1024.             if Context.ActiveFont is TtsFontCreator then begin

  1025.               case pParam^ of

  1026.                 TS_TRUE:

  1027.                   TtsFontCreator(Context.ActiveFont).CreateChars := True;

  1028.                 TS_FALSE:

  1029.                   TtsFontCreator(Context.ActiveFont).CreateChars := False;

  1030.               else

  1031.                 SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1032.               end;

  1033.             end else

  1034.               SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1035.           end else

  1036.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  1037. 

  1038.         TS_CREATOR_ADD_RESIZING_BORDER:

  1039.           if Context.ActiveFont <> nil then begin

  1040.             if Context.ActiveFont is TtsFontCreator then begin

  1041.               case pParam^ of

  1042.                 TS_TRUE:

  1043.                   TtsFontCreator(Context.ActiveFont).AddResizingBorder := True;

  1044.                 TS_FALSE:

  1045.                   TtsFontCreator(Context.ActiveFont).AddResizingBorder := False;

  1046.               else

  1047.                 SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1048.               end;

  1049.             end else

  1050.               SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1051.           end else

  1052.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);

  1053. 

  1054.         // renderer

  1055.         TS_RENDERER:

  1056.           if not Context.IsLocked then begin

  1057.             if tsGetParameteri(TS_RENDERER) <> pParam^ then begin

  1058.               if (Context.FontCount = 0) and (Context.ImageCount = 0) then begin

  1059.                 case pParam^ of

  1060.                   TS_RENDERER_NULL:

  1061.                     begin

  1062.                       if Context.Renderer <> nil then

  1063.                         Context.Renderer.Free;

  1064. 

  1065.                       Context.Renderer := TtsRendererNULL.Create(Context);

  1066.                     end;

  1067.                   TS_RENDERER_OPENGL:

  1068.                     begin

  1069.                       if OpenGL_initialized then begin

  1070.                         if Context.Renderer <> nil then

  1071.                           Context.Renderer.Free;

  1072. 

  1073.                         Context.Renderer := TtsRendererOpenGL.Create(Context);

  1074.                       end else

  1075.                         SetError(TS_NOT_INITIALIZED, TS_FUNC_SET_PARAMETER);

  1076.                     end

  1077.                 else

  1078.                   SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1079.                 end;

  1080.               end else

  1081.                 // Renderer only can set if no Images/Fonts exist

  1082.                 SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1083.             end;

  1084.           end else

  1085.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1086. 

  1087.         // opengl texture size

  1088.         TS_RENDERER_OPENGL_TEXTURE_SIZE:

  1089.           if Context.Renderer <> nil then begin

  1090.             if Context.Renderer is TtsRendererOpenGL then begin

  1091.               case pParam^ of

  1092.                 TS_RENDERER_OPENGL_TEXTURE_SIZE_128:

  1093.                   TtsRendererOpenGL(Context.Renderer).TextureSize := 128;

  1094. 

  1095.                 TS_RENDERER_OPENGL_TEXTURE_SIZE_256:

  1096.                   TtsRendererOpenGL(Context.Renderer).TextureSize := 256;

  1097. 

  1098.                 TS_RENDERER_OPENGL_TEXTURE_SIZE_512:

  1099.                   TtsRendererOpenGL(Context.Renderer).TextureSize := 512;

  1100. 

  1101.                 TS_RENDERER_OPENGL_TEXTURE_SIZE_1024:

  1102.                   TtsRendererOpenGL(Context.Renderer).TextureSize := 1024;

  1103.               else

  1104.                 SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1105.               end;

  1106.             end else

  1107.               SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1108.           end else

  1109.             SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_SET_PARAMETER);

  1110. 

  1111.         // null renderer saves char images

  1112.         TS_RENDERER_NULL_SAVE_IMAGES:

  1113.           if Context.Renderer <> nil then begin

  1114.             if Context.Renderer is TtsRendererNULL then begin

  1115.               case pParam^ of

  1116.                 TS_FALSE:

  1117.                   Context.Renderer.SaveImages := False;

  1118. 

  1119.                 TS_TRUE:

  1120.                   Context.Renderer.SaveImages := True;

  1121.               else

  1122.                 SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1123.               end;

  1124.             end else

  1125.               SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1126.           end else

  1127.             SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_SET_PARAMETER);

  1128. 

  1129.         // Align

  1130.         TS_ALIGN:

  1131.           if not Context.IsLocked then begin

  1132.             case pParam^ of

  1133.               TS_ALIGN_LEFT:

  1134.                 Context.gAlign := TS_ALIGN_LEFT;

  1135.               TS_ALIGN_CENTER:

  1136.                 Context.gAlign := TS_ALIGN_CENTER;

  1137.               TS_ALIGN_RIGHT:

  1138.                 Context.gAlign := TS_ALIGN_RIGHT;

  1139.               TS_ALIGN_BLOCK:

  1140.                 Context.gAlign := TS_ALIGN_BLOCK;

  1141.             else

  1142.               SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1143.             end;

  1144.           end else

  1145.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1146. 

  1147.         // Vertical Align

  1148.         TS_VALIGN:

  1149.           if not Context.IsLocked then begin

  1150.             case pParam^ of

  1151.               TS_VALIGN_TOP:

  1152.                 Context.gVAlign := TS_VALIGN_TOP;

  1153.               TS_VALIGN_CENTER:

  1154.                 Context.gVAlign := TS_VALIGN_CENTER;

  1155.               TS_VALIGN_BOTTOM:

  1156.                 Context.gVAlign := TS_VALIGN_BOTTOM;

  1157.             else

  1158.               SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1159.             end;

  1160.           end else

  1161.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1162. 

  1163.         // Clipping

  1164.         TS_CLIP:

  1165.           if not Context.IsLocked then begin

  1166.             case pParam^ of

  1167.               TS_CLIP_COMPLETE:

  1168.                 Context.gClip := TS_CLIP_COMPLETE;

  1169.               TS_CLIP_BORDER:

  1170.                 Context.gClip := TS_CLIP_BORDER;

  1171.             else

  1172.               SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1173.             end;

  1174.           end else

  1175.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1176. 

  1177.         // block offset

  1178.         TS_BLOCK_OFFSET_X:

  1179.           if not Context.IsLocked then begin

  1180.             Context.gBlockOffsetX := pParam^;

  1181.           end else

  1182.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1183. 

  1184.         TS_BLOCK_OFFSET_Y:

  1185.           if not Context.IsLocked then begin

  1186.             Context.gBlockOffsetY := pParam^;

  1187.           end else

  1188.             SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);

  1189. 

  1190.         // single line

  1191.         TS_SINGLE_LINE:

  1192.           case pParam^ of

  1193.             TS_SINGLE_LINE_TOP:

  1194.               Context.gSingleLine := TS_SINGLE_LINE_TOP;

  1195.             TS_SINGLE_LINE_BASELINE:

  1196.               Context.gSingleLine := TS_SINGLE_LINE_BASELINE;

  1197.           else

  1198.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1199.           end;

  1200. 

  1201.   {

  1202.         TS_TAB:

  1203.           case pParam^ of

  1204.             TS_TAB_FIXED:

  1205.               gTab := TS_TAB_FIXED;

  1206.             TS_TAB_ABSOLUTE:

  1207.               gTab := TS_TAB_ABSOLUTE;

  1208.           else

  1209.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1210.           end;

  1211. 

  1212.         TS_TAB_FIXED_WIDTH:

  1213.           gTabWidth := pParam^;

  1214.   }

  1215.         // image modes

  1216.         TS_IMAGE_RED_MODE:

  1217.           case pParam^ of

  1218.             TS_MODE_REPLACE:

  1219.               Context.gImageMode[tsModeRed] := TS_MODE_REPLACE;

  1220.             TS_MODE_MODULATE:

  1221.               Context.gImageMode[tsModeRed] := TS_MODE_MODULATE;

  1222.           else

  1223.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1224.           end;

  1225. 

  1226.         TS_IMAGE_GREEN_MODE:

  1227.           case pParam^ of

  1228.             TS_MODE_REPLACE:

  1229.               Context.gImageMode[tsModeGreen] := TS_MODE_REPLACE;

  1230.             TS_MODE_MODULATE:

  1231.               Context.gImageMode[tsModeGreen] := TS_MODE_MODULATE;

  1232.           else

  1233.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1234.           end;

  1235. 

  1236.         TS_IMAGE_BLUE_MODE:

  1237.           case pParam^ of

  1238.             TS_MODE_REPLACE:

  1239.               Context.gImageMode[tsModeBlue] := TS_MODE_REPLACE;

  1240.             TS_MODE_MODULATE:

  1241.               Context.gImageMode[tsModeBlue] := TS_MODE_MODULATE;

  1242.           else

  1243.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1244.           end;

  1245. 

  1246.         TS_IMAGE_ALPHA_MODE:

  1247.           case pParam^ of

  1248.             TS_MODE_REPLACE:

  1249.               Context.gImageMode[tsModeAlpha] := TS_MODE_REPLACE;

  1250.             TS_MODE_MODULATE:

  1251.               Context.gImageMode[tsModeAlpha] := TS_MODE_MODULATE;

  1252.           else

  1253.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1254.           end;

  1255. 

  1256.         TS_IMAGE_LUMINANCE_MODE:

  1257.           case pParam^ of

  1258.             TS_MODE_REPLACE:

  1259.               Context.gImageMode[tsModeLuminance] := TS_MODE_REPLACE;

  1260.             TS_MODE_MODULATE:

  1261.               Context.gImageMode[tsModeLuminance] := TS_MODE_MODULATE;

  1262.           else

  1263.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1264.           end;

  1265. 

  1266.         TS_IMAGE_LIBRARY:

  1267.           case pParam^ of

  1268.             TS_IMAGE_LIBRARY_SDL:

  1269.               Context.gImageLibrary := TS_IMAGE_LIBRARY_SDL;

  1270.           else

  1271.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1272.           end;

  1273. 

  1274.         // code pages

  1275.         TS_EMPTY_CP_ENTRY:

  1276.           case pParam^ of

  1277.             TS_EMPTY_CP_ENTRY_IGNORE:

  1278.               Context.gEmptyCodePageEntry := TS_EMPTY_CP_ENTRY_IGNORE;

  1279.             TS_EMPTY_CP_ENTRY_USE_DEFAULT:

  1280.               Context.gEmptyCodePageEntry := TS_EMPTY_CP_ENTRY_USE_DEFAULT;

  1281.           else

  1282.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1283.           end;

  1284. 

  1285.         TS_CODEPAGE:

  1286.           case pParam^ of

  1287.             TS_CODEPAGE_UTF8:

  1288.               SetCodePage(TS_CODEPAGE_UTF8, nil, nil);

  1289.             TS_CODEPAGE_8859_1:

  1290.               SetCodePage(TS_CODEPAGE_8859_1, nil, nil);

  1291.             TS_CODEPAGE_8859_2:

  1292.               SetCodePage(TS_CODEPAGE_8859_2, tsAnsiSBCDToWide, @CP_8859_2);

  1293.             TS_CODEPAGE_8859_3:

  1294.               SetCodePage(TS_CODEPAGE_8859_3, tsAnsiSBCDToWide, @CP_8859_3);

  1295.             TS_CODEPAGE_8859_4:

  1296.               SetCodePage(TS_CODEPAGE_8859_4, tsAnsiSBCDToWide, @CP_8859_4);

  1297.             TS_CODEPAGE_8859_5:

  1298.               SetCodePage(TS_CODEPAGE_8859_5, tsAnsiSBCDToWide, @CP_8859_5);

  1299.             TS_CODEPAGE_8859_6:

  1300.               SetCodePage(TS_CODEPAGE_8859_6, tsAnsiSBCDToWide, @CP_8859_6);

  1301.             TS_CODEPAGE_8859_7:

  1302.               SetCodePage(TS_CODEPAGE_8859_7, tsAnsiSBCDToWide, @CP_8859_7);

  1303.             TS_CODEPAGE_8859_8:

  1304.               SetCodePage(TS_CODEPAGE_8859_8, tsAnsiSBCDToWide, @CP_8859_8);

  1305.             TS_CODEPAGE_8859_9:

  1306.               SetCodePage(TS_CODEPAGE_8859_9, tsAnsiSBCDToWide, @CP_8859_9);

  1307.             TS_CODEPAGE_8859_10:

  1308.               SetCodePage(TS_CODEPAGE_8859_10, tsAnsiSBCDToWide, @CP_8859_10);

  1309.             TS_CODEPAGE_8859_11:

  1310.               SetCodePage(TS_CODEPAGE_8859_11, tsAnsiSBCDToWide, @CP_8859_11);

  1311.             TS_CODEPAGE_8859_13:

  1312.               SetCodePage(TS_CODEPAGE_8859_13, tsAnsiSBCDToWide, @CP_8859_13);

  1313.             TS_CODEPAGE_8859_14:

  1314.               SetCodePage(TS_CODEPAGE_8859_14, tsAnsiSBCDToWide, @CP_8859_14);

  1315.             TS_CODEPAGE_8859_15:

  1316.               SetCodePage(TS_CODEPAGE_8859_15, tsAnsiSBCDToWide, @CP_8859_15);

  1317.             TS_CODEPAGE_8859_16:

  1318.               SetCodePage(TS_CODEPAGE_8859_16, tsAnsiSBCDToWide, @CP_8859_16);

  1319.             TS_CODEPAGE_037:

  1320.               SetCodePage(TS_CODEPAGE_037, tsAnsiSBCDToWide, @CP_037);

  1321.             TS_CODEPAGE_437:

  1322.               SetCodePage(TS_CODEPAGE_437, tsAnsiSBCDToWide, @CP_437);

  1323.             TS_CODEPAGE_500:

  1324.               SetCodePage(TS_CODEPAGE_500, tsAnsiSBCDToWide, @CP_500);

  1325.             TS_CODEPAGE_737:

  1326.               SetCodePage(TS_CODEPAGE_737, tsAnsiSBCDToWide, @CP_737);

  1327.             TS_CODEPAGE_775:

  1328.               SetCodePage(TS_CODEPAGE_775, tsAnsiSBCDToWide, @CP_775);

  1329.             TS_CODEPAGE_850:

  1330.               SetCodePage(TS_CODEPAGE_850, tsAnsiSBCDToWide, @CP_850);

  1331.             TS_CODEPAGE_852:

  1332.               SetCodePage(TS_CODEPAGE_852, tsAnsiSBCDToWide, @CP_852);

  1333.             TS_CODEPAGE_855:

  1334.               SetCodePage(TS_CODEPAGE_855, tsAnsiSBCDToWide, @CP_855);

  1335.             TS_CODEPAGE_857:

  1336.               SetCodePage(TS_CODEPAGE_857, tsAnsiSBCDToWide, @CP_857);

  1337.             TS_CODEPAGE_860:

  1338.               SetCodePage(TS_CODEPAGE_860, tsAnsiSBCDToWide, @CP_860);

  1339.             TS_CODEPAGE_861:

  1340.               SetCodePage(TS_CODEPAGE_861, tsAnsiSBCDToWide, @CP_861);

  1341.             TS_CODEPAGE_862:

  1342.               SetCodePage(TS_CODEPAGE_862, tsAnsiSBCDToWide, @CP_862);

  1343.             TS_CODEPAGE_863:

  1344.               SetCodePage(TS_CODEPAGE_863, tsAnsiSBCDToWide, @CP_863);

  1345.             TS_CODEPAGE_864:

  1346.               SetCodePage(TS_CODEPAGE_864, tsAnsiSBCDToWide, @CP_864);

  1347.             TS_CODEPAGE_865:

  1348.               SetCodePage(TS_CODEPAGE_865, tsAnsiSBCDToWide, @CP_865);

  1349.             TS_CODEPAGE_866:

  1350.               SetCodePage(TS_CODEPAGE_866, tsAnsiSBCDToWide, @CP_866);

  1351.             TS_CODEPAGE_869:

  1352.               SetCodePage(TS_CODEPAGE_869, tsAnsiSBCDToWide, @CP_869);

  1353.             TS_CODEPAGE_874:

  1354.               SetCodePage(TS_CODEPAGE_874, tsAnsiSBCDToWide, @CP_874);

  1355.             TS_CODEPAGE_875:

  1356.               SetCodePage(TS_CODEPAGE_875, tsAnsiSBCDToWide, @CP_875);

  1357.             TS_CODEPAGE_1026:

  1358.               SetCodePage(TS_CODEPAGE_1026, tsAnsiSBCDToWide, @CP_1026);

  1359.             TS_CODEPAGE_1250:

  1360.               SetCodePage(TS_CODEPAGE_1250, tsAnsiSBCDToWide, @CP_1250);

  1361.             TS_CODEPAGE_1251:

  1362.               SetCodePage(TS_CODEPAGE_1251, tsAnsiSBCDToWide, @CP_1251);

  1363.             TS_CODEPAGE_1252:

  1364.               SetCodePage(TS_CODEPAGE_1252, tsAnsiSBCDToWide, @CP_1252);

  1365.             TS_CODEPAGE_1253:

  1366.               SetCodePage(TS_CODEPAGE_1253, tsAnsiSBCDToWide, @CP_1253);

  1367.             TS_CODEPAGE_1254:

  1368.               SetCodePage(TS_CODEPAGE_1254, tsAnsiSBCDToWide, @CP_1254);

  1369.             TS_CODEPAGE_1255:

  1370.               SetCodePage(TS_CODEPAGE_1255, tsAnsiSBCDToWide, @CP_1255);

  1371.             TS_CODEPAGE_1256:

  1372.               SetCodePage(TS_CODEPAGE_1256, tsAnsiSBCDToWide, @CP_1256);

  1373.             TS_CODEPAGE_1257:

  1374.               SetCodePage(TS_CODEPAGE_1257, tsAnsiSBCDToWide, @CP_1257);

  1375.             TS_CODEPAGE_1258:

  1376.               SetCodePage(TS_CODEPAGE_1258, tsAnsiSBCDToWide, @CP_1258);

  1377.           else

  1378.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1379.           end;

  1380. 

  1381.         TS_DEBUG_DRAW_CHAR_RECTS:

  1382.           case pParam^ of

  1383.             TS_TRUE:

  1384.               Context.gDebugDrawCharRects := True;

  1385.             TS_FALSE:

  1386.               Context.gDebugDrawCharRects := False;

  1387.           else

  1388.             SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1389.           end;

  1390.       else

  1391.         SetError(TS_INVALID_ENUM, TS_FUNC_SET_PARAMETER);

  1392.       end;

  1393.     end else

  1394.       SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);

  1395.   end else

  1396.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_SET_PARAMETER);

  1397. end;

  1398. 

  1399. 

  1400. function tsGetParameteri(ParamName: tsEnum): tsInt;

  1401. begin

  1402.   tsGetParameteriv(ParamName, @Result);

  1403. end;

  1404. 

  1405. 

  1406. procedure tsGetParameteriv(ParamName: tsEnum; pParam: ptsInt);

  1407. var

  1408.   Context: TtsContext;

  1409. begin

  1410.   Context := gContext;

  1411. 

  1412.   if pParam <> nil then begin

  1413.     pParam^ := 0;

  1414. 

  1415.     case ParamName of

  1416.       TS_INFO_MAYOR_VERSION:

  1417.         pParam^ := TS_MAYOR_VERSION;

  1418. 

  1419.       TS_INFO_MINOR_VERSION:

  1420.         pParam^ := TS_MINOR_VERSION;

  1421. 

  1422.       TS_INFO_BUILD_NUMBER:

  1423.         pParam^ := TS_BUILD_NUMBER;

  1424. 

  1425.       TS_CONTEXT_BINDING:

  1426.         if Context <> nil then begin

  1427.           pParam^ := Context.ContextID;

  1428.         end;

  1429. 

  1430.       // font

  1431.       TS_FONT_STYLE:

  1432.         if Context <> nil then begin

  1433.           if Context.ActiveFont <> nil then begin

  1434.             pParam^ := TS_STYLE_NORMAL;

  1435. 

  1436.             with Context.ActiveFont do begin

  1437.               if tsStyleBold in Style then

  1438.                 pParam^ := pParam^ or TS_STYLE_BOLD;

  1439. 

  1440.               if tsStyleItalic in Style then

  1441.                 pParam^ := pParam^ or TS_STYLE_ITALIC;

  1442. 

  1443.               if tsStyleUnderline  in Style then

  1444.                 pParam^ := pParam^ or TS_STYLE_UNDERLINE;

  1445. 

  1446.               if tsStyleStrikeout  in Style then

  1447.                 pParam^ := pParam^ or TS_STYLE_STRIKEOUT;

  1448.             end;

  1449.           end else

  1450.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1451.         end else

  1452.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1453. 

  1454.       TS_FONT_FILE_STYLE:

  1455.         if Context <> nil then begin

  1456.           if Context.ActiveFont <> nil then begin

  1457.             pParam^ := Context.ActiveFont.FontFileStyle;

  1458.           end else

  1459.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1460.         end else

  1461.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1462. 

  1463.       TS_FONT_FIXED_WIDTH:

  1464.         if Context <> nil then begin

  1465.           if Context.ActiveFont <> nil then begin

  1466.             if Context.ActiveFont.FixedWidth then

  1467.               pParam^ := TS_TRUE

  1468.             else

  1469.               pParam^ := TS_FALSE;

  1470.           end else

  1471.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1472.         end else

  1473.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1474. 

  1475.       TS_FONT_ASCENT:

  1476.         if Context <> nil then begin

  1477.           if Context.ActiveFont <> nil then begin

  1478.             pParam^ := Context.ActiveFont.Ascent;

  1479.           end else

  1480.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1481.         end else

  1482.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1483. 

  1484.       TS_FONT_DESCENT:

  1485.         if Context <> nil then begin

  1486.           if Context.ActiveFont <> nil then begin

  1487.             pParam^ := Context.ActiveFont.Descent;

  1488.           end else

  1489.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1490.         end else

  1491.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1492. 

  1493.       TS_FONT_EXTERNAL_LEADING:

  1494.         if Context <> nil then begin

  1495.           if Context.ActiveFont <> nil then begin

  1496.             pParam^ := Context.ActiveFont.ExternalLeading;

  1497.           end else

  1498.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1499.         end else

  1500.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1501. 

  1502.       TS_FONT_BASELINE_OFFSET:

  1503.         if Context <> nil then begin

  1504.           if Context.ActiveFont <> nil then begin

  1505.             pParam^ := Context.ActiveFont.BaselineOffset;

  1506.           end else

  1507.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1508.         end else

  1509.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1510. 

  1511.       TS_FONT_LINESKIP:

  1512.         if Context <> nil then begin

  1513.           if Context.ActiveFont <> nil then begin

  1514.             with Context.ActiveFont do

  1515.               pParam^ := Ascent + Descent + ExternalLeading;

  1516.           end else

  1517.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1518.         end else

  1519.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1520. 

  1521.       TS_FONT_ANTIALIASING:

  1522.         if Context <> nil then begin

  1523.           if Context.ActiveFont <> nil then begin

  1524.             case Context.ActiveFont.AntiAliasing of

  1525.               tsAANone:

  1526.                 pParam^ := TS_ANTIALIASING_NONE;

  1527.               tsAANormal:

  1528.                 pParam^ := TS_ANTIALIASING_NORMAL;

  1529.             end;

  1530.           end else

  1531.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1532.         end else

  1533.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1534. 

  1535.       TS_FONT_FORMAT:

  1536.         if Context <> nil then begin

  1537.           if Context.ActiveFont <> nil then begin

  1538.             case Context.ActiveFont.Format of

  1539.               tsFormatEmpty:

  1540.                 pParam^ := TS_FORMAT_EMPTY;

  1541.               tsFormatRGBA8:

  1542.                 pParam^ := TS_FORMAT_RGBA8;

  1543.             end;

  1544.           end else

  1545.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1546.         end else

  1547.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1548. 

  1549.       TS_FONT_CHAR_SPACING:

  1550.         if Context <> nil then begin

  1551.           if Context.ActiveFont <> nil then begin

  1552.             pParam^ := Context.ActiveFont.CharSpacing;

  1553.           end else

  1554.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1555.         end else

  1556.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1557. 

  1558.       TS_FONT_LINE_SPACING:

  1559.         if Context <> nil then begin

  1560.           if Context.ActiveFont <> nil then begin

  1561.             pParam^ := Context.ActiveFont.LineSpacing;

  1562.           end else

  1563.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1564.         end else

  1565.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1566. 

  1567.       TS_FONT_UNDERLINE_POSITION:

  1568.         if Context <> nil then begin

  1569.           if Context.ActiveFont <> nil then begin

  1570.             pParam^ := Context.ActiveFont.UnderlinePosition;

  1571.           end else

  1572.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1573.         end else

  1574.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1575. 

  1576.       TS_FONT_UNDERLINE_SIZE:

  1577.         if Context <> nil then begin

  1578.           if Context.ActiveFont <> nil then begin

  1579.             pParam^ := Context.ActiveFont.UnderlineSize;

  1580.           end else

  1581.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1582.         end else

  1583.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1584. 

  1585.       TS_FONT_STRIKEOUT_POSITION:

  1586.         if Context <> nil then begin

  1587.           if Context.ActiveFont <> nil then begin

  1588.             pParam^ := Context.ActiveFont.StrikeoutPosition;

  1589.           end else

  1590.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1591.         end else

  1592.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1593. 

  1594.       TS_FONT_STRIKEOUT_SIZE:

  1595.         if Context <> nil then begin

  1596.           if Context.ActiveFont <> nil then begin

  1597.             pParam^ := Context.ActiveFont.StrikeoutSize;

  1598.           end else

  1599.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1600.         end else

  1601.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1602. 

  1603.       // globals

  1604.       TS_GLOBAL_ANTIALIASING:

  1605.         if Context <> nil then begin

  1606.           pParam^ := Context.gGlobalAntiAliasing;

  1607.         end else

  1608.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1609. 

  1610.       TS_GLOBAL_FORMAT:

  1611.         if Context <> nil then begin

  1612.           pParam^ := Context.gGlobalFormat;

  1613.         end else

  1614.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1615. 

  1616.       // creator

  1617.       TS_CREATOR:

  1618.         if Context <> nil then begin

  1619.           pParam^ := Context.gCreator;

  1620.         end else

  1621.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1622. 

  1623.       TS_CREATOR_CREATE_CHARS:

  1624.         if Context <> nil then begin

  1625.           if Context.ActiveFont <> nil then begin

  1626.             if Context.ActiveFont is TtsFontCreator then begin

  1627.               if TtsFontCreator(Context.ActiveFont).CreateChars then

  1628.                 pParam^ := TS_TRUE

  1629.               else

  1630.                 pParam^ := TS_FALSE;

  1631.             end else

  1632.               SetError(TS_INVALID_OPERATION, TS_FUNC_GET_PARAMETER);

  1633.           end else

  1634.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1635.         end else

  1636.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1637. 

  1638.       TS_CREATOR_ADD_RESIZING_BORDER:

  1639.         if Context <> nil then begin

  1640.           if Context.ActiveFont <> nil then begin

  1641.             if Context.ActiveFont is TtsFontCreator then begin

  1642.               if TtsFontCreator(Context.ActiveFont).AddResizingBorder then

  1643.                 pParam^ := TS_TRUE

  1644.               else

  1645.                 pParam^ := TS_FALSE;

  1646.             end else

  1647.               SetError(TS_INVALID_OPERATION, TS_FUNC_GET_PARAMETER);

  1648.           end else

  1649.             SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);

  1650.         end else

  1651.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1652. 

  1653.       // Renderer

  1654.       TS_RENDERER:

  1655.         if Context <> nil then begin

  1656.           if Context.Renderer <> nil then begin

  1657.             if Context.Renderer is TtsRendererNULL then begin

  1658.               pParam^ := TS_RENDERER_NULL;

  1659.             end else

  1660.             if Context.Renderer is TtsRendererOpenGL then begin

  1661.               pParam^ := TS_RENDERER_OPENGL;

  1662.             end else

  1663.               SetError(TS_ERROR, TS_FUNC_GET_PARAMETER);

  1664.           end;

  1665.         end else

  1666.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1667. 

  1668.       // opengl texture size

  1669.       TS_RENDERER_OPENGL_TEXTURE_SIZE:

  1670.         if Context <> nil then begin

  1671.           if Context.Renderer <> nil then begin

  1672.             if Context.Renderer is TtsRendererOpenGL then begin

  1673.               pParam^ := TtsRendererOpenGL(Context.Renderer).TextureSize;

  1674.             end else

  1675.               SetError(TS_INVALID_OPERATION, TS_FUNC_GET_PARAMETER);

  1676.           end else

  1677.             SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_GET_PARAMETER);

  1678.         end else

  1679.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1680. 

  1681.       // null renderer must save images

  1682.       TS_RENDERER_NULL_SAVE_IMAGES:

  1683.         if Context <> nil then begin

  1684.           if Context.Renderer <> nil then begin

  1685.             if Context.Renderer is TtsRendererNULL then begin

  1686.               case Context.Renderer.SaveImages of

  1687.                 True:

  1688.                   pParam^ := TS_TRUE;

  1689.                 False:

  1690.                   pParam^ := TS_FALSE;

  1691.               end;

  1692.             end else

  1693.               SetError(TS_INVALID_OPERATION, TS_FUNC_GET_PARAMETER);

  1694.           end else

  1695.             SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_GET_PARAMETER);

  1696.         end else

  1697.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1698. 

  1699.       TS_ALIGN:

  1700.         if Context <> nil then begin

  1701.           pParam^ := Context.gAlign;

  1702.         end else

  1703.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1704. 

  1705.       TS_VALIGN:

  1706.         if Context <> nil then begin

  1707.           pParam^ := Context.gVAlign;

  1708.         end else

  1709.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1710. 

  1711.       TS_CLIP:

  1712.         if Context <> nil then begin

  1713.           pParam^ := Context.gClip;

  1714.         end else

  1715.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1716. 

  1717.       TS_BLOCK_OFFSET_X:

  1718.         if Context <> nil then begin

  1719.           pParam^ := Context.gBlockOffsetX;

  1720.         end else

  1721.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1722. 

  1723.       TS_BLOCK_OFFSET_Y:

  1724.         if Context <> nil then begin

  1725.           pParam^ := Context.gBlockOffsetY;

  1726.         end else

  1727.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1728. 

  1729. {

  1730.       TS_TAB:

  1731.         pParam^ := gTab;

  1732. 

  1733.       TS_TAB_FIXED_WIDTH:

  1734.         pParam^ := gTabWidth;

  1735. }

  1736. 

  1737.       TS_SINGLE_LINE:

  1738.         if Context <> nil then begin

  1739.           pParam^ := Context.gSingleLine;

  1740.         end else

  1741.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1742. 

  1743.       TS_IMAGE_RED_MODE:

  1744.         if Context <> nil then begin

  1745.           pParam^ := Context.gImageMode[tsModeRed];

  1746.         end else

  1747.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1748. 

  1749.       TS_IMAGE_GREEN_MODE:

  1750.         if Context <> nil then begin

  1751.           pParam^ := Context.gImageMode[tsModeGreen];

  1752.         end else

  1753.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1754. 

  1755.       TS_IMAGE_BLUE_MODE:

  1756.         if Context <> nil then begin

  1757.           pParam^ := Context.gImageMode[tsModeBlue];

  1758.         end else

  1759.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1760. 

  1761.       TS_IMAGE_ALPHA_MODE:

  1762.         if Context <> nil then begin

  1763.           pParam^ := Context.gImageMode[tsModeAlpha];

  1764.         end else

  1765.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1766. 

  1767.       TS_IMAGE_LUMINANCE_MODE:

  1768.         if Context <> nil then begin

  1769.           pParam^ := Context.gImageMode[tsModeLuminance];

  1770.         end else

  1771.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1772. 

  1773.       TS_IMAGE_LIBRARY:

  1774.         if Context <> nil then begin

  1775.           pParam^ := Context.gImageLibrary;

  1776.         end else

  1777.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1778. 

  1779.       TS_EMPTY_CP_ENTRY:

  1780.         if Context <> nil then begin

  1781.           pParam^ := Context.gEmptyCodePageEntry;

  1782.         end else

  1783.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1784. 

  1785.       TS_CODEPAGE:

  1786.         if Context <> nil then begin

  1787.           pParam^ := Context.gCodePage;

  1788.         end else

  1789.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1790. 

  1791.       TS_DEBUG_DRAW_CHAR_RECTS:

  1792.         if Context <> nil then begin

  1793.           case Context.gDebugDrawCharRects of

  1794.             True:

  1795.               pParam^ := TS_TRUE;

  1796.             False:

  1797.               pParam^ := TS_FALSE;

  1798.           end;

  1799.         end else

  1800.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1801. 

  1802.       TS_FONT_BINDING:

  1803.         if Context <> nil then begin

  1804.           if Context.Renderer <> nil then begin

  1805.             pParam^ := Context.Renderer.ActiveFontID;

  1806.           end

  1807.             else SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_GET_PARAMETER);

  1808.         end else

  1809.           SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);

  1810.     else

  1811.       SetError(TS_INVALID_ENUM, TS_FUNC_GET_PARAMETER);

  1812.     end;

  1813.   end else

  1814.     SetError(TS_INVALID_VALUE, TS_FUNC_GET_PARAMETER);

  1815. end;

  1816. 

  1817. 

  1818. function tsGetStringA(ParamName: tsEnum): pAnsiChar; 

  1819. var

  1820.   Context: TtsContext; 

  1821. begin

  1822.   Result := nil;

  1823. 

  1824.   Context := gContext;

  1825. 

  1826.   case ParamName of

  1827.     TS_INFO_VERSION:

  1828.       if TS_VERSION_STR <> '' then

  1829.         Result := pAnsiChar(TS_VERSION_STR);

  1830. 

  1831.     TS_INFO_COPYRIGHT:

  1832.       if TS_COPYRIGHT_STR <> '' then

  1833.         Result := pAnsiChar(TS_COPYRIGHT_STR);

  1834. 

  1835.     TS_FONT_COPYRIGHT:

  1836.       if Context <> nil then begin

  1837.         if Context.ActiveFont <> nil then begin

  1838.           if Context.ActiveFont.Copyright <> '' then

  1839.             Result := pAnsiChar(Context.ActiveFont.Copyright);

  1840.         end else

  1841.           SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_STRING);

  1842.       end else

  1843.         SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_STRING);

  1844. 

  1845.     TS_FONT_FACE_NAME:

  1846.       if Context <> nil then begin

  1847.         if Context.ActiveFont <> nil then begin

  1848.           if Context.ActiveFont.FaceName <> '' then

  1849.             Result := pAnsiChar(Context.ActiveFont.FaceName);

  1850.         end else

  1851.           SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_STRING);

  1852.       end else

  1853.         SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_STRING);

  1854. 

  1855.     TS_FONT_STYLE_NAME:

  1856.       if Context <> nil then begin

  1857.         if Context.ActiveFont <> nil then begin

  1858.           if Context.ActiveFont.StyleName <> '' then

  1859.             Result := pAnsiChar(Context.ActiveFont.StyleName);

  1860.         end else

  1861.           SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_STRING);

  1862.       end else

  1863.         SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_STRING);

  1864. 

  1865.     TS_FONT_FULL_NAME:

  1866.       if Context <> nil then begin

  1867.         if Context.ActiveFont <> nil then begin

  1868.           if Context.ActiveFont.FullName <> '' then

  1869.             Result := pAnsiChar(Context.ActiveFont.FullName);

  1870.         end else

  1871.           SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_STRING);

  1872.       end else

  1873.         SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_STRING);

  1874.   else

  1875.     SetError(TS_INVALID_ENUM, TS_FUNC_GET_STRING);

  1876.   end;

  1877. end;

  1878. 

  1879. 

  1880. // *** Context functions ***

  1881. procedure tsContextCreate(pContextID: ptsContextID);

  1882. begin

  1883.   if TextSuite_initialized then begin

  1884.     if pContextID <> nil then begin

  1885.       try

  1886.         gCriticalSection.Enter;

  1887.         try

  1888.           // unbound current context

  1889.           if gContext <> nil then begin

  1890.             gContext.gBoundThreadID := 0;

  1891.             gContext := nil;

  1892.           end;

  1893. 

  1894.           // create Context and bound it

  1895.           gContext := TtsContext.Create;

  1896.           gContext.gBoundThreadID := GetCurrentThreadId;

  1897. 

  1898.           // add to list

  1899.           gContexts.Add(gContext.ContextID, gContext);

  1900. 

  1901.           // return context id

  1902.           pContextID^ := gContext.ContextID;

  1903.         finally

  1904.           gCriticalSection.Leave;

  1905.         end;

  1906.       except

  1907.         on E: Exception do begin

  1908.           if E is EOutOfMemory then

  1909.             SetError(TS_OUT_OF_MEMORY, TS_FUNC_CONTEXT_CREATE)

  1910.           else

  1911.             SetError(TS_ERROR, TS_FUNC_CONTEXT_CREATE);

  1912. 

  1913.           pContextID^ := 0;

  1914.         end;

  1915.       end;

  1916.     end else

  1917.       SetError(TS_INVALID_VALUE, TS_FUNC_CONTEXT_CREATE);

  1918.   end else

  1919.     SetError(TS_NOT_INITIALIZED, TS_FUNC_CONTEXT_CREATE);

  1920. end;

  1921. 

  1922. 

  1923. procedure tsContextDestroy(ContextID: tsContextID);

  1924. var

  1925.   Context: TtsContext;

  1926. begin

  1927.   if TextSuite_initialized then begin

  1928.     try

  1929.       gCriticalSection.Enter;

  1930.       try

  1931.         Context := gContexts.Get(ContextID);

  1932. 

  1933.         if Context <> nil then begin

  1934.           // if context isn't bound or to actual thread

  1935.           if (Context.gBoundThreadID = 0) or (Context.gBoundThreadID = GetCurrentThreadId) then begin

  1936.             // if it's bound to actual thread

  1937.             if Context.gBoundThreadID = GetCurrentThreadId then begin

  1938.               gContext.gBoundThreadID := 0; 

  1939.               gContext := nil;

  1940.             end;

  1941. 

  1942.             // delete from list

  1943.             gContexts.Delete(ContextID);

  1944. 

  1945.             // free them

  1946.             Context.Free;

  1947.           end else

  1948.             SetError(TS_INVALID_OPERATION, TS_FUNC_CONTEXT_DESTROY);

  1949.         end else

  1950.           SetError(TS_INVALID_VALUE, TS_FUNC_CONTEXT_DESTROY);

  1951.       finally

  1952.         gCriticalSection.Leave;

  1953.       end;

  1954.     except

  1955.       SetError(TS_ERROR, TS_FUNC_CONTEXT_DESTROY);

  1956.     end;

  1957.   end else

  1958.     SetError(TS_NOT_INITIALIZED, TS_FUNC_CONTEXT_DESTROY);

  1959. end;

  1960. 

  1961. 

  1962. procedure tsContextBind(ContextID: tsContextID);

  1963. var

  1964.   Context: TtsContext;

  1965. begin

  1966.   if TextSuite_initialized then begin

  1967.     gCriticalSection.Enter;

  1968.     try

  1969.       // if any context is bound then release him

  1970.       if gContext <> nil then begin

  1971.         gContext.gBoundThreadID := 0;

  1972.         gContext := nil;

  1973.       end;

  1974. 

  1975.       // bind new context if <> zero

  1976.       if ContextID <> 0 then begin

  1977.         Context := gContexts.Get(ContextID);

  1978. 

  1979.         if Context <> nil then begin

  1980.           // check if the context is bound or bound to actual context

  1981.           if (Context.gBoundThreadID = 0) or (Context.gBoundThreadID = GetCurrentThreadId) then begin

  1982.             gContext := Context;

  1983.             gContext.gBoundThreadID := GetCurrentThreadId;

  1984.           end else

  1985.             SetError(TS_INVALID_OPERATION, TS_FUNC_CONTEXT_BIND);

  1986.         end else

  1987.           SetError(TS_INVALID_VALUE, TS_FUNC_CONTEXT_BIND);

  1988.       end;

  1989.     finally

  1990.       gCriticalSection.Leave;

  1991.     end;

  1992.   end else

  1993.     SetError(TS_NOT_INITIALIZED, TS_FUNC_CONTEXT_BIND);

  1994. end;

  1995. 

  1996. 

  1997. // *** font functions ***

  1998. //procedure tsFontCreate(pFontID: ptsFontID); 

  1999. //begin

  2000. 

  2001. //end;

  2002. 

  2003. 

  2004. procedure tsFontCreateCreatorA(Name: pAnsiChar; Size: tsInt; Style: tsBitmask; AntiAliasing: tsEnum; Format: tsEnum; pFontID: ptsFontID);

  2005. var

  2006.   Context: TtsContext;

  2007. 

  2008.   TempStyle: TtsFontStyles;

  2009.   TempAntiAliasing: TtsAntiAliasing;

  2010.   TempFormat: TtsFormat;

  2011. 

  2012.   Creator: TtsFontCreator;

  2013. begin

  2014.   Context := gContext;

  2015. 

  2016.   if Context <> nil then begin

  2017.     if Context.Renderer <> nil then begin

  2018.       if pFontID <> nil then begin

  2019.         pFontID^ := 0;

  2020. 

  2021.         // Style

  2022.         TempStyle := [];

  2023. 

  2024.         if (Style and TS_STYLE_BOLD) > 0 then

  2025.           TempStyle := TempStyle + [tsStyleBold];

  2026. 

  2027.         if (Style and TS_STYLE_ITALIC) > 0 then

  2028.           TempStyle := TempStyle + [tsStyleItalic];

  2029. 

  2030.         if (Style and TS_STYLE_UNDERLINE) > 0 then

  2031.           TempStyle := TempStyle + [tsStyleUnderline];

  2032. 

  2033.         if (Style and TS_STYLE_STRIKEOUT) > 0 then

  2034.           TempStyle := TempStyle + [tsStyleStrikeout];

  2035. 

  2036.         // AntiAliasing

  2037.         if AntiAliasing = TS_DEFAULT then

  2038.           AntiAliasing := Context.gGlobalAntiAliasing;

  2039. 

  2040.         case AntiAliasing of

  2041.           TS_ANTIALIASING_NONE:

  2042.             TempAntiAliasing := tsAANone;

  2043.           TS_ANTIALIASING_NORMAL:

  2044.             TempAntiAliasing := tsAANormal;

  2045.         else

  2046.           SetError(TS_INVALID_ENUM, TS_FUNC_FONT_CREATE_CREATOR);

  2047. 

  2048.           Exit;

  2049.         end;

  2050. 

  2051.         // Format

  2052.         if Format = TS_DEFAULT then

  2053.           Format := Context.gGlobalFormat;

  2054. 

  2055.         case Format of

  2056.           TS_FORMAT_RGBA8:

  2057.             TempFormat := tsFormatRGBA8;

  2058.         else

  2059.           SetError(TS_INVALID_ENUM, TS_FUNC_FONT_CREATE_CREATOR);

  2060. 

  2061.           Exit;

  2062.         end;

  2063. 

  2064.         Creator := nil;

  2065. 

  2066.         // create font

  2067.         try

  2068.           case Context.gCreator of

  2069.             TS_CREATOR_SDL:

  2070.               begin

  2071.                 if SDL_TTF_initialized then

  2072.                   Creator := TtsFontCreatorSDL.Create(Context.Renderer, Name, Size, TempStyle, TempFormat, TempAntiAliasing)

  2073.                 else

  2074.                   SetError(TS_NOT_INITIALIZED, TS_FUNC_FONT_CREATE_CREATOR);

  2075.               end;

  2076.             TS_CREATOR_GDI:

  2077.               begin

  2078.                 if GDI_initialized then

  2079.                   Creator := TtsFontCreatorGDIFile.Create(Context.Renderer, Name, Size, TempStyle, TempFormat, TempAntiAliasing)

  2080.                 else

  2081.                   SetError(TS_NOT_INITIALIZED, TS_FUNC_FONT_CREATE_CREATOR);

  2082.               end;

  2083.             TS_CREATOR_GDI_FACENAME:

  2084.               begin

  2085.                 if GDI_initialized then

  2086.                   Creator := TtsFontCreatorGDIFontFace.Create(Context.Renderer, Name, Size, TempStyle, TempFormat, TempAntiAliasing)

  2087.                 else

  2088.                   SetError(TS_NOT_INITIALIZED, TS_FUNC_FONT_CREATE_CREATOR);

  2089.               end;

  2090.             TS_CREATOR_GDI_STREAM:

  2091.               begin

  2092.                 if GDI_initialized then

  2093.                   Creator := TtsFontCreatorGDIStream.Create(Context.Renderer, TStream(Name), Size, TempStyle, TempFormat, TempAntiAliasing)

  2094.                 else

  2095.                   SetError(TS_NOT_INITIALIZED, TS_FUNC_FONT_CREATE_CREATOR);

  2096.               end;

  2097.           else

  2098.             SetError(TS_INVALID_ENUM, TS_FUNC_FONT_CREATE_CREATOR);

  2099.           end;

  2100.         except

  2101.           on E: Exception do begin

  2102.             if E is EOutOfMemory then

  2103.               SetError(TS_OUT_OF_MEMORY, TS_FUNC_FONT_CREATE_CREATOR)

  2104.             else

  2105.               SetError(TS_ERROR, TS_FUNC_FONT_CREATE_CREATOR);

  2106.             Exit;

  2107.           end;

  2108.         end;

  2109. 

  2110.         // Bind font

  2111.         if Creator <> nil then begin

  2112.           pFontID^ := Context.FontAdd(Creator);

  2113. 

  2114.           tsFontBind(pFontID^);

  2115.         end;

  2116.       end else

  2117.         SetError(TS_INVALID_VALUE, TS_FUNC_FONT_CREATE_CREATOR);

  2118.     end else

  2119.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_FONT_CREATE_CREATOR);

  2120.   end else

  2121.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_CREATE_CREATOR);

  2122. end;

  2123. 

  2124. 

  2125. procedure tsFontDestroy(FontID: tsFontID);

  2126. var

  2127.   Context: TtsContext;

  2128.   Font: TtsFont;

  2129. begin

  2130.   Context := gContext;

  2131. 

  2132.   if Context <> nil then begin

  2133.     if not Context.IsLocked then begin

  2134.       Font := Context.FontGet(FontID);

  2135. 

  2136.       if Font <> nil then begin

  2137.         Context.FontDelete(FontID);

  2138. 

  2139.         Font.Free;

  2140.       end else

  2141.         SetError(TS_INVALID_VALUE, TS_FUNC_FONT_DESTROY);

  2142.     end else

  2143.       SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_DESTROY);

  2144.   end else

  2145.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_DESTROY);

  2146. end;

  2147. 

  2148. 

  2149. procedure tsFontBind(FontID: tsFontID);

  2150. var

  2151.   Context: TtsContext;

  2152. begin

  2153.   Context := gContext;

  2154. 

  2155.   if Context <> nil then begin

  2156.     if Context.Renderer <> nil then begin

  2157.       if (FontID = 0) or (Context.FontGet(FontID) <> nil) then begin  

  2158.         Context.Renderer.FontActivate(FontID);

  2159.       end else

  2160.         SetError(TS_INVALID_VALUE, TS_FUNC_FONT_BIND);

  2161.     end else

  2162.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_FONT_BIND);

  2163.   end else

  2164.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_BIND);

  2165. end;

  2166. 

  2167. 

  2168. procedure tsFontAddCharRange(CharStart: WideChar; CharEnd: WideChar);

  2169. var

  2170.   ActiveFont: TtsFont;

  2171.   CharIdx: WideChar;

  2172.   Context: TtsContext;

  2173. begin

  2174.   Context := gContext;

  2175. 

  2176.   if Context <> nil then begin

  2177.     ActiveFont := Context.ActiveFont;

  2178. 

  2179.     if ActiveFont <> nil then begin

  2180.       if ActiveFont is TtsFontCreator then begin

  2181.         for CharIdx := CharStart to CharEnd do

  2182.           TtsFontCreator(ActiveFont).AddChar(CharIdx);

  2183.       end else

  2184.         SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_ADD_CHAR);

  2185.     end else

  2186.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_ADD_CHAR);

  2187.   end else

  2188.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_ADD_CHAR);

  2189. end;

  2190. 

  2191. 

  2192. procedure tsFontAddChars(Chars: pWideChar);

  2193. var

  2194.   ActiveFont: TtsFont;

  2195.   Context: TtsContext;

  2196. begin

  2197.   Context := gContext;

  2198. 

  2199.   if Context <> nil then begin

  2200.     ActiveFont := Context.ActiveFont;

  2201. 

  2202.     if ActiveFont <> nil then begin

  2203.       if ActiveFont is TtsFontCreator then begin

  2204.         if Chars <> nil then begin

  2205.           while Chars^ <> #0 do begin

  2206.             TtsFontCreator(ActiveFont).AddChar(Chars^);

  2207. 

  2208.             Inc(Chars);

  2209.           end;

  2210.         end else

  2211.           SetError(TS_INVALID_VALUE, TS_FUNC_FONT_ADD_CHAR);

  2212.       end else

  2213.         SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_ADD_CHAR);

  2214.     end else

  2215.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_ADD_CHAR);

  2216.   end else

  2217.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_ADD_CHAR);

  2218. end;

  2219. 

  2220. 

  2221. procedure tsFontAddChar(Char: WideChar);

  2222. var

  2223.   ActiveFont: TtsFont;

  2224.   Context: TtsContext;

  2225. begin

  2226.   Context := gContext;

  2227. 

  2228.   if Context <> nil then begin

  2229.     ActiveFont := Context.ActiveFont;

  2230. 

  2231.     if ActiveFont <> nil then begin

  2232.       if ActiveFont is TtsFontCreator then begin

  2233.         TtsFontCreator(ActiveFont).AddChar(Char);

  2234.       end else

  2235.         SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_ADD_CHAR);

  2236.     end else

  2237.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_ADD_CHAR);

  2238.   end else

  2239.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_ADD_CHAR);

  2240. end;

  2241. 

  2242. 

  2243. procedure tsFontDeleteCharRange(CharStart: WideChar; CharEnd: WideChar);

  2244. var

  2245.   Char: WideChar;

  2246.   ActiveFont: TtsFont;

  2247.   Context: TtsContext;

  2248. begin

  2249.   Context := gContext;

  2250. 

  2251.   if Context <> nil then begin

  2252.     ActiveFont := Context.ActiveFont;

  2253. 

  2254.     if ActiveFont <> nil then begin

  2255.       if ActiveFont is TtsFontCreator then begin

  2256.         for Char := CharStart to CharEnd do

  2257.           TtsFontCreator(ActiveFont).DeleteChar(Char);

  2258.       end else

  2259.         SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_DELETE_CHAR);

  2260.     end else

  2261.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_DELETE_CHAR);

  2262.   end else

  2263.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_DELETE_CHAR);

  2264. end;

  2265. 

  2266. 

  2267. procedure tsFontDeleteChars(Chars: pWideChar);

  2268. var

  2269.   ActiveFont: TtsFont;

  2270.   Context: TtsContext;

  2271. begin

  2272.   Context := gContext;

  2273. 

  2274.   if Context <> nil then begin

  2275.     ActiveFont := Context.ActiveFont;

  2276. 

  2277.     if ActiveFont <> nil then begin

  2278.       if ActiveFont is TtsFontCreator then begin

  2279.         if Chars <> nil then begin

  2280.           while Chars^ <> #0 do begin

  2281.             TtsFontCreator(ActiveFont).DeleteChar(Chars^);

  2282. 

  2283.             Inc(Chars);

  2284.           end;

  2285.         end else

  2286.           SetError(TS_INVALID_VALUE, TS_FUNC_FONT_DELETE_CHAR);

  2287.       end else

  2288.         SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_DELETE_CHAR);

  2289.     end else

  2290.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_DELETE_CHAR);

  2291.   end else

  2292.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_DELETE_CHAR);

  2293. end;

  2294. 

  2295. 

  2296. procedure tsFontDeleteChar(Char: WideChar);

  2297. var

  2298.   ActiveFont: TtsFont;

  2299.   Context: TtsContext;

  2300. begin

  2301.   Context := gContext;

  2302. 

  2303.   if Context <> nil then begin

  2304.     ActiveFont := Context.ActiveFont;

  2305. 

  2306.     if ActiveFont <> nil then begin

  2307.       if ActiveFont is TtsFontCreator then begin

  2308.         TtsFontCreator(Context.ActiveFont).DeleteChar(Char);

  2309.       end else

  2310.         SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_DELETE_CHAR);

  2311.     end else

  2312.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_DELETE_CHAR);

  2313.   end else

  2314.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_DELETE_CHAR);

  2315. end;

  2316. 

  2317. 

  2318. procedure tsFontSetCharParameteri(Char: WideChar; ParamName: tsEnum; Param: tsInt);

  2319. begin

  2320.   if ((ParamName <> TS_CHAR_GLYPHORIGIN) and

  2321.       (ParamName <> TS_CHAR_GLYPHRECT)) then begin

  2322.     tsFontSetCharParameteriv(Char, ParamName, @Param);

  2323.   end else

  2324.     SetError(TS_INVALID_ENUM, TS_FUNC_FONT_SET_CHAR_PARAMETER);

  2325. end;

  2326. 

  2327. 

  2328. procedure tsFontSetCharParameteriv(Char: WideChar; ParamName: tsEnum; pParam: ptsInt);

  2329. var

  2330.   tsChar: TtsChar;

  2331.   Context: TtsContext;

  2332. begin

  2333.   Context := gContext;

  2334. 

  2335.   if Context <> nil then begin

  2336.     if Context.ActiveFont <> nil then begin

  2337.       if pParam <> nil then begin

  2338.         tsChar := Context.ActiveFont.Char[Char];

  2339. 

  2340.         if tsChar <> nil then begin

  2341.           case ParamName of

  2342.             TS_CHAR_ADVANCE:

  2343.               tsChar.Advance := pParam^;

  2344. 

  2345.             TS_CHAR_GLYPHORIGIN:

  2346.               begin

  2347.                 tsChar.GlyphOriginX := ptsPoint(pParam)^.X;

  2348.                 tsChar.GlyphOriginY := ptsPoint(pParam)^.Y;

  2349.               end;

  2350. 

  2351.             TS_CHAR_GLYPHORIGIN_X:

  2352.               tsChar.GlyphOriginX := pParam^;

  2353. 

  2354.             TS_CHAR_GLYPHORIGIN_Y:

  2355.               tsChar.GlyphOriginY := pParam^;

  2356. 

  2357.             TS_CHAR_GLYPHRECT:

  2358.               tsChar.GlyphRect := pTsRect(pParam)^;

  2359. 

  2360.             TS_CHAR_GLYPHRECT_TOP:

  2361.               tsChar.GlyphRect.Top := pParam^;

  2362. 

  2363.             TS_CHAR_GLYPHRECT_LEFT:

  2364.               tsChar.GlyphRect.Left := pParam^;

  2365. 

  2366.             TS_CHAR_GLYPHRECT_RIGHT:

  2367.               tsChar.GlyphRect.Right := pParam^;

  2368. 

  2369.             TS_CHAR_GLYPHRECT_BOTTOM:

  2370.               tsChar.GlyphRect.Bottom := pParam^;

  2371.           else

  2372.             SetError(TS_INVALID_ENUM, TS_FUNC_FONT_SET_CHAR_PARAMETER);

  2373.           end;

  2374.         end else

  2375.           SetError(TS_INVALID_VALUE, TS_FUNC_FONT_SET_CHAR_PARAMETER);

  2376.       end else

  2377.         SetError(TS_INVALID_VALUE, TS_FUNC_FONT_SET_CHAR_PARAMETER);

  2378.     end else

  2379.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_SET_CHAR_PARAMETER);

  2380.   end else

  2381.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_SET_CHAR_PARAMETER);

  2382. end;

  2383. 

  2384. 

  2385. function tsFontGetCharParameteri(Char: WideChar; ParamName: tsEnum): tsInt;

  2386. begin

  2387.   if ((ParamName <> TS_CHAR_GLYPHORIGIN) and

  2388.       (ParamName <> TS_CHAR_GLYPHRECT)) then begin

  2389.     tsFontGetCharParameteriv(Char, ParamName, @Result);

  2390.   end else

  2391.     SetError(TS_INVALID_ENUM, TS_FUNC_FONT_GET_CHAR_PARAMETER);

  2392. end;

  2393. 

  2394. 

  2395. procedure tsFontGetCharParameteriv(Char: WideChar; ParamName: tsEnum; pParam: ptsInt);

  2396. var

  2397.   tsChar: TtsChar;

  2398.   Context: TtsContext;

  2399. begin

  2400.   pParam^ := 0;

  2401.   Context := gContext;

  2402. 

  2403.   if Context <> nil then begin

  2404.     if Context.ActiveFont <> nil then begin

  2405.       if pParam <> nil then begin

  2406.         tsChar := Context.ActiveFont.Char[Char];

  2407. 

  2408.         if tsChar <> nil then begin

  2409.           case ParamName of

  2410.             TS_CHAR_ADVANCE:

  2411.               pParam^ := tsChar.Advance;

  2412.             TS_CHAR_GLYPHORIGIN:

  2413.               begin

  2414.                 ptsPoint(pParam)^.X := tsChar.GlyphOriginX;

  2415.                 ptsPoint(pParam)^.Y := tsChar.GlyphOriginY;

  2416.               end;

  2417.             TS_CHAR_GLYPHORIGIN_X:

  2418.               pParam^ := tsChar.GlyphOriginX;

  2419.             TS_CHAR_GLYPHORIGIN_Y:

  2420.               pParam^ := tsChar.GlyphOriginY;

  2421.             TS_CHAR_GLYPHRECT:

  2422.               PtsRect(pParam)^ := tsChar.GlyphRect;

  2423.             TS_CHAR_GLYPHRECT_TOP:

  2424.               pParam^ := tsChar.GlyphRect.Top;

  2425.             TS_CHAR_GLYPHRECT_LEFT:

  2426.               pParam^ := tsChar.GlyphRect.Left;

  2427.             TS_CHAR_GLYPHRECT_RIGHT:

  2428.               pParam^ := tsChar.GlyphRect.Right;

  2429.             TS_CHAR_GLYPHRECT_BOTTOM:

  2430.               pParam^ := tsChar.GlyphRect.Bottom;

  2431.           else

  2432.             SetError(TS_INVALID_ENUM, TS_FUNC_FONT_GET_CHAR_PARAMETER);

  2433.           end;

  2434.         end else

  2435.           SetError(TS_INVALID_VALUE, TS_FUNC_FONT_GET_CHAR_PARAMETER);

  2436.       end else

  2437.         SetError(TS_INVALID_VALUE, TS_FUNC_FONT_GET_CHAR_PARAMETER);

  2438.     end else

  2439.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_GET_CHAR_PARAMETER);

  2440.   end else

  2441.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_GET_CHAR_PARAMETER);

  2442. end;

  2443. 

  2444. 

  2445. procedure tsPostAddFillColor3ub(Red, Green, Blue: tsByte; ChannelMask: tsBitmask);

  2446. begin

  2447.   tsPostAddFillColor4f(Red / $FF, Green / $FF, Blue / $FF, 1, ChannelMask);

  2448. end;

  2449. 

  2450. 

  2451. procedure tsPostAddFillColor3f(Red, Green, Blue: tsFloat; ChannelMask: tsBitmask);

  2452. begin

  2453.   tsPostAddFillColor4f(Red, Green, Blue, 1, ChannelMask);

  2454. end;

  2455. 

  2456. 

  2457. procedure tsPostAddFillColor4ub(Red, Green, Blue, Alpha: tsByte; ChannelMask: tsBitmask);

  2458. begin

  2459.   tsPostAddFillColor4f(Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF, ChannelMask);

  2460. end;

  2461. 

  2462. 

  2463. procedure tsPostAddFillColor4f(Red, Green, Blue, Alpha: tsFloat; ChannelMask: tsBitmask);

  2464. var

  2465.   Context: TtsContext;

  2466. begin

  2467.   Context := gContext;

  2468. 

  2469.   if Context <> nil then begin

  2470.     if Context.ActiveFont <> nil then begin

  2471.       if Context.ActiveFont is TtsFontCreator then begin

  2472.         TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostFillColor.Create(Red, Green, Blue, Alpha, ChannelMask, Context.gImageMode));

  2473.       end else

  2474.         SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_FILL_COLOR);

  2475.     end else

  2476.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_FILL_COLOR);

  2477.   end else

  2478.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_FILL_COLOR);

  2479. end;

  2480. 

  2481. 

  2482. procedure tsPostAddFillPattern(PatternImageID: tsImageID; X, Y: tsInt; ChannelMask: tsBitmask);

  2483. var

  2484.   Context: TtsContext;

  2485.   Image: TtsImage;

  2486. begin

  2487.   Context := gContext;

  2488. 

  2489.   if Context <> nil then begin

  2490.     if Context.ActiveFont <> nil then begin

  2491.       if Context.ActiveFont is TtsFontCreator then begin

  2492.         Image := Context.ImageGet(PatternImageID);

  2493. 

  2494.         if Image <> nil then

  2495.           TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostFillPattern.Create(Image, X, Y, ChannelMask, Context.gImageMode))

  2496.         else

  2497.           SetError(TS_INVALID_VALUE, TS_FUNC_POST_ADD_FILL_PATTERN);

  2498.       end else

  2499.         SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_FILL_PATTERN);

  2500.     end else

  2501.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_FILL_PATTERN);

  2502.   end else

  2503.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_FILL_PATTERN);

  2504. end;

  2505. 

  2506. 

  2507. procedure tsPostAddBorder3ub(Width, Strength: Single; Red, Green, Blue: tsByte);

  2508. begin

  2509.   tsPostAddBorder4f(Width, Strength, Red / $FF, Green / $FF, Blue / $FF, 1);

  2510. end;

  2511. 

  2512. 

  2513. procedure tsPostAddBorder3f(Width, Strength: Single; Red, Green, Blue: tsFloat);

  2514. begin

  2515.   tsPostAddBorder4f(Width, Strength, Red, Green, Blue, 1);

  2516. end;

  2517. 

  2518. 

  2519. procedure tsPostAddBorder4ub(Width, Strength: Single; Red, Green, Blue, Alpha: tsByte);

  2520. begin

  2521.   tsPostAddBorder4f(Width, Strength, Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF);

  2522. end;

  2523. 

  2524. 

  2525. procedure tsPostAddBorder4f(Width, Strength: Single; Red, Green, Blue, Alpha: tsFloat);

  2526. var

  2527.   Context: TtsContext;

  2528. begin

  2529.   Context := gContext;

  2530. 

  2531.   if Context <> nil then begin

  2532.     if Context.ActiveFont <> nil then begin

  2533.       if Context.ActiveFont is TtsFontCreator then begin

  2534.         TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostBorder.Create(Width, Strength, Red, Green, Blue, Alpha));

  2535.       end else

  2536.         SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_BORDER);

  2537.     end else

  2538.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_BORDER);

  2539.   end else

  2540.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_BORDER);

  2541. end;

  2542. 

  2543. 

  2544. procedure tsPostAddShadow3ub(Radius: Single; X, Y: tsInt; Red, Green, Blue: tsByte);

  2545. begin

  2546.   tsPostAddShadow4f(Radius, X, Y, Red / $FF, Green / $FF, Blue / $FF, 1);

  2547. end;

  2548. 

  2549. 

  2550. procedure tsPostAddShadow3f(Radius: Single; X, Y: tsInt; Red, Green, Blue: tsFloat);

  2551. begin

  2552.   tsPostAddShadow4f(Radius, X, Y, Red, Green, Blue, 1);

  2553. end;

  2554. 

  2555. 

  2556. procedure tsPostAddShadow4ub(Radius: Single; X, Y: tsInt; Red, Green, Blue, Alpha: tsByte);

  2557. begin

  2558.   tsPostAddShadow4f(Radius, X, Y, Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF);

  2559. end;

  2560. 

  2561. 

  2562. procedure tsPostAddShadow4f(Radius: Single; X, Y: tsInt; Red, Green, Blue, Alpha: tsFloat);

  2563. var

  2564.   Context: TtsContext;

  2565. begin

  2566.   Context := gContext;

  2567. 

  2568.   if Context <> nil then begin

  2569.     if Context.ActiveFont <> nil then begin

  2570.       if Context.ActiveFont is TtsFontCreator then begin

  2571.         TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostShadow.Create(Radius, X, Y, Red, Green, Blue, Alpha));

  2572.       end else

  2573.         SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_SHADOW);

  2574.     end else

  2575.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_SHADOW);

  2576.   end else

  2577.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_SHADOW);

  2578. end;

  2579. 

  2580. 

  2581. (*

  2582. procedure tsPostAddKerning;

  2583. var

  2584.   Context: TtsContext;

  2585. begin

  2586.   Context := gContext;

  2587. 

  2588.   if Context <> nil then begin

  2589.     if Context.ActiveFont <> nil then begin

  2590.       if Context.ActiveFont is TtsFontCreator then begin

  2591.         TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostKerning.Create);

  2592.       end else

  2593.         SetError(TS_INVALID_OPERATION;

  2594.     end else

  2595.       SetError(TS_NO_ACTIVE_FONT;

  2596.   end else

  2597.     SetError(TS_NO_ACTIVE_CONTEXT;

  2598. end;

  2599. *)

  2600. 

  2601. procedure tsPostAddCustom(PostProcessProc: tsPostProcessProc; Data: Pointer);

  2602. var

  2603.   Context: TtsContext;

  2604. begin

  2605.   Context := gContext;

  2606. 

  2607.   if Context <> nil then begin

  2608.     if Context.ActiveFont <> nil then begin

  2609.       if Context.ActiveFont is TtsFontCreator then begin

  2610.         TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostCustom.Create(Context, PostProcessProc, Data));

  2611.       end else

  2612.         SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_CUSTOM);

  2613.     end else

  2614.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_CUSTOM);

  2615.   end else

  2616.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_CUSTOM);

  2617. end;

  2618. 

  2619. 

  2620. procedure tsPostDelete(PostIndex: tsInt);

  2621. var

  2622.   Context: TtsContext;

  2623. begin

  2624.   Context := gContext;

  2625. 

  2626.   if Context <> nil then begin

  2627.     if Context.ActiveFont <> nil then begin

  2628.       if Context.ActiveFont is TtsFontCreator then begin

  2629.         if PostIndex = TS_POST_INDEX_ALL then begin

  2630.           TtsFontCreator(Context.ActiveFont).ClearPostProcessSteps;

  2631.         end else

  2632. 

  2633.         begin

  2634.           // tranlate to direct index

  2635.           if PostIndex = TS_POST_INDEX_LAST then

  2636.             PostIndex := TtsFontCreator(Context.ActiveFont).PostProcessStepCount -1;

  2637. 

  2638.           TtsFontCreator(Context.ActiveFont).DeletePostProcessStep(PostIndex);

  2639.         end;

  2640.       end else

  2641.         SetError(TS_INVALID_OPERATION, TS_FUNC_POST_DELETE);

  2642.     end else

  2643.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_DELETE);

  2644.   end else

  2645.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_DELETE);

  2646. end;

  2647. 

  2648. 

  2649. procedure tsPostAddUsageRange(PostIndex: tsInt; UsageType: tsEnum; CharStart, CharEnd: WideChar);

  2650. var

  2651.   Context: TtsContext;

  2652.   ActFont: TtsFont;

  2653.   Usage: TtsFontProcessStepUsage;

  2654.   Idx: Integer;

  2655. 

  2656. 

  2657.   procedure AssignUsage(Idx: Integer);

  2658.   var

  2659.     PostProcess: TtsPostProcessStep;

  2660.   begin

  2661.     PostProcess := TtsFontCreator(ActFont).PostProcessStep[Idx];

  2662. 

  2663.     if PostProcess <> nil then begin

  2664.       PostProcess.AddUsageRange(Usage, CharStart, CharEnd);

  2665.     end else

  2666.       SetError(TS_INVALID_VALUE, TS_FUNC_POST_ADD_USAGE);

  2667.   end;

  2668. 

  2669. begin

  2670.   Context := gContext;

  2671. 

  2672.   if Context <> nil then begin

  2673.     ActFont := Context.ActiveFont;

  2674.     if ActFont <> nil then begin

  2675.       if ActFont is TtsFontCreator then begin

  2676.         // getting usagetype

  2677.         case UsageType of

  2678.           TS_POST_USAGE_INCLUDE:

  2679.             Usage := tsUInclude;

  2680.           TS_POST_USAGE_EXCLUDE:

  2681.             Usage := tsUExclude;

  2682.         else

  2683.           SetError(TS_INVALID_ENUM, TS_FUNC_POST_ADD_USAGE);

  2684.           Exit;

  2685.         end;

  2686. 

  2687.         // add usage to post processors

  2688.         if PostIndex = TS_POST_INDEX_ALL then begin

  2689.           for Idx := 0 to TtsFontCreator(ActFont).PostProcessStepCount -1 do

  2690.             AssignUsage(Idx);

  2691.         end else

  2692. 

  2693.         begin

  2694.           if PostIndex = TS_POST_INDEX_LAST then

  2695.             PostIndex := TtsFontCreator(ActFont).PostProcessStepCount -1;

  2696. 

  2697.           AssignUsage(PostIndex);

  2698.         end;

  2699.       end else

  2700.         SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_USAGE);

  2701.     end else

  2702.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_USAGE);

  2703.   end else

  2704.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_USAGE);

  2705. end;

  2706. 

  2707. 

  2708. procedure tsPostAddUsageChars(PostIndex: tsInt; UsageType: tsEnum; Chars: pWideChar);

  2709. var

  2710.   Context: TtsContext;

  2711.   ActFont: TtsFont;

  2712.   Usage: TtsFontProcessStepUsage;

  2713.   Idx: Integer;

  2714. 

  2715. 

  2716.   procedure AssignUsage(Idx: Integer);

  2717.   var

  2718.     PostProcess: TtsPostProcessStep;

  2719.   begin

  2720.     PostProcess := TtsFontCreator(ActFont).PostProcessStep[Idx];

  2721. 

  2722.     if PostProcess <> nil then begin

  2723.       PostProcess.AddUsageChars(Usage, Chars);

  2724.     end else

  2725.       SetError(TS_INVALID_VALUE, TS_FUNC_POST_ADD_USAGE);

  2726.   end;

  2727. 

  2728. begin

  2729.   Context := gContext;

  2730. 

  2731.   if Context <> nil then begin

  2732.     if Chars <> nil then begin

  2733.       ActFont := Context.ActiveFont;

  2734.       if ActFont <> nil then begin

  2735.         if ActFont is TtsFontCreator then begin

  2736.           // getting usagetype

  2737.           case UsageType of

  2738.             TS_POST_USAGE_INCLUDE:

  2739.               Usage := tsUInclude;

  2740.             TS_POST_USAGE_EXCLUDE:

  2741.               Usage := tsUExclude;

  2742.           else

  2743.             SetError(TS_INVALID_ENUM, TS_FUNC_POST_ADD_USAGE);

  2744.             Exit;

  2745.           end;

  2746. 

  2747.           // add usage to post processors

  2748.           if PostIndex = TS_POST_INDEX_ALL then begin

  2749.             for Idx := 0 to TtsFontCreator(ActFont).PostProcessStepCount -1 do

  2750.               AssignUsage(Idx);

  2751.           end else

  2752. 

  2753.           begin

  2754.             if PostIndex = TS_POST_INDEX_LAST then

  2755.               PostIndex := TtsFontCreator(ActFont).PostProcessStepCount -1;

  2756. 

  2757.             AssignUsage(PostIndex);

  2758.           end;

  2759.         end else

  2760.           SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_USAGE);

  2761.       end else

  2762.         SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_USAGE);

  2763.     end else

  2764.       SetError(TS_INVALID_VALUE, TS_FUNC_POST_ADD_USAGE);

  2765.   end else

  2766.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_USAGE);

  2767. end;

  2768. 

  2769. 

  2770. procedure tsPostClearUsage(PostIndex: tsInt); cdecl;

  2771. var

  2772.   Context: TtsContext;

  2773.   ActFont: TtsFont;

  2774.   Idx: Integer;

  2775. 

  2776. 

  2777.   procedure ClearUsage(Idx: Integer);

  2778.   var

  2779.     PostProcess: TtsPostProcessStep;

  2780.   begin

  2781.     PostProcess := TtsFontCreator(ActFont).PostProcessStep[Idx];

  2782. 

  2783.     if PostProcess <> nil then begin

  2784.       PostProcess.ClearIncludeRange;

  2785.       PostProcess.ClearExcludeRange;

  2786.     end else

  2787.       SetError(TS_INVALID_VALUE, TS_FUNC_POST_CLEAR_USAGE);

  2788.   end;

  2789. 

  2790. begin

  2791.   Context := gContext;

  2792. 

  2793.   if Context <> nil then begin

  2794.     ActFont := Context.ActiveFont;

  2795.     if ActFont <> nil then begin

  2796.       if ActFont is TtsFontCreator then begin

  2797.         if PostIndex = TS_POST_INDEX_ALL then begin

  2798.           for Idx := 0 to TtsFontCreator(ActFont).PostProcessStepCount -1 do

  2799.             ClearUsage(Idx);

  2800.         end else

  2801. 

  2802.         begin

  2803.           if PostIndex = TS_POST_INDEX_LAST then

  2804.             PostIndex := TtsFontCreator(ActFont).PostProcessStepCount -1;

  2805. 

  2806.           ClearUsage(PostIndex);

  2807.         end;

  2808.       end else

  2809.         SetError(TS_INVALID_OPERATION, TS_FUNC_POST_CLEAR_USAGE);

  2810.     end else

  2811.       SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_CLEAR_USAGE);

  2812.   end else

  2813.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_CLEAR_USAGE);

  2814. end;

  2815. 

  2816. 

  2817. function tsStringAnsiToWide(pText: pAnsiChar): pWideChar;

  2818. var

  2819.   Context: TtsContext;

  2820. begin

  2821.   Result := nil;

  2822. 

  2823.   if TextSuite_initialized then begin

  2824.     Context := gContext;

  2825. 

  2826.     try

  2827.       if Context <> nil then begin

  2828.         if pText <> nil then begin

  2829.           Result := Context.AnsiToWide(pText);

  2830. 

  2831.           if Result <> nil then begin

  2832.             gCriticalSection.Enter;

  2833.             try

  2834.               gStrings.Add(Result);

  2835.             finally

  2836.               gCriticalSection.Leave;

  2837.             end;

  2838.           end else

  2839.               SetError(TS_INVALID_OPERATION, TS_FUNC_STRING_ANSI_TO_WIDE);

  2840.         end else

  2841.           SetError(TS_INVALID_VALUE, TS_FUNC_STRING_ANSI_TO_WIDE);

  2842.       end else

  2843.         SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_STRING_ANSI_TO_WIDE);

  2844.     except

  2845.       on E: Exception do begin

  2846.         if E is EOutOfMemory then

  2847.           SetError(TS_OUT_OF_MEMORY, TS_FUNC_STRING_ANSI_TO_WIDE)

  2848.         else

  2849.           SetError(TS_ERROR, TS_FUNC_STRING_ANSI_TO_WIDE);

  2850.       end;

  2851.     end;

  2852.   end else

  2853.     SetError(TS_NOT_INITIALIZED, TS_FUNC_STRING_ANSI_TO_WIDE);

  2854. end;

  2855. 

  2856. 

  2857. function tsStringAlloc(Size: tsInt): pWideChar; cdecl;

  2858. begin

  2859.   Result := nil;

  2860. 

  2861.   if TextSuite_initialized then begin 

  2862.     try

  2863.       Result := tsStrAlloc(Size);

  2864. 

  2865.       gCriticalSection.Enter;

  2866.       try

  2867.         gStrings.Add(Result);

  2868.       finally

  2869.         gCriticalSection.Leave;

  2870.       end;

  2871.     except

  2872.       on E: Exception do begin

  2873.         if E is EOutOfMemory then

  2874.           SetError(TS_OUT_OF_MEMORY, TS_FUNC_STRING_ALLOC)

  2875.         else

  2876.           SetError(TS_ERROR, TS_FUNC_STRING_ALLOC);

  2877.       end;

  2878.     end;

  2879.   end else

  2880.     SetError(TS_NOT_INITIALIZED, TS_FUNC_STRING_ALLOC);

  2881. end;

  2882. 

  2883. 

  2884. procedure tsStringDispose(pText: pWideChar);

  2885. var

  2886.   ValidString: Boolean;

  2887. begin

  2888.   if TextSuite_initialized then begin 

  2889.     if pText <> nil then begin

  2890.       try

  2891.         // delete String from hash

  2892.         gCriticalSection.Enter;

  2893.         try

  2894.           ValidString := gStrings.Delete(pText);

  2895.         finally

  2896.           gCriticalSection.Leave;

  2897.         end;

  2898. 

  2899.         // if sting valid free them

  2900.         if ValidString then

  2901.           tsStrDispose(pText)

  2902.         else

  2903.           SetError(TS_INVALID_OPERATION, TS_FUNC_STRING_DISPOSE);

  2904.       except

  2905.         on E: Exception do begin

  2906.           if E is EAccessViolation then

  2907.             SetError(TS_INVALID_OPERATION, TS_FUNC_STRING_DISPOSE)

  2908.           else

  2909.             SetError(TS_ERROR, TS_FUNC_STRING_DISPOSE);

  2910.         end;

  2911.       end;

  2912.     end else

  2913.       SetError(TS_INVALID_VALUE, TS_FUNC_STRING_DISPOSE);

  2914.   end else

  2915.     SetError(TS_NOT_INITIALIZED, TS_FUNC_STRING_DISPOSE);

  2916. end;

  2917. 

  2918. 

  2919. procedure tsTextBeginBlock(Left, Top, Width, Height: tsInt; Flags: tsBitmask); 

  2920. var

  2921.   Context: TtsContext;

  2922. begin

  2923.   Context := gContext;

  2924. 

  2925.   if Context <> nil then begin

  2926.     if Context.Renderer <> nil then begin

  2927.       if not Context.IsLocked then begin

  2928.         Context.Renderer.BeginBlock(Left, Top, Width, Height, Flags);

  2929.       end else

  2930.         SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_BEGIN_BLOCK);

  2931.     end else

  2932.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_BEGIN_BLOCK);

  2933.   end else

  2934.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_BEGIN_BLOCK);

  2935. end;

  2936. 

  2937. 

  2938. procedure tsTextEndBlock; 

  2939. var

  2940.   Context: TtsContext;

  2941. begin

  2942.   Context := gContext;

  2943. 

  2944.   if Context <> nil then begin

  2945.     if Context.Renderer <> nil then begin

  2946.       if Context.IsLocked then begin

  2947.         Context.Renderer.EndBlock;

  2948.       end else

  2949.         SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_END_BLOCK);

  2950.     end else

  2951.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_END_BLOCK);

  2952.   end else

  2953.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_END_BLOCK);

  2954. end;

  2955. 

  2956. 

  2957. procedure tsTextColor3ub(Red, Green, Blue: tsByte);

  2958. begin

  2959.   tsTextColor4f(Red / $FF, Green / $FF, Blue / $FF, 1);

  2960. end;

  2961. 

  2962. 

  2963. procedure tsTextColor3f(Red, Green, Blue: tsFloat);

  2964. begin

  2965.   tsTextColor4f(Red, Green, Blue, 1);

  2966. end;

  2967. 

  2968. 

  2969. procedure tsTextColor4ub(Red, Green, Blue, Alpha: tsByte);

  2970. begin

  2971.   tsTextColor4f(Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF);

  2972. end;

  2973. 

  2974. 

  2975. procedure tsTextColor4f(Red, Green, Blue, Alpha: tsFloat);

  2976. var

  2977.   Context: TtsContext;

  2978. begin

  2979.   Context := gContext;

  2980. 

  2981.   if Context <> nil then begin

  2982.     if Context.Renderer <> nil then begin

  2983.       Context.Renderer.Color(Red, Green, Blue, Alpha);

  2984.     end else

  2985.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_COLOR);

  2986.   end else

  2987.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_COLOR);

  2988. end;

  2989. 

  2990. 

  2991. procedure tsTextOutA(pText: pAnsiChar);

  2992. var

  2993.   pTemp: PWideChar;

  2994.   Context: TtsContext;

  2995. begin

  2996.   Context := gContext;

  2997. 

  2998.   if Context <> nil then begin

  2999.     if Context.Renderer <> nil then begin

  3000.       if Context.ActiveFont <> nil then begin

  3001.         if pText <> nil then begin

  3002.           // convert text via codepage

  3003.           pTemp := Context.AnsiToWide(pText);

  3004.           if pTemp <> nil then begin

  3005.             try

  3006.               Context.Renderer.TextOut(pTemp);

  3007.             finally

  3008.               tsStrDispose(pTemp);

  3009.             end;

  3010.           end else

  3011.             SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_OUT);

  3012.         end else

  3013.           SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_OUT);

  3014.       end else

  3015.         SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_OUT);

  3016.     end else

  3017.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_OUT);

  3018.   end else

  3019.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_OUT);

  3020. end;

  3021. 

  3022. 

  3023. procedure tsTextOutW(pText: pWideChar);

  3024. var

  3025.   Context: TtsContext;

  3026. begin

  3027.   Context := gContext;

  3028. 

  3029.   if Context <> nil then begin

  3030.     if Context.Renderer <> nil then begin

  3031.       if Context.ActiveFont <> nil then begin

  3032.         if pText <> nil then begin

  3033.           Context.Renderer.TextOut(pText);

  3034.         end else

  3035.           SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_OUT);

  3036.       end else

  3037.         SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_OUT);

  3038.     end else

  3039.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_OUT);

  3040.   end else

  3041.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_OUT);

  3042. end;

  3043. 

  3044. 

  3045. function tsTextGetWidthA(pText: pAnsiChar): tsInt;

  3046. var

  3047.   pTemp: PWideChar;

  3048.   Context: TtsContext;

  3049. begin

  3050.   Result := 0;

  3051.   Context := gContext;

  3052. 

  3053.   if Context <> nil then begin

  3054.     pTemp := nil;

  3055. 

  3056.     // if pText is assigned convert it

  3057.     if pText <> nil then begin

  3058.       pTemp := Context.AnsiToWide(pText);

  3059. 

  3060.       if pTemp = nil then begin

  3061.         SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_GET_WIDTH);

  3062.         Exit;

  3063.       end;

  3064.     end;

  3065. 

  3066.     try

  3067.       Result := tsTextGetWidthW(pTemp);

  3068.     finally

  3069.       if pTemp <> nil then

  3070.         tsStrDispose(pTemp);

  3071.     end;

  3072.   end else

  3073.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_GET_WIDTH);

  3074. end;

  3075. 

  3076. 

  3077. function tsTextGetWidthW(pText: pWideChar): tsInt;

  3078. var

  3079.   Context: TtsContext;

  3080. begin

  3081.   Result := 0;

  3082. 

  3083.   Context := gContext;

  3084. 

  3085.   if Context <> nil then begin

  3086.     if Context.Renderer <> nil then begin

  3087.       // Width from the text

  3088.       if pText <> nil then begin

  3089.         if Context.ActiveFont <> nil then begin

  3090.           Result := Context.Renderer.TextGetWidth(pText);

  3091.         end else

  3092.           SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_GET_WIDTH);

  3093.       end else

  3094. 

  3095.       // Width from blockmode

  3096.       begin

  3097.         if Context.IsLocked then begin

  3098.           Result := Context.Renderer.TextGetDrawWidth;

  3099.         end else

  3100.           SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_GET_WIDTH);

  3101.       end;

  3102.     end else

  3103.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_GET_WIDTH);

  3104.   end else

  3105.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_GET_WIDTH);

  3106. end;

  3107. 

  3108. 

  3109. function tsTextGetHeightA(pText: pAnsiChar): tsInt;

  3110. var

  3111.   pTemp: PWideChar;

  3112.   Context: TtsContext;

  3113. begin

  3114.   Result := 0;

  3115.   Context := gContext;

  3116. 

  3117.   if Context <> nil then begin

  3118.     pTemp := nil;

  3119. 

  3120.     // if pText is assigned convert it

  3121.     if pText <> nil then begin

  3122.       pTemp := Context.AnsiToWide(pText);

  3123. 

  3124.       if pTemp = nil then begin      

  3125.         SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_GET_WIDTH);

  3126.         Exit;

  3127.       end;

  3128.     end;

  3129. 

  3130.     try

  3131.       Result := tsTextGetHeightW(pTemp);

  3132.     finally

  3133.       if pTemp <> nil then

  3134.         tsStrDispose(pTemp);

  3135.     end;

  3136.   end else

  3137.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_GET_WIDTH);

  3138. end;

  3139. 

  3140. 

  3141. function tsTextGetHeightW(pText: pWideChar): tsInt; 

  3142. var

  3143.   Context: TtsContext;

  3144. begin

  3145.   Result := 0;

  3146. 

  3147.   Context := gContext;

  3148. 

  3149.   if Context <> nil then begin

  3150.     if Context.Renderer <> nil then begin

  3151.       // Height from the text

  3152.       if pText <> nil then begin

  3153.         if Context.ActiveFont <> nil then begin

  3154.           with Context.ActiveFont do

  3155.             Result := Ascent + Descent + ExternalLeading;

  3156.         end else

  3157.           SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_GET_HEIGHT);

  3158.       end else

  3159. 

  3160.       // Height from blockmode

  3161.       begin

  3162.         if Context.IsLocked then begin

  3163.           Result := Context.Renderer.TextGetDrawHeight;

  3164.         end else

  3165.           SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_GET_HEIGHT);

  3166.       end;

  3167.     end else

  3168.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_GET_HEIGHT);

  3169.   end else

  3170.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_GET_HEIGHT);

  3171. end;

  3172. 

  3173. 

  3174. procedure tsCharOutW(CharCode: WideChar); cdecl;

  3175. var

  3176.   Context: TtsContext;

  3177. begin

  3178.   Context := gContext;

  3179. 

  3180.   if Context <> nil then begin

  3181.     if Context.Renderer <> nil then begin

  3182.       if not Context.IsLocked then begin

  3183.         if Context.Renderer.ActiveFont <> nil then begin

  3184.           if Context.Renderer.ActiveFont.Char[CharCode] <> nil then begin

  3185.             Context.Renderer.CharOut(CharCode);

  3186.           end else

  3187.             SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_OUT);

  3188.         end else

  3189.           SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_OUT);

  3190.       end else

  3191.         SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_OUT);

  3192.     end else

  3193.       SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_OUT);

  3194.   end else

  3195.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_OUT);

  3196. end;

  3197. 

  3198. 

  3199. // *** image functions ***

  3200. procedure tsImageCreate(pImageID: ptsImageID);

  3201. var

  3202.   Context: TtsContext;

  3203.   Image: TtsImage;

  3204. begin

  3205.   Context := gContext;

  3206. 

  3207.   if Context <> nil then begin

  3208.     if pImageID <> nil then begin

  3209.       // create image

  3210.       try

  3211.         Image := TtsImage.Create;

  3212.       except

  3213.         on E: Exception do begin

  3214.           if E is EOutOfMemory then

  3215.             SetError(TS_OUT_OF_MEMORY, TS_FUNC_IMAGE_CREATE)

  3216.           else

  3217.             SetError(TS_ERROR, TS_FUNC_IMAGE_CREATE);

  3218.           Exit;

  3219.         end;

  3220.       end;

  3221. 

  3222.       // add image

  3223.       pImageID^ := Context.ImageAdd(Image);

  3224.     end else

  3225.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_CREATE);

  3226.   end else

  3227.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_CREATE);

  3228. end;

  3229. 

  3230. 

  3231. procedure tsImageDestroy(ImageID: tsImageID);

  3232. var

  3233.   Context: TtsContext;

  3234.   Image: TtsImage;

  3235. begin

  3236.   Context := gContext;

  3237.   

  3238.   if Context <> nil then begin

  3239.     Image := Context.ImageGet(ImageID);

  3240. 

  3241.     if Image <> nil then begin

  3242.       Context.ImageDelete(ImageID);

  3243. 

  3244.       Image.Free;

  3245.     end else

  3246.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_DESTROY);

  3247.   end else

  3248.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_DESTROY);

  3249. end;

  3250. 

  3251. 

  3252. procedure tsImageLoadA(ImageID: tsImageID; Filename: pAnsiChar);

  3253. var

  3254.   Context: TtsContext;

  3255.   Image: TtsImage;

  3256. begin

  3257.   Context := gContext;

  3258. 

  3259.   if Context <> nil then begin

  3260.     case gContext.gImageLibrary of

  3261.       // SDL_image

  3262.       TS_IMAGE_LIBRARY_SDL:

  3263.         begin

  3264.           if SDL_IMAGE_initialized then begin

  3265.             Image := Context.ImageGet(ImageID);

  3266. 

  3267.             if Image <> nil then begin

  3268.               try

  3269.                 Image.LoadFromFile(Filename);

  3270.               except

  3271.                 on E: Exception do begin

  3272.                   if E is EOutOfMemory then

  3273.                     SetError(TS_OUT_OF_MEMORY, TS_FUNC_IMAGE_LOAD)

  3274.                   else

  3275.                     SetError(TS_ERROR, TS_FUNC_IMAGE_LOAD);

  3276.                 end;

  3277.               end;

  3278.             end else

  3279.               SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_LOAD);

  3280.           end else

  3281.             SetError(TS_NOT_INITIALIZED, TS_FUNC_IMAGE_LOAD);

  3282.         end;

  3283.     else

  3284.       SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_LOAD);

  3285.     end;

  3286.   end else

  3287.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_LOAD);

  3288. end;

  3289. 

  3290. 

  3291. procedure tsImageAssignFrom(ImageID: tsImageID; FromImageID: tsImageID);

  3292. var

  3293.   Context: TtsContext;

  3294.   Image, ImageFrom: TtsImage;

  3295. begin

  3296.   Context := gContext;

  3297. 

  3298.   if Context <> nil then begin

  3299.     Image := Context.ImageGet(ImageID);

  3300.     ImageFrom := Context.ImageGet(FromImageID);

  3301. 

  3302.     if (Image <> nil) and (ImageFrom <> nil) then begin

  3303.       if not ImageFrom.Empty then begin

  3304.         try

  3305.           Image.AssignFrom(ImageFrom)

  3306.         except

  3307.           on E: Exception do begin

  3308.             if E is EOutOfMemory then

  3309.               SetError(TS_OUT_OF_MEMORY, TS_FUNC_IMAGE_ASSIGN_FROM)

  3310.             else

  3311.               SetError(TS_ERROR, TS_FUNC_IMAGE_ASSIGN_FROM);

  3312.             Exit;

  3313.           end;

  3314.         end;

  3315.       end else

  3316.         SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_ASSIGN_FROM);

  3317.     end else

  3318.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_ASSIGN_FROM);

  3319.   end else

  3320.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_ASSIGN_FROM);

  3321. end;

  3322. 

  3323. 

  3324. procedure tsImageNew(ImageID: tsImageID; Width: tsInt; Height: tsInt; Format: tsEnum);

  3325. var

  3326.   Context: TtsContext;

  3327.   Image: TtsImage;

  3328.   ImageFormat: TtsFormat;

  3329. begin

  3330.   Context := gContext;

  3331. 

  3332.   if Context <> nil then begin

  3333.     Image := Context.ImageGet(ImageID);

  3334. 

  3335.     if Image <> nil then begin

  3336.       // format

  3337.       if Format = TS_DEFAULT then

  3338.         Format := Context.gGlobalFormat;

  3339. 

  3340.       case Format of

  3341.         TS_FORMAT_RGBA8:

  3342.           ImageFormat := tsFormatRGBA8;

  3343.       else

  3344.         SetError(TS_INVALID_ENUM, TS_FUNC_IMAGE_NEW);

  3345. 

  3346.         // leave the function

  3347.         Exit;

  3348.       end;

  3349. 

  3350.       if (Width > 0) and (Height > 0) then begin

  3351.         try

  3352.           Image.CreateEmpty(ImageFormat, Width, Height);

  3353.         except

  3354.           on E: Exception do begin

  3355.             if E is EOutOfMemory then

  3356.               SetError(TS_OUT_OF_MEMORY, TS_FUNC_IMAGE_NEW)

  3357.             else

  3358.               SetError(TS_ERROR, TS_FUNC_IMAGE_NEW);

  3359.           end;

  3360.         end;

  3361.       end else

  3362.         SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_NEW);

  3363.     end else

  3364.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_NEW);

  3365.   end else

  3366.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_NEW);

  3367. end;

  3368. 

  3369. 

  3370. procedure tsImageGetInfo(ImageID: tsImageID; pisEmpty: ptsBool; pWidth: ptsInt; pHeight: ptsInt; pFormat: ptsEnum; pData: PPointer);

  3371. var

  3372.   Context: TtsContext;

  3373.   Image: TtsImage;

  3374. begin

  3375.   Context := gContext;

  3376. 

  3377.   // defaults

  3378.   if pisEmpty <> nil then

  3379.     pisEmpty^ := TS_FALSE;

  3380. 

  3381.   if pWidth <> nil then

  3382.     pWidth^ := 0;

  3383. 

  3384.   if pHeight <> nil then

  3385.     pHeight^ := 0;

  3386. 

  3387.   if pFormat <> nil then

  3388.     pFormat^ := TS_FORMAT_EMPTY;

  3389. 

  3390.   if pData <> nil then

  3391.     pData^ := nil;

  3392. 

  3393.   // query values

  3394.   if Context <> nil then begin

  3395.     Image := Context.ImageGet(ImageID);

  3396. 

  3397.     if Image <> nil then begin

  3398.       // isEmpty

  3399.       if pisEmpty <> nil then

  3400.         if Image.Empty then

  3401.           pisEmpty^ := TS_TRUE

  3402.         else

  3403.           pisEmpty^ := TS_FALSE;

  3404. 

  3405.       // Width

  3406.       if pWidth <> nil then

  3407.         pWidth^ := Image.Width;

  3408. 

  3409.       // Height

  3410.       if pHeight <> nil then

  3411.         pHeight^ := Image.Height;

  3412. 

  3413.       // Format

  3414.       if pFormat <> nil then begin

  3415.         case Image.Format of

  3416.           tsFormatEmpty:

  3417.             pFormat^ := TS_FORMAT_EMPTY;

  3418.           tsFormatRGBA8:

  3419.             pFormat^ := TS_FORMAT_RGBA8;

  3420.         end;

  3421.       end;

  3422. 

  3423.       // Data

  3424.       if pData <> nil then

  3425.         pData^ := Image.Data;

  3426.     end else

  3427.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_GET_INFO);

  3428.   end else

  3429.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_GET_INFO);

  3430. end;

  3431. 

  3432. 

  3433. function tsImageGetIsEmpty(ImageID: tsImageID): tsBool;

  3434. begin

  3435.   tsImageGetInfo(ImageID, @Result, nil, nil, nil, nil);

  3436. end;

  3437. 

  3438. 

  3439. function tsImageGetWidth(ImageID: tsImageID): tsInt;

  3440. begin

  3441.   tsImageGetInfo(ImageID, nil, @Result, nil, nil, nil);

  3442. end;

  3443. 

  3444. 

  3445. function tsImageGetHeight(ImageID: tsImageID): tsInt;

  3446. begin

  3447.   tsImageGetInfo(ImageID, nil, nil, @Result, nil, nil);

  3448. end;

  3449. 

  3450. 

  3451. function tsImageGetFormat(ImageID: tsImageID): tsEnum;

  3452. begin

  3453.   tsImageGetInfo(ImageID, nil, nil, nil, @Result, nil);

  3454. end;

  3455. 

  3456. 

  3457. function tsImageGetData(ImageID: tsImageID): Pointer;

  3458. begin

  3459.   tsImageGetInfo(ImageID, nil, nil, nil, nil, @Result);

  3460. end;

  3461. 

  3462. 

  3463. function tsImageScanline(ImageID: tsImageID; ScanLine: tsInt): Pointer;

  3464. var

  3465.   Context: TtsContext;

  3466.   Image: TtsImage;

  3467. begin

  3468.   Result := nil;

  3469. 

  3470.   Context := gContext;

  3471. 

  3472.   if Context <> nil then begin

  3473.     Image := Context.ImageGet(ImageID);

  3474. 

  3475.     if Image <> nil then begin

  3476.       if not Image.Empty then begin      

  3477.         Result := Image.ScanLine[ScanLine];

  3478.       end else

  3479.         SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_SCANLINE);

  3480.     end else

  3481.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_SCANLINE);

  3482.   end else

  3483.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_SCANLINE);

  3484. end;

  3485. 

  3486. 

  3487. procedure tsImageResize(ImageID: tsImageID; Width, Height, X, Y: tsInt);

  3488. var

  3489.   Context: TtsContext;

  3490.   Image: TtsImage;

  3491. begin

  3492.   Context := gContext;

  3493. 

  3494.   if Context <> nil then begin

  3495.     Image := Context.ImageGet(ImageID);

  3496. 

  3497.     if Image <> nil then begin

  3498.       if not Image.Empty then begin

  3499.         Image.Resize(Width, Height, X, Y);

  3500.       end else

  3501.         SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_RESIZE);

  3502.     end else

  3503.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_RESIZE);

  3504.   end else

  3505.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_RESIZE);

  3506. end;

  3507. 

  3508. 

  3509. procedure tsImageBlend(ImageID, OverImageID: tsImageID; X, Y: tsInt; AutoExpand: tsBool);

  3510. var

  3511.   Context: TtsContext;

  3512.   Image, ImageOver: TtsImage;

  3513. begin

  3514.   Context := gContext;

  3515. 

  3516.   if Context <> nil then begin

  3517.     Image := Context.ImageGet(ImageID);

  3518.     ImageOver := Context.ImageGet(OverImageID);

  3519. 

  3520.     if (Image <> nil) and (ImageOver <> nil) then begin

  3521.       if (not Image.Empty) and (not ImageOver.Empty) then begin

  3522.         Image.BlendImage(ImageOver, X, Y, AutoExpand = TS_TRUE);

  3523.       end else

  3524.         SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_BLEND);

  3525.     end else

  3526.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_BLEND);

  3527.   end else

  3528.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_BLEND);

  3529. end;

  3530. 

  3531. 

  3532. procedure tsImageBlur(ImageID: tsImageID; X, Y: tsFloat; ChannelMask: tsBitmask; AutoExpand: tsBool; ExpandSizeX, ExpandSizeY: ptsInt);

  3533. var

  3534.   Context: TtsContext;

  3535.   Image: TtsImage;

  3536. 

  3537.   HorzKernel, VertKernel: TtsKernel1D;

  3538. begin

  3539.   Context := gContext;

  3540. 

  3541.   if Context <> nil then begin

  3542.     Image := Context.ImageGet(ImageID);

  3543. 

  3544.     if Image <> nil then begin

  3545.       if not Image.Empty then begin

  3546.         // Creating kernels

  3547.         HorzKernel := TtsKernel1D.Create(X, 0);

  3548.         VertKernel := TtsKernel1D.Create(Y, 0);

  3549. 

  3550.         if AutoExpand = TS_TRUE then begin

  3551.           // resizing image

  3552.           Image.Resize(Image.Width + HorzKernel.Size * 2, Image.Height + VertKernel.Size * 2, HorzKernel.Size, VertKernel.Size);

  3553. 

  3554.           if ExpandSizeX <> nil then

  3555.             ExpandSizeX^ := HorzKernel.Size;

  3556. 

  3557.           if ExpandSizeY <> nil then

  3558.             ExpandSizeY^ := VertKernel.Size

  3559.         end else

  3560. 

  3561.         begin

  3562.           if ExpandSizeX <> nil then

  3563.             ExpandSizeX^ := 0;

  3564. 

  3565.           if ExpandSizeY <> nil then

  3566.             ExpandSizeY^ := 0;

  3567.         end;

  3568. 

  3569.         // bluring image

  3570.         Image.Blur(HorzKernel, VertKernel, ChannelMask);

  3571. 

  3572.         // freeing

  3573.         HorzKernel.Free;

  3574.         VertKernel.Free;

  3575.       end else

  3576.         SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_BLUR);

  3577.     end else

  3578.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_BLUR);

  3579.   end else

  3580.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_BLUR);

  3581. end;

  3582. 

  3583. 

  3584. procedure tsImageFillColor3ub(ImageID: tsImageID; Red, Green, Blue: tsByte; ChannelMask: tsBitmask);

  3585. begin

  3586.   tsImageFillColor4f(ImageID, Red / $FF, Green / $FF, Blue / $FF, 1, ChannelMask);

  3587. end;

  3588. 

  3589. 

  3590. procedure tsImageFillColor3f(ImageID: tsImageID; Red, Green, Blue: tsFloat; ChannelMask: tsBitmask);

  3591. begin

  3592.   tsImageFillColor4f(ImageID, Red, Green, Blue, 1, ChannelMask);

  3593. end;

  3594. 

  3595. 

  3596. procedure tsImageFillColor4ub(ImageID: tsImageID; Red, Green, Blue, Alpha: tsByte; ChannelMask: tsBitmask);

  3597. begin

  3598.   tsImageFillColor4f(ImageID, Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF, ChannelMask);

  3599. end;

  3600. 

  3601. 

  3602. procedure tsImageFillColor4f(ImageID: tsImageID; Red, Green, Blue, Alpha: tsFloat; ChannelMask: tsBitmask);

  3603. var

  3604.   Context: TtsContext;

  3605.   Image: TtsImage;

  3606. begin

  3607.   Context := gContext;

  3608. 

  3609.   if Context <> nil then begin

  3610.     Image := Context.ImageGet(ImageID);

  3611. 

  3612.     if Image <> nil then begin

  3613.       if not Image.Empty then begin

  3614.         Image.FillColor(Red, Green, Blue, Alpha, ChannelMask, Context.gImageMode);

  3615.       end else

  3616.         SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_FILL_COLOR);

  3617.     end else

  3618.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_FILL_COLOR);

  3619.   end else

  3620.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_FILL_COLOR);

  3621. end;

  3622. 

  3623. 

  3624. procedure tsImageFillPattern(ImageID, PatternImageID: tsImageID; X, Y: tsInt; ChannelMask: tsBitmask);

  3625. var

  3626.   Context: TtsContext;

  3627.   Image, ImagePattern: TtsImage;

  3628. begin

  3629.   Context := gContext;

  3630. 

  3631.   if Context <> nil then begin

  3632.     Image := Context.ImageGet(ImageID);

  3633.     ImagePattern := Context.ImageGet(PatternImageID);

  3634. 

  3635.     if (Image <> nil) and (ImagePattern <> nil) then begin

  3636.       if (not Image.Empty) and (not ImagePattern.Empty) then begin

  3637.         Image.FillPattern(ImagePattern, X, Y, ChannelMask, Context.gImageMode);

  3638.       end else

  3639.         SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_FILL_PATTERN);

  3640.     end else

  3641.       SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_FILL_PATTERN);

  3642.   end else

  3643.     SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_FILL_PATTERN);

  3644. end;

  3645. 

  3646. 

  3647. {$endif}

  3648. 

  3649. 

  3650. end.