opengl
/
TextSuite
1
0
複製 0
程式碼 問題 0 合併請求 0 版本發佈 0 Wiki 活動
瀏覽代碼

* initial commit

master
Bergmann89 11 年之前
當前提交
a226a7e15b
共有 24 個檔案被更改，包括 15789 行新增 和 0 行删除
分割檢視
Diff Options
Show Stats Download Patch File Download Diff File
  1. +2
    -0
      .gitignore
  2. 二進制
     
  3. +119
    -0
      TextSuiteTest.lpi
  4. +21
    -0
      TextSuiteTest.lpr
  5. +350
    -0
      TextSuiteTest.lps
  6. 二進制
     
  7. +2531
    -0
      new/utsTextSuite.pas
  8. +3650
    -0
      old/TextSuite.pas
  9. +143
    -0
      old/TextSuiteCPUUtils.pas
  10. +5762
    -0
      old/TextSuiteClasses.pas
  11. +867
    -0
      old/TextSuiteImports.pas
  12. +46
    -0
      old/TextSuiteOptions.inc
  13. +398
    -0
      old/TextSuitePostProcess.pas
  14. +367
    -0
      old/TextSuiteTTFUtils.pas
  15. +13
    -0
      old/TextSuiteVersion.pas
  16. +1394
    -0
      old/TextSuiteWideUtils.pas
  17. 二進制
     
  18. 二進制
     
  19. 二進制
     
  20. 二進制
     
  21. 二進制
     
  22. 二進制
     
  23. +14
    -0
      uMainForm.lfm
  24. +112
    -0
      uMainForm.pas

+ 2
- 0
.gitignore 查看文件

@@ -0,0 +1,2 @@
*.exe
lib/

二進制
查看文件


+ 119
- 0
TextSuiteTest.lpi 查看文件

@@ -0,0 +1,119 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="TextSuiteTest"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="10">
<Unit0>
<Filename Value="TextSuiteTest.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
</Unit1>
<Unit2>
<Filename Value="new\utsTextSuite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="utsTextSuite"/>
</Unit2>
<Unit3>
<Filename Value="old\TextSuite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TextSuite"/>
</Unit3>
<Unit4>
<Filename Value="old\TextSuiteImports.pas"/>
<IsPartOfProject Value="True"/>
</Unit4>
<Unit5>
<Filename Value="old\TextSuiteWideUtils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TextSuiteWideUtils"/>
</Unit5>
<Unit6>
<Filename Value="old\TextSuiteClasses.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TextSuiteClasses"/>
</Unit6>
<Unit7>
<Filename Value="old\TextSuitePostProcess.pas"/>
<IsPartOfProject Value="True"/>
</Unit7>
<Unit8>
<Filename Value="old\TextSuiteTTFUtils.pas"/>
<IsPartOfProject Value="True"/>
</Unit8>
<Unit9>
<Filename Value="old\TextSuiteVersion.pas"/>
<IsPartOfProject Value="True"/>
</Unit9>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="TextSuiteTest"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);old"/>
<OtherUnitFiles Value="old;..\bitSpace\_projects\MassiveUniverseOnline\bitSpaceEngine\src\OpenGLCore;new"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

+ 21
- 0
TextSuiteTest.lpr 查看文件

@@ -0,0 +1,21 @@
program TextSuiteTest;

{$mode objfpc}{$H+}

uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, uMainForm, TextSuite, TextSuiteClasses, TextSuiteImports, TextSuitePostProcess,
TextSuiteTTFUtils, TextSuiteVersion, TextSuiteWideUtils, utsTextSuite;

{$R *.res}

begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.


+ 350
- 0
TextSuiteTest.lps 查看文件

@@ -0,0 +1,350 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="19">
<Unit0>
<Filename Value="TextSuiteTest.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos X="45" Y="17"/>
<UsageCount Value="60"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
<TopLine Value="79"/>
<CursorPos Y="97"/>
<UsageCount Value="60"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="new\utsTextSuite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="utsTextSuite"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="2"/>
<TopLine Value="1988"/>
<CursorPos X="22" Y="2002"/>
<UsageCount Value="59"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="old\TextSuite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TextSuite"/>
<EditorIndex Value="1"/>
<WindowIndex Value="1"/>
<TopLine Value="207"/>
<CursorPos X="3" Y="223"/>
<ExtraEditorCount Value="1"/>
<ExtraEditor1>
<EditorIndex Value="-1"/>
<TopLine Value="232"/>
<CursorPos X="3" Y="302"/>
</ExtraEditor1>
<UsageCount Value="54"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="old\TextSuiteImports.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="662"/>
<CursorPos X="3" Y="664"/>
<UsageCount Value="54"/>
</Unit4>
<Unit5>
<Filename Value="old\TextSuiteWideUtils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TextSuiteWideUtils"/>
<EditorIndex Value="2"/>
<WindowIndex Value="1"/>
<TopLine Value="1243"/>
<CursorPos X="18" Y="1257"/>
<UsageCount Value="54"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="old\TextSuiteClasses.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TextSuiteClasses"/>
<IsVisibleTab Value="True"/>
<WindowIndex Value="1"/>
<TopLine Value="4487"/>
<CursorPos X="28" Y="4439"/>
<UsageCount Value="54"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="old\TextSuitePostProcess.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="163"/>
<CursorPos X="61" Y="141"/>
<UsageCount Value="54"/>
</Unit7>
<Unit8>
<Filename Value="old\TextSuiteTTFUtils.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="54"/>
</Unit8>
<Unit9>
<Filename Value="old\TextSuiteVersion.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="54"/>
</Unit9>
<Unit10>
<Filename Value="..\bitSpace\_projects\MassiveUniverseOnline\bitSpaceEngine\src\OpenGLCore\uglcTypes.pas"/>
<UnitName Value="uglcTypes"/>
<EditorIndex Value="1"/>
<TopLine Value="264"/>
<CursorPos X="3" Y="273"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="..\bitSpace\_projects\MassiveUniverseOnline\bitSpaceEngine\src\OpenGLCore\dglOpenGL.pas"/>
<UnitName Value="dglOpenGL"/>
<EditorIndex Value="5"/>
<TopLine Value="11398"/>
<CursorPos X="3" Y="11232"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="new\uglctextsuite.pas"/>
<EditorIndex Value="-1"/>
<CursorPos X="3" Y="13"/>
<UsageCount Value="15"/>
</Unit12>
<Unit13>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\2.7.1\source\rtl\inc\ustringh.inc"/>
<EditorIndex Value="4"/>
<TopLine Value="110"/>
<CursorPos X="10" Y="126"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\2.7.1\source\rtl\inc\ustrings.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1819"/>
<CursorPos X="37" Y="2066"/>
<UsageCount Value="6"/>
</Unit14>
<Unit15>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\2.7.1\source\rtl\inc\systemh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="756"/>
<CursorPos X="32" Y="774"/>
<UsageCount Value="27"/>
</Unit15>
<Unit16>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\2.7.1\source\rtl\inc\heaph.inc"/>
<EditorIndex Value="3"/>
<TopLine Value="69"/>
<CursorPos X="10" Y="94"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit16>
<Unit17>
<Filename Value="old\TextSuiteCPUUtils.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<CursorPos X="23" Y="20"/>
<UsageCount Value="18"/>
</Unit17>
<Unit18>
<Filename Value="..\glBitmap\glBitmap\glBitmap.pas"/>
<EditorIndex Value="-1"/>
<CursorPos X="14" Y="14"/>
<UsageCount Value="6"/>
</Unit18>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1979" TopLine="1967"/>
</Position1>
<Position2>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1980" TopLine="1967"/>
</Position2>
<Position3>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1981" TopLine="1967"/>
</Position3>
<Position4>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1982" TopLine="1967"/>
</Position4>
<Position5>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1983" TopLine="1967"/>
</Position5>
<Position6>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1984" TopLine="1967"/>
</Position6>
<Position7>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1987" TopLine="1967"/>
</Position7>
<Position8>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2032" TopLine="2015"/>
</Position8>
<Position9>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2037" TopLine="2015"/>
</Position9>
<Position10>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1970" TopLine="1954"/>
</Position10>
<Position11>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1973" TopLine="1954"/>
</Position11>
<Position12>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1974" TopLine="1954"/>
</Position12>
<Position13>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1975" TopLine="1967"/>
</Position13>
<Position14>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1977" TopLine="1967"/>
</Position14>
<Position15>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1991" TopLine="1967"/>
</Position15>
<Position16>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1995" TopLine="2008"/>
</Position16>
<Position17>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1997" TopLine="1982"/>
</Position17>
<Position18>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2008" TopLine="1982"/>
</Position18>
<Position19>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2054" TopLine="2037"/>
</Position19>
<Position20>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2032" TopLine="2016"/>
</Position20>
<Position21>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2037" Column="36" TopLine="2013"/>
</Position21>
<Position22>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2011" TopLine="1995"/>
</Position22>
<Position23>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2032" TopLine="2016"/>
</Position23>
<Position24>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1991" Column="51" TopLine="2005"/>
</Position24>
<Position25>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2011" TopLine="2006"/>
</Position25>
<Position26>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2034" TopLine="2012"/>
</Position26>
<Position27>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2035" TopLine="2012"/>
</Position27>
<Position28>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2051" TopLine="2035"/>
</Position28>
<Position29>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="1993" Column="28" TopLine="1991"/>
</Position29>
<Position30>
<Filename Value="new\utsTextSuite.pas"/>
<Caret Line="2011" TopLine="1990"/>
</Position30>
</JumpHistory>
</ProjectSession>
<Debugging>
<BreakPoints Count="4">
<Item1>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="new\utsTextSuite.pas"/>
<Line Value="2011"/>
</Item1>
<Item2>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="new\utsTextSuite.pas"/>
<Line Value="2058"/>
</Item2>
<Item3>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="new\utsTextSuite.pas"/>
<Line Value="2037"/>
</Item3>
<Item4>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="new\utsTextSuite.pas"/>
<Line Value="1991"/>
</Item4>
</BreakPoints>
<Watches Count="4">
<Item1>
<Expression Value="Text"/>
</Item1>
<Item2>
<Expression Value="p^.Text"/>
</Item2>
<Item3>
<Expression Value="TextBegin"/>
</Item3>
<Item4>
<Expression Value="aText"/>
</Item4>
</Watches>
</Debugging>
</CONFIG>

二進制
查看文件


+ 2531
- 0
new/utsTextSuite.pas
文件差異過大導致無法顯示
查看文件


+ 3650
- 0
old/TextSuite.pas
文件差異過大導致無法顯示
查看文件


+ 143
- 0
old/TextSuiteCPUUtils.pas 查看文件

@@ -0,0 +1,143 @@
{
TextSuite (C) Steffen Xonna (aka Lossy eX)
http://www.opengl24.de/
-----------------------------------------------------------------------
For copyright informations see file copyright.txt.
}

{$I TextSuiteOptions.inc}

unit TextSuiteCPUUtils;

{$ifdef TS_PURE_PASCAL}
{$message fatal 'This unit is''t compatible to the flag TS_PURE_PASCAL.'}
{$endif}

interface


var
supportFPU,
supportCMOV,
supportMMX,
supportMMX_EXT,
supportSSE,
supportSSE2,
support3DNow,
support3DNow_EXT,
supportSSE3,
supportSSSE3
: ByteBool;


procedure ReadCPUFlags;

function GetSSESafeMem(Size: Cardinal): Pointer;
function GetSSESafeAddr(Addr: Pointer): Pointer;


implementation


const
BIT_FPU = 1 shl 0;
BIT_CMOV = 1 shl 15;
BIT_MMX = 1 shl 23;
BIT_SSE = 1 shl 25;
BIT_SSE2 = 1 shl 26;
BIT_3DNOW_EXT = 1 shl 30;
BIT_3DNOW = 1 shl 31;

BIT_SSE3 = 1 shl 0;
BIT_SSSE3 = 1 shl 9;


procedure ReadCPUFlags;
asm
pushfd
pop eax // copy EEFlags to eax
mov edx, eax // copy to edx

xor eax, $00200000 // clear bit 21
push eax
popfd // restore to EEFlags

pushfd
pop eax // copy EEFlags to eax
xor eax, edx // test if flags hav changed
jnz @@supportCPUID

ret

@@supportCPUID:

push ebx // save ebx

mov eax, 1 // function 1
cpuid

// test flags
test edx, BIT_FPU
setnz [supportFPU] // FPU supported

test edx, BIT_CMOV
setnz [supportCMOV] // CMOV supported

test edx, BIT_MMX
setnz [supportMMX] // MMX supported

test edx, BIT_SSE
setnz [supportSSE] // SSE supported

test edx, BIT_SSE2
setnz [supportSSE2] // SSE2 supported

test ecx, BIT_SSE3
setnz [supportSSE3] // SSE3 supported

test ecx, BIT_SSSE3
setnz [supportSSSE3] // SSSE3 supported

// test extended functions
mov eax, $80000000
cpuid
cmp eax, $80000000
jbe @@no_ext_functions

mov eax, $80000001
cpuid

test edx, BIT_3DNOW
setnz [support3DNow] // 3DNow supported

test edx, BIT_3DNOW_EXT
setnz [support3DNow_EXT] // 3DNowExt supported


@@no_ext_functions:

pop ebx // restore ebx

@@end:
end;


function GetSSESafeMem(Size: Cardinal): Pointer;
begin
GetMem(Result, Size + $F);
end;


function GetSSESafeAddr(Addr: Pointer): Pointer;
asm
test eax, $F // test if one of the last bits are set
jz @@end // address is allways 16 Byte aligned
or eax, $F // fill the last 4 bits
inc eax // add 1
@@end:
end;


end.

+ 5762
- 0
old/TextSuiteClasses.pas
文件差異過大導致無法顯示
查看文件


+ 867
- 0
old/TextSuiteImports.pas 查看文件

@@ -0,0 +1,867 @@
{
TextSuite (C) Steffen Xonna (aka Lossy eX)
http://www.opengl24.de/
-----------------------------------------------------------------------
For copyright informations see file copyright.txt.
}

{$I TextSuiteOptions.inc}

unit TextSuiteImports;

interface

uses
TextSuite;

type
DWORD = Cardinal;
PDWORD = ^DWORD;

// *** Global Functions ***
{$IFDEF WINDOWS}
const
Kernel32 = 'kernel32.dll';

function LoadLibrary(lpFileName: pAnsiChar): Pointer; stdcall; external Kernel32 name 'LoadLibraryA';
function FreeLibrary(hModule: Pointer): Pointer; stdcall; external Kernel32 name 'FreeLibrary';
function GetProcAddress(hModule: Pointer; lpProcName: pAnsiChar): Pointer; stdcall; external Kernel32 name 'GetProcAddress';
{$ELSE}
const
LibraryLib = {$IFDEF Linux} 'libdl.so.2'{$ELSE} 'c'{$ENDIF};

RTLD_LAZY = $001;

function dlopen(Name: pAnsiChar; Flags: LongInt): Pointer; cdecl; external LibraryLib name 'dlopen';
function dlclose(Lib: Pointer): LongInt; cdecl; external LibraryLib name 'dlclose';
function dlsym(Lib: Pointer; Name: pAnsiChar): Pointer; cdecl; external LibraryLib name 'dlsym';
{$ENDIF}


{$IFDEF WINDOWS}
function GetCurrentThreadId: DWORD; stdcall; external Kernel32 name 'GetCurrentThreadId';
{$ENDIF}



// *** OpenGL ***
function Init_OpenGL: Boolean;
procedure Quit_OpenGL;

const
{$IFDEF WINDOWS}
LIB_OPENGL = 'opengl32.dll';
{$ELSE}
LIB_OPENGL = 'libGL.so.1';
{$ENDIF}

GL_TEXTURE_2D = $0DE1;
GL_RGBA = $1908;
GL_UNSIGNED_BYTE = $1401;
GL_NEAREST = $2600;
GL_LINEAR = $2601;
GL_TEXTURE_MAG_FILTER = $2800;
GL_TEXTURE_MIN_FILTER = $2801;

GL_LINES = $0001;
GL_QUADS = $0007;

GL_COMPILE = $1300;


var
OpenGL_initialized: Boolean;
Library_OpenGL: Pointer;

glEnable: procedure(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glDisable: procedure(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}

glColor4f: procedure(red, green, blue, alpha: Single); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}

glGenTextures: procedure(n: Integer; textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glDeleteTextures: procedure(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glBindTexture: procedure(target: Cardinal; texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glTexParameteri: procedure(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glTexImage2D: procedure(target: Cardinal; level: Integer; internalformat: Integer; width: Integer; height: Integer; border: Integer; format: Cardinal; _type: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glTexSubImage2D: procedure(target: Cardinal; level: Integer; xoffset: Integer; yoffset: Integer; width: Integer; height: Integer; format: Cardinal; _type: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}

glBegin: procedure(mode: Cardinal); {$IFNDEF CLR}{$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}{$ENDIF}
glEnd: procedure(); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glTexCoord2f: procedure(s: Single; t: Single); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glTexCoord2fv: procedure(v: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glVertex2f: procedure(x: Single; y: Single); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glVertex2fv: procedure(v: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glVertex2iv: procedure(v: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}

glGenLists: function(range: Integer): Cardinal; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glDeleteLists: procedure(list: Cardinal; range: Integer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glCallList: procedure(list: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glNewList: procedure(list: Cardinal; mode: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
glEndList: procedure(); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}



// *** Windows GDI ***
function Init_GDI: Boolean;
procedure Quit_GDI;

type
HDC = Cardinal;
HFONT = Cardinal;
HGDIOBJ = Cardinal;

{$IFDEF CPU64}
{$PACKRECORDS 8}
{$ENDIF}

TFixed = packed record
fract: Word;
value: Smallint;
end;

TMat2 = packed record
eM11: TFixed;
eM12: TFixed;
eM21: TFixed;
eM22: TFixed;
end;
PMat2 = ^TMat2;

TLogFontA = record
lfHeight: Longint;
lfWidth: Longint;
lfEscapement: Longint;
lfOrientation: Longint;
lfWeight: Longint;
lfItalic: Byte;
lfUnderline: Byte;
lfStrikeOut: Byte;
lfCharSet: Byte;
lfOutPrecision: Byte;
lfClipPrecision: Byte;
lfQuality: Byte;
lfPitchAndFamily: Byte;
lfFaceName: array[0..31] of AnsiChar;
end;
PLogFontA = ^TLogFontA;

TTextMetricW = record
tmHeight: Longint;
tmAscent: Longint;
tmDescent: Longint;
tmInternalLeading: Longint;
tmExternalLeading: Longint;
tmAveCharWidth: Longint;
tmMaxCharWidth: Longint;
tmWeight: Longint;
tmOverhang: Longint;
tmDigitizedAspectX: Longint;
tmDigitizedAspectY: Longint;
tmFirstChar: WideChar;
tmLastChar: WideChar;
tmDefaultChar: WideChar;
tmBreakChar: WideChar;
tmItalic: Byte;
tmUnderlined: Byte;
tmStruckOut: Byte;
tmPitchAndFamily: Byte;
tmCharSet: Byte;
end;
PTextMetricW = ^TTextMetricW;

TGlyphMetrics = record
gmBlackBoxX: Cardinal;
gmBlackBoxY: Cardinal;
gmptGlyphOrigin: tsPoint;
gmCellIncX: Smallint;
gmCellIncY: Smallint;
end;
PGlyphMetrics = ^TGlyphMetrics;

TGCPResultsW = record
lStructSize: DWORD;
lpOutString: PWideChar;
lpOrder: PDWORD;
lpDx: PInteger;
lpCaretPos: PInteger;
lpClass: PChar;
lpGlyphs: PCardinal;
nGlyphs: Cardinal;
nMaxFit: Cardinal;
end;
PGCPResultsW = ^TGCPResultsW;

TPanose = record
bFamilyType: Byte;
bSerifStyle: Byte;
bWeight: Byte;
bProportion: Byte;
bContrast: Byte;
bStrokeVariation: Byte;
bArmStyle: Byte;
bLetterform: Byte;
bMidline: Byte;
bXHeight: Byte;
end;
PPanose = ^TPanose;

TOutlineTextmetricW = record
otmSize: LongWord;
otmTextMetrics: TTextMetricW;
otmFiller: Byte;
otmPanoseNumber: TPanose;
otmfsSelection: LongWord;
otmfsType: LongWord;
otmsCharSlopeRise: Integer;
otmsCharSlopeRun: Integer;
otmItalicAngle: Integer;
otmEMSquare: LongWord;
otmAscent: Integer;
otmDescent: Integer;
otmLineGap: LongWord;
otmsCapEmHeight: LongWord;
otmsXHeight: LongWord;
otmrcFontBox: tsRect;
otmMacAscent: Integer;
otmMacDescent: Integer;
otmMacLineGap: LongWord;
otmusMinimumPPEM: LongWord;
otmptSubscriptSize: tsPoint;
otmptSubscriptOffset: tsPoint;
otmptSuperscriptSize: tsPoint;
otmptSuperscriptOffset: tsPoint;
otmsStrikeoutSize: LongWord;
otmsStrikeoutPosition: Integer;
otmsUnderscoreSize: Integer;
otmsUnderscorePosition: Integer;
otmpFamilyName: PWideChar;
otmpFaceName: PWideChar;
otmpStyleName: PWideChar;
otmpFullName: PWideChar;
end;
POutlineTextmetricW = ^TOutlineTextmetricW;

{$IFDEF CPU64}
{$PACKRECORDS 4}
{$ENDIF}

const
LIB_GDI32 = 'gdi32.dll';
LIB_KERNEL32 = 'kernel32.dll';

GDI_ERROR = DWORD($FFFFFFFF);

FW_NORMAL = 400;
FW_BOLD = 700;

DEFAULT_CHARSET = 1;

NONANTIALIASED_QUALITY = 3;
ANTIALIASED_QUALITY = 4;

GGO_METRICS = 0;
GGO_BITMAP = 1;
GGO_GRAY8_BITMAP = 6;
GGO_GLYPH_INDEX = $80;

FR_PRIVATE = $10;
FR_NOT_ENUM = $20;

LOCALE_USER_DEFAULT = $0400;
LOCALE_ILANGUAGE = $1;

GCP_MAXEXTENT = $100000;

TMPF_FIXED_PITCH = 1;


var
GDI_initialized: Boolean;
Library_GDI32: Pointer;
Library_KERNEL32: Pointer;

CreateFontIndirectA: function (const p1: TLogFontA): HFONT; stdcall;

AddFontResourceA: function(Filename: PAnsiChar): Integer; stdcall;
AddFontResourceExA: function(Filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Integer; stdcall;
AddFontMemResourceEx: function(pbFont: Pointer; cbFont: DWORD; pdv: Pointer; pcFonts: PDWORD): THandle; stdcall;
RemoveFontResourceA: function(Filename: PAnsiChar): Boolean; stdcall;
RemoveFontResourceExA: function(filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Boolean; stdcall;
RemoveFontMemResourceEx: function(fh: THandle): Boolean; stdcall;

GetTextMetricsW: function(DC: HDC; var TM: TTextMetricW): Boolean; stdcall;
//GetGlyphOutlineA: function(DC: HDC; uChar, uFormat: Word; const lpgm: TGlyphMetrics; cbBuffer: DWORD; lpvBuffer: Pointer; const lpmat2: TMat2): DWORD; stdcall;
GetGlyphOutlineA: function(DC: HDC; uChar, uFormat: Cardinal; lpgm: PGlyphMetrics; cbBuffer: DWORD; lpvBuffer: Pointer; lpmat2: PMat2): DWORD; stdcall;

GetCharacterPlacementW: function(DC: HDC; Str: PWideChar; Count, MaxExtent: Integer; Result: PGCPResultsW; Flags: DWORD): DWORD; stdcall;
GetFontData: function(DC: HDC; TableName, Offset: DWORD; Buffer: Pointer; Data: DWORD): DWORD; stdcall;

CreateCompatibleDC: function(DC: HDC): HDC; stdcall;
DeleteDC: function(DC: HDC): Boolean; stdcall;
SelectObject: function(DC: HDC; p2: HGDIOBJ): HGDIOBJ; stdcall;
DeleteObject: function(p1: HGDIOBJ): Boolean; stdcall;

GetLocaleInfoA: function(Locale: DWORD; LCType: DWORD; lpLCData: pAnsiChar; cchData: Integer): Integer; stdcall;

GetOutlineTextMetricsW: function(DC: HDC; p2: LongWord; var OTMetricStructs: TOutlineTextmetricW): LongWord; stdcall;

// *** SDL globals ***
function Init_SDL: Boolean;
procedure Quit_SDL;

type
PSDL_Color = ^TSDL_Color;
TSDL_Color = record
r: Byte;
g: Byte;
b: Byte;
unused: Byte;
end;

TSDL_Rect = record
X: Smallint;
Y: Smallint;
Width: Word;
Height: Word;
end;

PSDL_ColorArray = ^TSDL_ColorArray;
TSDL_ColorArray = array[0..65000] of TSDL_Color;

PSDL_Palette = ^TSDL_Palette;
TSDL_Palette = record
ncolors: Integer;
colors: PSDL_ColorArray;
end;

PSDL_PixelFormat = ^TSDL_PixelFormat;
TSDL_PixelFormat = record
Palette: PSDL_Palette;
BitsPerPixel: Byte;
BytesPerPixel: Byte;
Rloss: Byte;
Gloss: Byte;
Bloss: Byte;
Aloss: Byte;
Rshift: Byte;
Gshift: Byte;
Bshift: Byte;
Ashift: Byte;
RMask: Cardinal;
GMask: Cardinal;
BMask: Cardinal;
AMask: Cardinal;
Colorkey: Cardinal;
Alpha: Byte;
end;


PSDL_Surface = ^TSDL_Surface;
TSDL_Surface = record
Flags: Cardinal;
Format: PSDL_PixelFormat;
Width: Integer;
Height: Integer;
Pitch: Word;
Pixels: Pointer;
Offset: Integer;
HWDdata: Pointer;
ClipRect: TSDL_Rect;
Unused1: Cardinal;
Locked: Cardinal;
Blitmap: Pointer;
FormatVersion: Cardinal;
RefCount: Integer;
end;


const
{$IFDEF WINDOWS}
LIB_SDL = 'SDL.dll';
{$ELSE}
LIB_SDL = 'libSDL.so';
LIB_SDL_VERSION = 'libSDL-1.2.so.0';
{$ENDIF}

SDL_SWSURFACE = $00000000;
var
Library_SDL: Pointer;

SDL_FreeSurface: procedure(surface: PSDL_Surface); cdecl;
SDL_ConvertSurface: function(Source: PSDL_Surface; Format: PSDL_PixelFormat; flags: Cardinal): PSDL_Surface; cdecl;



// *** SDL_TTF ***
function Init_SDL_TTF: Boolean;
procedure Quit_SDL_TTF;

type
PTTF_Font = ^TTTF_font;
TTTF_Font = record end;


const
{$IFDEF WINDOWS}
LIB_SDL_TTF = 'SDL_ttf.dll';
{$ELSE}
LIB_SDL_TTF = 'libSDL_ttf.so';
LIB_SDL_TTF_VERSION = 'libSDL_ttf-2.0.so.0';
{$ENDIF}

TTF_STYLE_NORMAL = $00;
TTF_STYLE_BOLD = $01;
TTF_STYLE_ITALIC = $02;
// TTF_STYLE_UNDERLINE = $04;

// ZERO WIDTH NO-BREAKSPACE (Unicode byte order mark)
// UNICODE_BOM_NATIVE = $FEFF;
// UNICODE_BOM_SWAPPED = $FFFE;

var
SDL_TTF_initialized: Boolean;
Library_SDL_TTF: Pointer;

TTF_Init: function: Integer; cdecl;
TTF_WasInit: function: Integer; cdecl;
TTF_OpenFont: function(const Filename: pAnsiChar; PTSize: Integer): PTTF_Font; cdecl;
TTF_CloseFont: procedure(Font: PTTF_Font); cdecl;

TTF_GetFontStyle: function(Font: PTTF_Font): Integer; cdecl;
TTF_SetFontStyle: procedure(Font: PTTF_Font; Style: Integer); cdecl;

TTF_FontAscent: function(Font: PTTF_Font) : Integer; cdecl;
TTF_FontDescent: function(Font: PTTF_Font) : Integer; cdecl;
TTF_FontLineSkip: function(Font: PTTF_Font): Integer; cdecl;
TTF_FontFaceIsFixedWidth: function(Font: PTTF_Font): Integer; cdecl;
TTF_FontFaceFamilyName: function(Font: PTTF_Font): pAnsiChar; cdecl;
TTF_FontFaceStyleName: function(Font : PTTF_Font): pAnsiChar; cdecl;
TTF_GlyphMetrics: function(Font: PTTF_Font; CharCode: WORD; var MinX: Integer; var MaxX: Integer; var MinY: Integer; var MaxY: Integer; var Advance: Integer): Integer; cdecl;

TTF_RenderGlyph_Solid: function(Font: PTTF_Font; Char: WORD; const ForeGround: TSDL_Color): PSDL_Surface; cdecl;
TTF_RenderGlyph_Shaded: function(Font: PTTF_Font; Char: WORD; const ForeGround: TSDL_Color; const BackGround: TSDL_Color): PSDL_Surface; cdecl;



// *** SDL_IMAGE ***
function Init_SDL_IMAGE: Boolean;
procedure Quit_SDL_IMAGE;

const
{$IFDEF WINDOWS}
LIB_SDL_IMAGE = 'SDL_Image.dll';
{$ELSE}
LIB_SDL_IMAGE = 'libSDL_image.so';
LIB_SDL_IMAGE_VERSION = 'libSDL_image-1.2.so.0';
{$ENDIF}

var
SDL_IMAGE_initialized: Boolean;
Library_SDL_IMAGE: Pointer;

IMG_Load: function(const _file: PAnsiChar): PSDL_Surface; cdecl;


implementation


function GetLibraryProc(hLibrary: Pointer; ProcName: pAnsiChar): Pointer;
begin
{$IFDEF WINDOWS}
Result := GetProcAddress(hLibrary, ProcName);
{$ELSE}
Result := dlsym(hLibrary, ProcName);
{$ENDIF}
end;


function GetOpenGLLibraryProc(hLibrary: Pointer; ProcName: pAnsiChar): Pointer;
begin
Result := GetLibraryProc(hLibrary, ProcName);
end;


// *** OpenGL ***

function Init_OpenGL: Boolean;
begin
if Library_OpenGL = nil then begin
{$IFDEF WINDOWS}
Library_OpenGL := LoadLibrary(LIB_OPENGL);
{$ELSE}
Library_OpenGL := dlopen(LIB_OPENGL, RTLD_LAZY);
{$ENDIF}
end;

if Library_OpenGL <> nil then begin
glEnable := GetOpenGLLibraryProc(Library_OpenGL, 'glEnable');
glDisable := GetOpenGLLibraryProc(Library_OpenGL, 'glDisable');
glColor4f := GetOpenGLLibraryProc(Library_OpenGL, 'glColor4f');
glGenTextures := GetOpenGLLibraryProc(Library_OpenGL, 'glGenTextures');
glDeleteTextures := GetOpenGLLibraryProc(Library_OpenGL, 'glDeleteTextures');
glBindTexture := GetOpenGLLibraryProc(Library_OpenGL, 'glBindTexture');
glTexParameteri := GetOpenGLLibraryProc(Library_OpenGL, 'glTexParameteri');
glTexImage2D := GetOpenGLLibraryProc(Library_OpenGL, 'glTexImage2D');
glTexSubImage2D := GetOpenGLLibraryProc(Library_OpenGL, 'glTexSubImage2D');
glBegin := GetOpenGLLibraryProc(Library_OpenGL, 'glBegin');
glEnd := GetOpenGLLibraryProc(Library_OpenGL, 'glEnd');
glTexCoord2f := GetOpenGLLibraryProc(Library_OpenGL, 'glTexCoord2f');
glTexCoord2fv := GetOpenGLLibraryProc(Library_OpenGL, 'glTexCoord2fv');
glVertex2f := GetOpenGLLibraryProc(Library_OpenGL, 'glVertex2f');
glVertex2fv := GetOpenGLLibraryProc(Library_OpenGL, 'glVertex2fv');
glVertex2iv := GetOpenGLLibraryProc(Library_OpenGL, 'glVertex2iv');
glGenLists := GetOpenGLLibraryProc(Library_OpenGL, 'glGenLists');
glDeleteLists := GetOpenGLLibraryProc(Library_OpenGL, 'glDeleteLists');
glCallList := GetOpenGLLibraryProc(Library_OpenGL, 'glCallList');
glNewList := GetOpenGLLibraryProc(Library_OpenGL, 'glNewList');
glEndList := GetOpenGLLibraryProc(Library_OpenGL, 'glEndList');
end;

OpenGL_initialized :=
(Addr(glEnable) <> nil) and
(Addr(glDisable) <> nil) and
(Addr(glColor4f) <> nil) and
(Addr(glGenTextures) <> nil) and
(Addr(glDeleteTextures) <> nil) and
(Addr(glBindTexture) <> nil) and
(Addr(glTexParameteri) <> nil) and
(Addr(glTexImage2D) <> nil) and
(Addr(glTexSubImage2D) <> nil) and
(Addr(glBegin) <> nil) and
(Addr(glEnd) <> nil) and
(Addr(glTexCoord2f) <> nil) and
(Addr(glTexCoord2fv) <> nil) and
(Addr(glVertex2f) <> nil) and
(Addr(glVertex2fv) <> nil) and
(Addr(glVertex2iv) <> nil) and
(Addr(glGenLists) <> nil) and
(Addr(glDeleteLists) <> nil) and
(Addr(glCallList) <> nil) and
(Addr(glNewList) <> nil) and
(Addr(glEndList) <> nil);

Result := OpenGL_initialized;
end;


procedure Quit_OpenGL;
begin
glEnable := nil;
glDisable := nil;
glColor4f := nil;
glGenTextures := nil;
glDeleteTextures := nil;
glBindTexture := nil;
glTexParameteri := nil;
glTexImage2D := nil;
glTexSubImage2D := nil;
glBegin := nil;
glEnd := nil;
glTexCoord2f := nil;
glTexCoord2fv := nil;
glVertex2f := nil;
glVertex2fv := nil;
glVertex2iv := nil;
glGenLists := nil;
glDeleteLists := nil;
glCallList := nil;
glNewList := nil;
glEndList := nil;

if Library_OpenGL <> nil then begin
{$IFDEF WINDOWS}
FreeLibrary(Library_OpenGL);
Library_OpenGL := nil;
{$ELSE}
dlclose(Library_OpenGL);
Library_OpenGL := nil;
{$ENDIF}
end;

OpenGL_initialized := False;
end;


// *** Windows GDI globals ***
function Init_GDI: Boolean;
begin
if Library_GDI32 = nil then begin
{$IFDEF WINDOWS}
Library_GDI32 := LoadLibrary(LIB_GDI32);
// {$ELSE}
// Library_GDI32 := nil; //dlopen(LIB_GDI, RTLD_LAZY);
{$ENDIF}
end;

if Library_GDI32 <> nil then begin
CreateFontIndirectA := GetLibraryProc(Library_GDI32, 'CreateFontIndirectA');

AddFontResourceA := GetLibraryProc(Library_GDI32, 'AddFontResourceA');
AddFontResourceExA := GetLibraryProc(Library_GDI32, 'AddFontResourceExA');
AddFontMemResourceEx := GetLibraryProc(Library_GDI32, 'AddFontMemResourceEx');
RemoveFontResourceA := GetLibraryProc(Library_GDI32, 'RemoveFontResourceA');
RemoveFontResourceExA := GetLibraryProc(Library_GDI32, 'RemoveFontResourceExA');
RemoveFontMemResourceEx := GetLibraryProc(Library_GDI32, 'RemoveFontMemResourceEx');

GetTextMetricsW := GetLibraryProc(Library_GDI32, 'GetTextMetricsW');
GetGlyphOutlineA := GetLibraryProc(Library_GDI32, 'GetGlyphOutlineA');

GetCharacterPlacementW := GetLibraryProc(Library_GDI32, 'GetCharacterPlacementW');
GetFontData := GetLibraryProc(Library_GDI32, 'GetFontData');

CreateCompatibleDC := GetLibraryProc(Library_GDI32, 'CreateCompatibleDC');
DeleteDC := GetLibraryProc(Library_GDI32, 'DeleteDC');
SelectObject := GetLibraryProc(Library_GDI32, 'SelectObject');
DeleteObject := GetLibraryProc(Library_GDI32, 'DeleteObject');

GetOutlineTextMetricsW := GetLibraryProc(Library_GDI32, 'GetOutlineTextMetricsW');
end;

if Library_KERNEL32 = nil then begin
{$IFDEF WINDOWS}
Library_KERNEL32 := LoadLibrary(LIB_KERNEL32);
{$ENDIF}
end;

if Library_KERNEL32 <> nil then begin
GetLocaleInfoA := GetLibraryProc(Library_KERNEL32, 'GetLocaleInfoA');
end;

GDI_initialized :=
(Addr(CreateFontIndirectA) <> nil) and

((Addr(AddFontResourceA) <> nil) or
(Addr(AddFontResourceExA) <> nil)) and

((Addr(RemoveFontResourceA) <> nil) or
(Addr(RemoveFontResourceExA) <> nil)) and

(Addr(GetTextMetricsW) <> nil) and
(Addr(GetGlyphOutlineA) <> nil) and

// under 9x GetCharacterPlacementW dosn't exist
(Addr(GetCharacterPlacementW) <> nil) and
(Addr(GetFontData) <> nil) and

(Addr(CreateCompatibleDC) <> nil) and
(Addr(DeleteDC) <> nil) and
(Addr(SelectObject) <> nil) and
(Addr(DeleteObject) <> nil) and

(Addr(GetLocaleInfoA) <> nil) and

(Addr(GetOutlineTextMetricsW) <> nil);

Result := GDI_initialized;
end;


procedure Quit_GDI;
begin
CreateFontIndirectA := nil;
AddFontResourceA := nil;
AddFontResourceExA := nil;
RemoveFontResourceA := nil;
RemoveFontResourceExA := nil;
GetTextMetricsW := nil;
GetGlyphOutlineA := nil;
GetCharacterPlacementW := nil;
GetFontData := nil;
CreateCompatibleDC := nil;
DeleteDC := nil;
SelectObject := nil;
DeleteObject := nil;

if Library_GDI32 <> nil then begin
{$IFDEF WINDOWS}
FreeLibrary(Library_GDI32);
Library_GDI32 := nil;
{$ENDIF}
end;

GetLocaleInfoA := nil;

if Library_KERNEL32 <> nil then begin
{$IFDEF WINDOWS}
FreeLibrary(Library_KERNEL32);
Library_KERNEL32 := nil;
{$ENDIF}
end;

GDI_initialized := False;
end;


// *** SDL globals ***
function Init_SDL: Boolean;
begin
if Library_SDL = nil then begin
{$IFDEF WINDOWS}
Library_SDL := LoadLibrary(LIB_SDL);
{$ELSE}
Library_SDL := dlopen(LIB_SDL, RTLD_LAZY);

if Library_SDL = nil then
Library_SDL := dlopen(LIB_SDL_VERSION, RTLD_LAZY);
{$ENDIF}
end;

if Library_SDL <> nil then begin
SDL_FreeSurface := GetLibraryProc(Library_SDL, 'SDL_FreeSurface');
SDL_ConvertSurface := GetLibraryProc(Library_SDL, 'SDL_ConvertSurface');
end;

Result :=
(Addr(SDL_FreeSurface) <> nil) and
(Addr(SDL_ConvertSurface) <> nil);
end;


procedure Quit_SDL;
begin
SDL_FreeSurface := nil;
SDL_ConvertSurface := nil;

if Library_SDL <> nil then begin
{$IFDEF WINDOWS}
FreeLibrary(Library_SDL);
Library_SDL := nil;
{$ELSE}
dlclose(Library_SDL);
Library_SDL := nil;
{$ENDIF}
end;
end;


// *** SDL_TTF ***
function Init_SDL_TTF: Boolean;
begin
if Library_SDL_TTF = nil then begin
{$IFDEF WINDOWS}
Library_SDL_TTF := LoadLibrary(LIB_SDL_TTF);
{$ELSE}
Library_SDL_TTF := dlopen(LIB_SDL_TTF, RTLD_LAZY);

if Library_SDL_TTF = nil then
Library_SDL_TTF := dlopen(LIB_SDL_TTF_VERSION, RTLD_LAZY);
{$ENDIF}
end;

if Library_SDL_TTF <> nil then begin
TTF_Init := GetLibraryProc(Library_SDL_TTF, 'TTF_Init');
TTF_WasInit := GetLibraryProc(Library_SDL_TTF, 'TTF_WasInit');
TTF_OpenFont := GetLibraryProc(Library_SDL_TTF, 'TTF_OpenFont');
TTF_CloseFont := GetLibraryProc(Library_SDL_TTF, 'TTF_CloseFont');
TTF_GetFontStyle := GetLibraryProc(Library_SDL_TTF, 'TTF_GetFontStyle');
TTF_SetFontStyle := GetLibraryProc(Library_SDL_TTF, 'TTF_SetFontStyle');
TTF_FontAscent := GetLibraryProc(Library_SDL_TTF, 'TTF_FontAscent');
TTF_FontDescent := GetLibraryProc(Library_SDL_TTF, 'TTF_FontDescent');
TTF_FontLineSkip := GetLibraryProc(Library_SDL_TTF, 'TTF_FontLineSkip');
TTF_FontFaceIsFixedWidth := GetLibraryProc(Library_SDL_TTF, 'TTF_FontFaceIsFixedWidth');
TTF_FontFaceFamilyName := GetLibraryProc(Library_SDL_TTF, 'TTF_FontFaceFamilyName');
TTF_FontFaceStyleName := GetLibraryProc(Library_SDL_TTF, 'TTF_FontFaceStyleName');
TTF_GlyphMetrics := GetLibraryProc(Library_SDL_TTF, 'TTF_GlyphMetrics');
TTF_RenderGlyph_Solid := GetLibraryProc(Library_SDL_TTF, 'TTF_RenderGlyph_Solid');
TTF_RenderGlyph_Shaded := GetLibraryProc(Library_SDL_TTF, 'TTF_RenderGlyph_Shaded');
end;

SDL_TTF_initialized :=
Init_SDL and
(Addr(TTF_Init) <> nil) and
(Addr(TTF_WasInit) <> nil) and
(Addr(TTF_OpenFont) <> nil) and
(Addr(TTF_CloseFont) <> nil) and
(Addr(TTF_GetFontStyle) <> nil) and
(Addr(TTF_SetFontStyle) <> nil) and
(Addr(TTF_FontAscent) <> nil) and
(Addr(TTF_FontDescent) <> nil) and
(Addr(TTF_FontLineSkip) <> nil) and
(Addr(TTF_FontFaceIsFixedWidth) <> nil) and
(Addr(TTF_FontFaceFamilyName) <> nil) and
(Addr(TTF_FontFaceStyleName) <> nil) and
(Addr(TTF_GlyphMetrics) <> nil) and
(Addr(TTF_RenderGlyph_Solid) <> nil) and
(Addr(TTF_RenderGlyph_Shaded) <> nil);

Result := SDL_TTF_initialized;
end;


procedure Quit_SDL_TTF;
begin
TTF_Init := nil;
TTF_WasInit := nil;
TTF_OpenFont := nil;
TTF_CloseFont := nil;
TTF_GetFontStyle := nil;
TTF_SetFontStyle := nil;
TTF_FontAscent := nil;
TTF_FontDescent := nil;
TTF_FontLineSkip := nil;
TTF_FontFaceIsFixedWidth := nil;
TTF_FontFaceFamilyName := nil;
TTF_FontFaceStyleName := nil;
TTF_GlyphMetrics := nil;
TTF_RenderGlyph_Solid := nil;
TTF_RenderGlyph_Shaded := nil;

if Library_SDL_TTF <> nil then begin
{$IFDEF WINDOWS}
FreeLibrary(Library_SDL_TTF);
Library_SDL_TTF := nil;
{$ELSE}
dlclose(Library_SDl_TTF);
Library_SDL_TTF := nil;
{$ENDIF}
end;

SDL_TTF_initialized := False;
end;


// *** SDL_IMAGE ***
function Init_SDL_IMAGE: Boolean;
begin
if Library_SDL_IMAGE = nil then begin
{$IFDEF WINDOWS}
Library_SDL_IMAGE := LoadLibrary(LIB_SDL_IMAGE);
{$ELSE}
Library_SDL_IMAGE := dlopen(LIB_SDL_IMAGE, RTLD_LAZY);

if Library_SDL_IMAGE = nil then
Library_SDL_IMAGE := dlopen(LIB_SDL_IMAGE_VERSION, RTLD_LAZY);
{$ENDIF}
end;

if Library_SDL_IMAGE <> nil then begin
IMG_Load := GetLibraryProc(Library_SDL_IMAGE, 'IMG_Load');
end;

SDL_IMAGE_initialized :=
Init_SDL and
(Addr(IMG_load) <> nil);

Result := SDL_IMAGE_initialized;
end;


procedure Quit_SDL_IMAGE;
begin
IMG_Load := nil;

if Library_SDL_IMAGE <> nil then begin
{$IFDEF WINDOWS}
FreeLibrary(Library_SDL_IMAGE);
Library_SDL_IMAGE := nil;
{$ELSE}
dlclose(Library_SDL_IMAGE);
Library_SDL_IMAGE := nil;
{$ENDIF}
end;
end;

end.

+ 46
- 0
old/TextSuiteOptions.inc 查看文件

@@ -0,0 +1,46 @@

{ *** options *** }

{ to use the external library }
{.$define TS_EXTERN_STATIC}


{ to disable the assembler code and use pure pascal code instead.
if you have problem with some older compiler or runtime errors.
But. This can decrease the speed of some operations. }
{.$define TS_PURE_PASCAL}



{ *** important seetings. Don't touch it! *** }
{$IFDEF FPC}
{$MODE Delphi}

{$SMARTLINK ON}

{$IFDEF CPUI386}
{$DEFINE CPU386}
{$ASMMODE INTEL}
{$ELSE}
{$define TS_PURE_PASCAL}
{$ENDIF}

{$IFNDEF WINDOWS}
{$LINKLIB c}
{$ENDIF}
{$ENDIF}


{$BOOLEVAL OFF} // short boolean eval
{$LONGSTRINGS ON} // huge strings
{$EXTENDEDSYNTAX ON} // extended syntax
{$ALIGN ON} // Alignment
{$TYPEDADDRESS OFF} // Typed addresses with @

{$IFNDEF FPC}
{$OPTIMIZATION ON} // O+ Optimizations
{ $ASSERTIONS OFF} // C-
{ $RANGECHECKS OFF} // R-
{ $STACKFRAMES OFF} // W-
{ $OVERFLOWCHECKS OFF} // Q-
{$ENDIF}

+ 398
- 0
old/TextSuitePostProcess.pas 查看文件

@@ -0,0 +1,398 @@
{
TextSuite (C) Steffen Xonna (aka Lossy eX)
http://www.opengl24.de/
-----------------------------------------------------------------------
For copyright informations see file copyright.txt.
}

{$I TextSuiteOptions.inc}

unit TextSuitePostProcess;

interface

uses
TextSuite,
TextSuiteClasses;


type
// ** Post Processing FillColor **
TtsPostFillColor = class(TtsPostProcessStep)
protected
fRed: Single;
fGreen: Single;
fBlue: Single;
fAlpha: Single;
fLuminance: Single;
fChannelMask: tsBitmask;

fModes: TtsImageModes;

procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
public
constructor Create(Red, Green, Blue, Alpha: Single; ChannelMask: tsBitmask; Modes: TtsImageModes);
end;


// ** Post Processing FillPattern **
TtsPostFillPattern = class(TtsPostProcessStep)
protected
fPattern: TtsImage;
fX: Integer;
fY: Integer;
fChannelMask: tsBitmask;
fModes: TtsImageModes;

procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
public
constructor Create(Pattern: TtsImage; X, Y: Integer; ChannelMask: tsBitmask; Modes: TtsImageModes);
end;


// ** Post Processing Border **
TtsPostBorderLookupFuncData = record
Kernel: TtsKernel2D;
XPos, YPos, XMax, YMax: Integer;

pData: pByte;
end;


TtsPostBorder = class(TtsPostProcessStep)
protected
fKernel: TtsKernel2D;

fRed: Single;
fGreen: Single;
fBlue: Single;
fAlpha: Single;

procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
public
constructor Create(Width, Strength: Single; Red, Green, Blue, Alpha: Single);
destructor Destroy; override;
end;

// ** Post Processing Kerning **
TtsPostKerning = class(TtsPostProcessStep)
protected
procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
end;


// ** Post Processing Shadow **
TtsPostShadow = class(TtsPostProcessStep)
protected
fKernel: TtsKernel1D;

fX: Integer;
fY: Integer;

fRed: Single;
fGreen: Single;
fBlue: Single;
fAlpha: Single;

procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
public
constructor Create(Radius: Single; X, Y: Integer; Red, Green, Blue, Alpha: Single);
destructor Destroy; override;
end;


// ** Post Processing Custom **
TtsPostCustom = class(TtsPostProcessStep)
protected
fContext: TtsContext;
fPostProcessProc: tsPostProcessProc;
fData: Pointer;

procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
public
constructor Create(Context: TtsContext; PostProcessProc: tsPostProcessProc; Data: Pointer);
end;


implementation

//uses
// TextSuiteImageUtils;


{ TtsPostFillColor }

constructor TtsPostFillColor.Create(Red, Green, Blue, Alpha: Single; ChannelMask: tsBitmask; Modes: TtsImageModes);
begin
inherited Create;

fRed := Red;
fGreen := Green;
fBlue := Blue;
fAlpha := Alpha;
fChannelMask := ChannelMask;
fModes := Modes;
end;


procedure TtsPostFillColor.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
begin
if CharImage <> nil then
CharImage.FillColor(fRed, fGreen, fBlue, fAlpha, fChannelMask, fModes);
end;


{ TtsPostFillPattern }

constructor TtsPostFillPattern.Create(Pattern: TtsImage; X, Y: Integer; ChannelMask: tsBitmask; Modes: TtsImageModes);
begin
inherited Create;

fPattern := Pattern;
fX := X;
fY := Y;
fChannelMask := ChannelMask;
fModes := Modes;
end;


procedure TtsPostFillPattern.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
begin
if CharImage <> nil then
CharImage.FillPattern(fPattern, fX, fY, fChannelMask, fModes);
end;



{ TtsPostBorder }

constructor TtsPostBorder.Create(Width, Strength, Red, Green, Blue, Alpha: Single);
begin
inherited Create;

fKernel := TtsKernel2D.Create(Width, Strength);

fRed := Red;
fGreen := Green;
fBlue := Blue;
fAlpha := Alpha;
end;


function BorderLookupMax(var Data: TtsPostBorderLookupFuncData): Byte;
var
Idx: Integer;
Temp, TempValue: Single;
pTempData: pByte;
begin
TempValue := 0;

with Data, Data.Kernel do begin
for Idx := 0 to ItemCount - 1 do
with Items[Idx] do
if ((XPos + OffsetX >= 0) and (XPos + OffsetX < XMax) and
(YPos + OffsetY >= 0) and (YPos + OffsetY < YMax)) then begin
pTempData := pData;

Inc(pTempData, DataOffset);

// there is no value
if pTempData^ = $00 then
Continue;

// calculate pixel
Temp := pTempData^ * Value;
if (Temp > TempValue) then
TempValue := Temp;

// there is nothing greater than this
if pTempData^ = $FF then
Break;
end;
end;

Result := Round(TempValue);
end;


destructor TtsPostBorder.Destroy;
begin
fKernel.Free;

inherited;
end;


procedure TtsPostBorder.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
var
OriginalImage: TtsImage;

X, Y: Integer;
pSource, pDest: ptsColor;

Data: TtsPostBorderLookupFuncData;
begin
if CharImage <> nil then begin
// Make image geater
CharImage.Resize(CharImage.Width + fKernel.SizeX * 2, CharImage.Height + fKernel.SizeY * 2, fKernel.SizeX, fKernel.SizeY);

// Create copy of Image
OriginalImage := TtsImage.Create;
try
OriginalImage.AssignFrom(CharImage);
CharImage.FillColor(fRed, fGreen, fBlue, fAlpha, TS_CHANNELS_RGBA, cModesReplace);

fKernel.UpdateDataOffset(4, OriginalImage.Width * 4);

Data.Kernel := fKernel;
Data.XMax := OriginalImage.Width;
Data.YMax := OriginalImage.Height;

for Y := 0 to OriginalImage.Height - 1 do begin
pSource := OriginalImage.ScanLine[Y];
pDest := CharImage.ScanLine[Y];

Data.pData := @(pSource^.Alpha);
Data.YPos := Y;

for X := 0 to OriginalImage.Width - 1 do begin
Data.XPos := X;

pDest^.Alpha := Round(fAlpha * BorderLookupMax(Data));

Inc(Data.pData, 4);
Inc(pDest);
end;
end;

// Blend OriginalImage over CharImage (shadow)
CharImage.BlendImage(OriginalImage, 0, 0);
finally
OriginalImage.Free;
end;
end;

// Set Char Data
Char.GlyphRect.Left := Char.GlyphRect.Left + fKernel.SizeX - fKernel.MidSizeX;
Char.GlyphRect.Right := Char.GlyphRect.Right + fKernel.SizeX + fKernel.MidSizeX;

Char.GlyphRect.Top := Char.GlyphRect.Top + fKernel.SizeY - fKernel.MidSizeY;
Char.GlyphRect.Bottom := Char.GlyphRect.Bottom + fKernel.SizeY + fKernel.MidSizeY;

Char.GlyphOriginY := Char.GlyphOriginY + fKernel.MidSizeY;
Char.Advance := Char.Advance + fKernel.MidSizeX;
end;


{ TtsPostKerning }

procedure TtsPostKerning.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
begin
// if CharImage <> nil then
// Char.CalculateKerningData(CharImage);
end;


{ TtsPostShadow }

constructor TtsPostShadow.Create(Radius: Single; X, Y: Integer; Red, Green, Blue, Alpha: Single);
begin
inherited Create;

fKernel := TtsKernel1D.Create(Radius, 0);

fX := X;
fY := Y;
fRed := Red;
fGreen := Green;
fBlue := Blue;
fAlpha := Alpha;
end;


destructor TtsPostShadow.Destroy;
begin
fKernel.Free;

inherited;
end;


procedure TtsPostShadow.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
var
OriginalImage: TtsImage;
TempX, TempY: Integer;
begin
if CharImage <> nil then begin
OriginalImage := TtsImage.Create;
try
// backup to original
OriginalImage.AssignFrom(CharImage);

// Resizing image
CharImage.Resize(CharImage.Width + fKernel.Size * 2, CharImage.Height + fKernel.Size * 2, fKernel.Size, fKernel.Size);

// fill char image with color
CharImage.FillColor(fRed, fGreen, fBlue, fAlpha, TS_CHANNELS_RGBA, cModesNormal);

// blur charimage
CharImage.Blur(fKernel, fKernel, TS_CHANNEL_ALPHA);

TempX := fKernel.Size - fX;
TempY := fKernel.Size - fY;

// Blend OriginalImage over CharImage (shadow)
CharImage.BlendImage(OriginalImage, TempX, TempY);

// Set Chardimension
with Char.GlyphRect do begin
if TempX > 0 then begin
Left := Left + TempX;
Right := Right + TempX;
end;

if TempY > 0 then begin
Top := Top + TempY;
Bottom := Bottom + TempY;
end;
end;
finally
OriginalImage.Free;
end;
end;
end;


{ TtsPostCustom }

constructor TtsPostCustom.Create(Context: TtsContext; PostProcessProc: tsPostProcessProc; Data: Pointer);
begin
inherited Create;

fContext := Context;
fPostProcessProc := PostProcessProc;
fData := Data;
end;


procedure TtsPostCustom.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
var
ImageID: tsImageID;
begin
if CharImage <> nil then begin
if fContext <> nil then begin
// temporary Add Image
ImageID := fContext.ImageAdd(CharImage);
try
fPostProcessProc(ImageID, Char.CharCode, fData);
finally
fContext.ImageDelete(ImageID);
end;
end;
end
// call without an ImageID
else fPostProcessProc(0, Char.CharCode, fData);
end;


end.

+ 367
- 0
old/TextSuiteTTFUtils.pas 查看文件

@@ -0,0 +1,367 @@
{
TextSuite (C) Steffen Xonna (aka Lossy eX)
http://www.opengl24.de/
-----------------------------------------------------------------------
For copyright informations see file copyright.txt.
}

{$WARNINGS OFF}
{$HINTS OFF}

{$I TextSuiteOptions.inc}

unit TextSuiteTTFUtils;

interface

uses Classes;

const
NAME_ID_COPYRIGHT = 0;
NAME_ID_FACE_NAME = 1;
NAME_ID_STYLE_NAME = 2;
NAME_ID_FULL_NAME = 4;



function MakeTTTableName(ch1, ch2, ch3, ch4: Char): Cardinal;
function GetTTString(pBuffer: Pointer; BufferSize: Integer; NameID, LanguageID: Cardinal; var Text: AnsiString): Boolean;

function GetTTFontFullNameFromStream(Stream: TStream; LanguageID: Cardinal): AnsiString;
function GetTTFontFullNameFromFile(Filename: AnsiString; LanguageID: Cardinal): AnsiString;

(*
function GetTTUnicodeGlyphIndex(DC: Cardinal; ch: Word): Word;
function GetTTUnicodeCharCount(DC: Cardinal): Word;
*)

implementation


uses
SysUtils,
TextSuiteWideUtils,
TextSuiteImports;


function SWAPWORD(x: Word): Word;
{$ifdef TS_PURE_PASCAL}
begin
Result := x and $FF;
Result := Result shl 8;
Result := Result or (x shr 8);
{$else}
asm
mov dl, al
mov al, ah
mov ah, dl
{$endif}
end;


function SWAPLONG(x: Cardinal): Cardinal;
{$ifdef TS_PURE_PASCAL}
begin
Result := (x and $FF) shl 24;
x := x shr 8;

Result := Result or ((x and $FF) shl 16);
x := x shr 8;
Result := Result or ((x and $FF) shl 8);
x := x shr 8;

Result := Result or x;
{$else}
asm
mov dx, ax
shr eax, 16
mov cx, ax
mov al, dh
mov ah, dl
shl eax, 16
mov al, ch
mov ah, cl
{$endif}
end;


function MakeTTTableName(ch1, ch2, ch3, ch4: Char): Cardinal;
begin
Result := ord(ch4) shl 24 or ord(ch3) shl 16 or ord(ch2) shl 8 or ord(ch1);
end;


type
TT_OFFSET_TABLE = packed record
uMajorVersion: Word;
uMinorVersion: Word;
uNumOfTables: Word;
uSearchRange: Word;
uEntrySelector: Word;
uRangeShift: Word;
end;


TT_TABLE_DIRECTORY = packed record
TableName: Cardinal; // table name
uCheckSum: Cardinal; // Check sum
uOffset: Cardinal; // Offset from beginning of file
uLength: Cardinal; // length of the table in bytes
end;


TT_NAME_TABLE_HEADER = packed record
uFSelector: Word; //format selector. Always 0
uNRCount: Word; //Name Records count
uStorageOffset: Word; //Offset for strings storage, from start of the table
end;

TT_NAME_RECORD = packed record
uPlatformID: Word;
uEncodingID: Word;
uLanguageID: Word;
uNameID: Word;
uStringLength: Word;
uStringOffset: Word; //from start of storage area
end;


const
PLATFORM_ID_APPLE_UNICODE = 0;
PLATFORM_ID_MACINTOSH = 1;
PLATFORM_ID_MICROSOFT = 3;


function GetTTTableData(Stream: TStream; TableName: Cardinal; pBuff: Pointer; var Size: Integer): Boolean;
var
Pos: Int64;
OffsetTable: TT_OFFSET_TABLE;
TableDir: TT_TABLE_DIRECTORY;
Idx: Integer;
begin
Result := False;

Pos := Stream.Position;

// Reading table header
Stream.Read(OffsetTable, sizeof(TT_OFFSET_TABLE));
OffsetTable.uNumOfTables := SWAPWORD(OffsetTable.uNumOfTables);
OffsetTable.uMajorVersion := SWAPWORD(OffsetTable.uMajorVersion);
OffsetTable.uMinorVersion := SWAPWORD(OffsetTable.uMinorVersion);

//check is this is a true type font and the version is 1.0
if (OffsetTable.uMajorVersion <> 1) or (OffsetTable.uMinorVersion <> 0) then
Exit;

// seaching table with name
for Idx := 0 to OffsetTable.uNumOfTables -1 do begin
Stream.Read(TableDir, sizeof(TT_TABLE_DIRECTORY));

if (TableName = TableDir.TableName) then begin
TableDir.uOffset := SWAPLONG(TableDir.uOffset);
TableDir.uLength := SWAPLONG(TableDir.uLength);

// copying tabledata
if (pBuff <> nil) and (Size >= Integer(TableDir.uLength)) then begin
Stream.Seek(TableDir.uOffset, soBeginning);
Size := Stream.Read(pBuff^, TableDir.uLength);

Result := Size = Integer(TableDir.uLength);
end else

begin
// restoring streamposition
Stream.Position := Pos;

Size := TableDir.uLength;
Result := True;
end;

break;
end;
end;
end;


function GetTTString(pBuffer: Pointer; BufferSize: Integer; NameID, LanguageID: Cardinal; var Text: AnsiString): Boolean;
var
pActBuffer: pByte;
ttNTHeader: TT_NAME_TABLE_HEADER;
ttRecord: TT_NAME_RECORD;
Idx: Integer;
Prio: Integer;

procedure ExtractName;
var
pTempBuffer: pByte;
pTemp: pWideChar;
uStringLengthH2: Word;

procedure SwapText(pText: pWideChar; Length: Word);
begin
while Length > 0 do begin
pWord(pText)^ := SWAPWORD(pWord(pText)^);
Inc(pText);
Dec(Length);
end;
end;

begin
Result := True;

ttRecord.uStringLength := SWAPWORD(ttRecord.uStringLength);
ttRecord.uStringOffset := SWAPWORD(ttRecord.uStringOffset);

uStringLengthH2 := ttRecord.uStringLength shr 1;

pTempBuffer := pBuffer;
Inc(pTempBuffer, ttNTHeader.uStorageOffset + ttRecord.uStringOffset);

// Unicode
if ((ttRecord.uPlatformID = PLATFORM_ID_MICROSOFT) and (ttRecord.uEncodingID in [0, 1])) or
((ttRecord.uPlatformID = PLATFORM_ID_APPLE_UNICODE) and (ttRecord.uEncodingID > 0)) then begin
pTemp := tsStrAlloc(uStringLengthH2);
try
// uStringLengthH2 * 2 because possible buffer overrun
Move(pTempBuffer^, pTemp^, uStringLengthH2 * 2);

SwapText(pTemp, uStringLengthH2);

WideCharLenToStrVar(pTemp, uStringLengthH2, Text);
finally
tsStrDispose(pTemp);
end;
end else

// none unicode
begin
SetLength(Text, ttRecord.uStringLength);
Move(pTempBuffer^, Text[1], ttRecord.uStringLength);
end;
end;

begin
Result := False;

pActBuffer := pBuffer;

Move(pActBuffer^, ttNTHeader, sizeof(TT_NAME_TABLE_HEADER));
inc(pActBuffer, sizeof(TT_NAME_TABLE_HEADER));

ttNTHeader.uNRCount := SWAPWORD(ttNTHeader.uNRCount);
ttNTHeader.uStorageOffset := SWAPWORD(ttNTHeader.uStorageOffset);

Prio := -1;

for Idx := 0 to ttNTHeader.uNRCount -1 do begin
Move(pActBuffer^, ttRecord, sizeof(TT_NAME_RECORD));
Inc(pActBuffer, sizeof(TT_NAME_RECORD));

ttRecord.uNameID := SWAPWORD(ttRecord.uNameID);

if ttRecord.uNameID = NameID then begin
ttRecord.uPlatformID := SWAPWORD(ttRecord.uPlatformID);
ttRecord.uEncodingID := SWAPWORD(ttRecord.uEncodingID);
ttRecord.uLanguageID := SWAPWORD(ttRecord.uLanguageID);

// highest priority
if (ttRecord.uPlatformID = PLATFORM_ID_MICROSOFT) then begin
// system language
if (ttRecord.uLanguageID = languageID) then begin
if Prio <= 7 then begin
ExtractName;

Prio := 7;
end;
end else

// english
if (ttRecord.uLanguageID = 1033) then begin
if Prio <= 6 then begin
ExtractName;

Prio := 6;
end;
end else

// all else
if Prio <= 5 then begin
ExtractName;

Prio := 5;
end;
end else

// apple unicode
if (ttRecord.uPlatformID = PLATFORM_ID_APPLE_UNICODE) then begin
ExtractName;

Prio := 4;
end else

// macintosh
if (ttRecord.uPlatformID = PLATFORM_ID_MACINTOSH) then begin
// english
if (ttRecord.uLanguageID = 0) then begin
if Prio <= 3 then begin
ExtractName;

Prio := 3;
end;
end else

// all other
begin
ExtractName;

Prio := 2;
end;
end else

begin
if Prio <= 1 then begin
ExtractName;

Prio := 1;
end;
end;
end;
end;
end;

function GetTTFontFullNameFromStream(Stream: TStream; LanguageID: Cardinal): AnsiString;
var
TableName: Cardinal;
Buffer: Pointer;
BufferSize: Integer;
begin
TableName := MakeTTTableName('n', 'a', 'm', 'e');

if GetTTTableData(Stream, TableName, nil, BufferSize) then begin
GetMem(Buffer, BufferSize);
try
if GetTTTableData(Stream, TableName, Buffer, BufferSize) then begin
if not GetTTString(Buffer, BufferSize, NAME_ID_FULL_NAME, LanguageID, Result) then
if not GetTTString(Buffer, BufferSize, NAME_ID_FACE_NAME, LanguageID, Result) then
Result := '';
end;
finally
FreeMem(Buffer);
end;
end;
end;

function GetTTFontFullNameFromFile(Filename: AnsiString; LanguageID: Cardinal): AnsiString;
var
fs: TFileStream;
begin
fs := TFileStream.Create(String(Filename), fmOpenRead or fmShareDenyWrite);
try
result := GetTTFontFullNameFromStream(fs, LanguageID);
finally
fs.Free;
end;
end;

end.

+ 13
- 0
old/TextSuiteVersion.pas 查看文件

@@ -0,0 +1,13 @@
unit TextSuiteVersion;

interface

const
TS_MAYOR_VERSION = 0;
TS_MINOR_VERSION = 8;
TS_BUILD_NUMBER = 1;
TS_VERSION_STR = '0.8.1';
implementation

end.

+ 1394
- 0
old/TextSuiteWideUtils.pas
文件差異過大導致無法顯示
查看文件


二進制
查看文件


二進制
查看文件


二進制
查看文件


二進制
查看文件


二進制
查看文件


二進制
查看文件


+ 14
- 0
uMainForm.lfm 查看文件

@@ -0,0 +1,14 @@
object MainForm: TMainForm
Left = 536
Height = 508
Top = 255
Width = 682
OnCreate = FormCreate
OnPaint = FormPaint
LCLVersion = '1.3'
object ApplicationProperties: TApplicationProperties
OnIdle = ApplicationPropertiesIdle
left = 56
top = 24
end
end

+ 112
- 0
uMainForm.pas 查看文件

@@ -0,0 +1,112 @@
unit uMainForm;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, uglcContext, TextSuite, uglcTypes, utsTextSuite;

type
TMainForm = class(TForm)
ApplicationProperties: TApplicationProperties;
procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
fContext: TglcContext;
fTextSuiteContext: tsContextID;
fFontID: tsFontID;

ftsContext: TtsContext;
ftsRenderer: TtsRenderer;
ftsCreator: TtsFontCreator;
ftsFont: TtsFont;

procedure Render;
public
{ public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.lfm}

uses
dglOpenGL;

const
TEST_STRING = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.';

procedure TMainForm.FormCreate(Sender: TObject);
var
pf: TglcContextPixelFormatSettings;
begin
pf := TglcContext.MakePF();
fContext := TglcContext.GetPlatformClass.Create(self, pf);
fContext.BuildContext;

tsInit(TS_INIT_TEXTSUITE or TS_INIT_OPENGL or TS_INIT_GDI);
tsContextCreate(@fTextSuiteContext);
tsSetParameteri(TS_RENDERER, TS_RENDERER_OPENGL);
tsSetParameteri(TS_CREATOR, TS_CREATOR_GDI);
tsContextBind(fTextSuiteContext);
tsFontCreateCreatorA('ttf/calibri.ttf', 24, 0, TS_ANTIALIASING_NORMAL, TS_DEFAULT, @fFontID);
tsFontBind(fFontID);

ftsContext := TtsContext.Create;
ftsRenderer := TtsRenderer.Create(ftsContext, tsFormatRGBA8);
ftsCreator := TtsFontCreator.Create;
ftsFont := TtsFont.Create(ftsRenderer, ftsCreator, '', '', '', '', 12, 0, 0, [], tsAANormal);
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
Render;
end;

procedure TMainForm.Render;
var
block: TtsTextBlock;
begin
glViewport(0, 0, ClientWidth, ClientHeight);
glClearColor(0, 0, 0, 0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho(0, ClientWidth, ClientHeight, 0, -10, 10);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;

glDisable(GL_CULL_FACE);
glDisable(GL_DEPTH_TEST);
glEnable(GL_BLEND);

glcBlendFunc(TglcBlendMode.bmAdditiveAlphaBlend);
//tsTextBeginBlock(10, 10, ClientWidth-10, ClientHeight-10, TS_ALIGN_BLOCK);
//tsTextOutA(TEST_STRING);
//tsTextEndBlock;

block := ftsRenderer.BeginBlock(10, 10, ClientWidth-10, ClientHeight-10, [tsBlockFlagWordWrap]);
try
block.ChangeFont(ftsFont);
block.TextOutW('test'#13#10#13#10'test'#13#13'test'#10#10'test'#13#10#10'test'#13#13#10);
finally
ftsRenderer.EndBlock(block);
end;

fContext.SwapBuffers;
end;

procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
begin
Render;
Done := false;
end;

end.


Write Preview
Loading…
取消
儲存