/
texture-font-to-pascal.lpr
166 lines (150 loc) · 7.1 KB
/
texture-font-to-pascal.lpr
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
{
Copyright 2004-2023 Michalis Kamburelis.
This file is part of "Castle Game Engine".
"Castle Game Engine" is free software; see the file COPYING.txt,
included in this distribution, for details about the copyright.
"Castle Game Engine" is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
----------------------------------------------------------------------------
}
{ Convert font files (.ttf, .otf and other formats handled by FreeType) to Pascal units,
to embed fonts inside source code. }
{$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif}
uses Classes, SysUtils,
CastleFont2Pascal, CastleUtils, CastleClassUtils, CastleLog,
CastleParameters, CastleTextureFontData, CastleStringUtils,
CastleUriUtils, CastleUnicode, CastleFilesUtils,
CastleImages, CastleApplicationProperties, CastleLocalizationGetText;
var
Size: Integer = 10;
AntiAliasing: boolean = true;
ParamUnitName, ParamFunctionName: string;
OnlySampleText: boolean = false;
DebugFontImage: boolean = false;
Characters: TUnicodeCharList;
const
Options: array [0..12] of TOption =
(
(Short: 'h'; Long: 'help'; Argument: oaNone),
(Short: 'v'; Long: 'version'; Argument: oaNone),
(Short: #0; Long: 'size'; Argument: oaRequired),
(Short: #0; Long: 'no-anti-alias'; Argument: oaNone),
(Short: #0; Long: 'sample-text'; Argument: oaRequired),
(Short: #0; Long: 'sample-text-file'; Argument: oaRequired),
(Short: #0; Long: 'sample-code'; Argument: oaRequired),
(Short: #0; Long: 'sample-get-text-mo'; Argument: oaRequired),
(Short: #0; Long: 'function-name'; Argument: oaRequired),
(Short: #0; Long: 'unit-name'; Argument: oaRequired),
(Short: #0; Long: 'debug-log'; Argument: oaNone),
(Short: #0; Long: 'debug-font-image'; Argument: oaNone),
(Short: #0; Long: 'only-sample-text'; Argument: oaNone)
);
procedure OptionProc(OptionNum: Integer; HasArgument: boolean;
const Argument: string; const SeparateArgs: TSeparateArgs; Data: Pointer);
begin
case OptionNum of
0: begin
Writeln(
'texture-font-to-pascal: convert font file (like TTF or OTF)' +NL+
'to a Pascal source file, based on types' +NL+
'in Castle Game Engine CastleTextureFontData unit.' +NL+
NL+
'Usage:' +NL+
' texture-font-to-pascal [options...] MyFontFile.ttf' +NL+
NL+
'Available options:' +NL+
OptionDescription('-h / --help',
'Print this help message and exit.') + NL +
OptionDescription('--size=FONT-SIZE', '') + NL +
OptionDescription('--no-anti-alias', '') + NL +
OptionDescription('--sample-text=TEXT',
'Load (if existing in the font file) all the listed characters. You can use this parameter multiple times.') + NL +
OptionDescription('--sample-text-file=TEXT-FILE-NAME',
'Load (if existing in the font file) all the characters used in given text file. You can use this parameter multiple times.') + NL +
OptionDescription('--sample-code=TEXT',
'Load (if existing in the font file) the listed character code. You can use this parameter multiple times.') + NL +
OptionDescription('--sample-get-text-mo=URL',
'Load (if existing in the font file) all the character codes present in translated strings in URL. URL must point to a GetText MO file, it can be a regular filename as well. You can use this parameter multiple times.') + NL +
OptionDescription('--only-sample-text',
'Load only characters from --sample-text and --sample-code, do not add standard ASCII chars. By default we add standard ASCII chars, regardless of --sample-text and --sample-code.') + NL +
OptionDescription('--function-name=PASCAL-FUNCTION-NAME',
'Set function name to access the font. By default we automatically calculate it based on font name and size.') + NL +
OptionDescription('--unit-name=PASCAL-UNIT-NAME',
'Set generated unit name. This also determines the output filename. By default we automatically calculate it based on function name (which in turn is automatically calculated based on font name and size).') + NL +
OptionDescription('--debug-log',
'See the log, showing e.g. the font image size.') + NL +
OptionDescription('--debug-font-image',
'Write to disk font images as png.') + NL +
NL+
ApplicationProperties.Description);
Halt;
end;
1: begin
// include ApplicationName in version, good for help2man
Writeln(ApplicationName + ' ' + ApplicationProperties.Version);
Halt;
end;
2: Size := StrToInt(Argument);
3: AntiAliasing := false;
4: Characters.Add(Argument);
5: Characters.Add(FileToString(Argument));
6: Characters.Add(StrToInt(Argument));
7: AddTranslatedCharacters(Argument, Characters);
8: ParamFunctionName := Argument;
9: ParamUnitName := Argument;
10: InitializeLog;
11: DebugFontImage := true;
12: OnlySampleText := true;
else raise EInternalError.Create('OptionProc');
end;
end;
var
Font: TTextureFontData;
PrecedingComment, UnitName, FontFunctionName, OutURL, FontURL, FontName: string;
begin
ApplicationProperties.ApplicationName := 'texture-font-to-pascal';
ApplicationProperties.Version := '1.0';
ApplicationProperties.OnWarning.Add(@ApplicationProperties.WriteWarningOnConsole);
Characters := TUnicodeCharList.Create;
try
Parameters.Parse(Options, @OptionProc, nil);
Parameters.CheckHigh(1);
FontURL := Parameters[1];
if not OnlySampleText then
Characters.Add(SimpleAsciiCharacters);
if Characters.Count = 0 then
raise EInvalidParams.Create('No font characters requested to be loaded');
FontName := DeleteURIExt(ExtractURIName(FontURL));
if ParamFunctionName <> '' then
FontFunctionName := ParamFunctionName
else
FontFunctionName := 'TextureFont_' +
SDeleteChars(FontName, AllChars - ['a'..'z', 'A'..'Z', '0'..'9']) +
'_' + IntToStr(Size);
if ParamUnitName <> '' then
UnitName := ParamUnitName
else
UnitName := 'Castle' + FontFunctionName;
PrecedingComment := Format(
' Source font:' +NL+
' Name : %s' +NL+
' Size : %d' +NL+
' AntiAliasing : %s' +nl,
[ FontName, Size, BoolToStr(AntiAliasing, true) ]);
Font := TTextureFontData.Create(FontURL, Size, AntiAliasing, Characters);
try
OutURL := LowerCase(UnitName) + '.pas';
Font2Pascal(Font, UnitName, PrecedingComment, FontFunctionName, OutURL);
Writeln('texture-font-to-pascal: "' + OutURL + '" generated, texture size ',
Font.Image.Width, ' x ',
Font.Image.Height);
if DebugFontImage then
begin
OutURL := LowerCase(UnitName) + '.png';
SaveImage(Font.Image, OutURL);
Writeln('texture-font-to-pascal: font image "' + OutURL + '" written');
end;
finally FreeAndNil(Font) end;
finally FreeAndNil(Characters) end;
end.