-
Notifications
You must be signed in to change notification settings - Fork 11
Expand file tree
/
Copy pathbmfontgen.pas
More file actions
159 lines (136 loc) · 4.1 KB
/
bmfontgen.pas
File metadata and controls
159 lines (136 loc) · 4.1 KB
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
unit bmfontgen;
{$mode objfpc}{$H+}
Interface
uses
Classes, SysUtils, FPWritePNG, IntfGraphics, Graphics, Generics.Collections;
type
TBmPadding = Record
up, right, down, left : integer;
end;
TBmSpacing = Record
horizontal, vertical : integer;
end;
TBmInfo = record
face : string;
size : integer;
bold : integer;
italic : integer;
charset : string;
unicode : integer;
stretchH : integer;
smooth : integer;
aa : integer;
padding : TBmPadding;
spacing : TBmSpacing;
outline : integer;
end;
TBmCommon = record
LineHeight : integer;
Base : integer;
scaleW : integer;
scaleH : integer;
pages : integer;
ppacked : integer;
alphaChnl : integer;
redChnl : integer;
greenChnl : integer;
blueChnl : integer;
end;
TBmPage = record
id : integer;
filename : string;
end;
TBmChar = record
id : integer;
x, y : integer;
width, height : integer;
xoffset, yoffset : integer;
xadvance : integer;
page : integer;
chnl : integer;
end;
TBmKern = record
first, second, amount: Integer;
end;
TBmFontGen = class
private
info : TBmInfo;
common : TBmCommon;
Page : TBmPage;
FChars: specialize TList<TBmChar>;
FKerns: specialize TList<TBmKern>;
public
constructor Create;
destructor Destroy; override;
procedure AddCharacter(C: TBmChar);
procedure AddKern(K: TBmKern);
procedure SetInfo(I: TBmInfo);
procedure SetCommon(C: TBmCommon);
procedure SetPage(P: TBmPage);
procedure SaveFont(const FileName: string);
end;
Implementation
constructor TBmFontGen.Create;
begin
FChars := specialize TList<TBmChar>.Create;
FKerns := specialize TList<TBmKern>.Create; //for future if we want to implement kerning
end;
destructor TBmFontGen.Destroy;
begin
FChars.Free;
FKerns.Free;
inherited;
end;
procedure TBmFontGen.AddCharacter(C: TBmChar);
begin
FChars.Add(C);
end;
procedure TBmFontGen.AddKern(K: TBmKern);
begin
FKerns.Add(K);
end;
procedure TBmFontGen.SetInfo(I: TBmInfo);
begin
Info:=I;
end;
procedure TBmFontGen.SetCommon(C: TBmCommon);
begin
Common:=C;
end;
procedure TBmFontGen.SetPage(P: TBmPage);
begin
Page:=P;
end;
procedure TBmFontGen.SaveFont(const FileName: string);
var
SL : TStringList;
C : TBmChar;
begin
SL := TStringList.Create;
try
SL.Add('info face="' + info.face + '" size=' + IntToStr(info.size) +
' bold='+IntToStr(info.bold)+' italic='+IntToStr(info.italic)+
' charset="'+info.charset+'" unicode='+IntToStr(info.unicode)+
' stretchH='+IntToStr(info.stretchH)+' smooth='+IntToStr(info.smooth)+
' aa='+IntToStr(info.aa)+' padding='+IntToStr(info.padding.up)+','+IntToStr(info.padding.right)+
','+IntToStr(info.padding.down)+','+IntToStr(info.padding.left)+
' spacing='+IntToStr(info.spacing.horizontal)+','+IntToStr(info.spacing.vertical)+
' outline='+IntToStr(info.outline));
SL.Add('common lineHeight=' + IntToStr(common.LineHeight) + ' base=' + IntToStr(common.Base) +
' scaleW=' + IntToStr(common.scaleW) + ' scaleH=' + IntToStr(common.scaleH) +
' pages=' + IntToStr(common.pages) + ' packed='+IntToStr(common.ppacked)+' alphaChnl='+IntToStr(common.alphaChnl)+
' redChnl='+ IntToStr(common.redChnl) + ' greenChnl=' + IntToStr(common.greenChnl) + ' blueChnl=' + IntToStr(common.blueChnl));
SL.Add('page id=' + IntToStr(page.id) + ' file="' + page.filename + '"');
SL.Add('chars count=' + IntToStr(FChars.Count));
for C in FChars do
begin
SL.Add(Format('char id=%d x=%d y=%d width=%d height=%d xoffset=%d yoffset=%d xadvance=%d page=%d chnl=%d',
[C.id, C.x, C.y, C.width, C.height, C.xoffset, C.yoffset, C.xadvance, C.page, C.chnl]));
end;
SL.Add('kernings count=0');
SL.SaveToFile(FileName, TEncoding.UTF8); // <-- only TStringList
finally
SL.Free;
end;
end;
end.