572 lines
12 KiB
ObjectPascal
572 lines
12 KiB
ObjectPascal
|
|
{ Prints contents of a OTF font in a readable form }
|
|
|
|
unit frxOTFPrinter;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils,
|
|
frxStorage,
|
|
Classes,
|
|
frxOTF;
|
|
|
|
type
|
|
|
|
{ Printing visitor }
|
|
|
|
TPrintVisitor = class(TVisitor)
|
|
private
|
|
FOut: TFmtStream;
|
|
FIndent: Integer;
|
|
|
|
procedure PrintProp(Key: string; Value: string); overload;
|
|
procedure PrintProp(Key: string; Value: Int64); overload;
|
|
procedure PrintPropHex(Key: string; Value: Int64);
|
|
procedure PrintPropBits(Key: string; Value: Int64);
|
|
public
|
|
constructor Create(Stream: TFmtStream);
|
|
|
|
procedure Visit(Obj: TFontView); override;
|
|
procedure Visit(Obj: TCharmapTableView); override;
|
|
procedure Visit(Obj: TSegCharmapTableView); override;
|
|
procedure Visit(Obj: TFontCollectionView); override;
|
|
procedure Visit(Obj: TStringTableView); override;
|
|
procedure Visit(Obj: TAsciiCharmapTableView); override;
|
|
procedure Visit(Obj: THeadTableView); override;
|
|
procedure Visit(Obj: TWinMetrics1TableView); override;
|
|
|
|
property Indent: Integer read FIndent write FIndent;
|
|
end;
|
|
|
|
procedure PrintFontInfo(Font: TView; Stream: TStream); overload;
|
|
procedure PrintFontInfo(Font: TStream; Stream: TStream); overload;
|
|
procedure PrintFontInfo(Font: TStream; ResFile: string); overload;
|
|
procedure PrintFontInfo(Font: TView; ResFile: string); overload;
|
|
procedure PrintFontInfo(FontFile: string; Stream: TStream); overload;
|
|
procedure PrintFontInfo(FontFile: string; ResFile: string); overload;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math,
|
|
frxCryptoUtils;
|
|
|
|
procedure PrintFontInfo(FontFile: string; ResFile: string);
|
|
var
|
|
Res: TStream;
|
|
begin
|
|
Res := TFileStream.Create(ResFile, fmCreate);
|
|
|
|
try
|
|
PrintFontInfo(FontFile, Res);
|
|
finally
|
|
Res.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure PrintFontInfo(Font: TView; ResFile: string);
|
|
var
|
|
Res: TStream;
|
|
begin
|
|
Res := TFileStream.Create(ResFile, fmCreate);
|
|
|
|
try
|
|
PrintFontInfo(Font, Res)
|
|
finally
|
|
Res.Free
|
|
end;
|
|
end;
|
|
|
|
procedure PrintFontInfo(Font: TStream; ResFile: string);
|
|
var
|
|
Res: TStream;
|
|
begin
|
|
Res := TFileStream.Create(ResFile, fmCreate);
|
|
|
|
try
|
|
PrintFontInfo(Font, Res)
|
|
finally
|
|
Res.Free
|
|
end;
|
|
end;
|
|
|
|
procedure PrintFontInfo(Font: TStream; Stream: TStream);
|
|
var
|
|
View: TView;
|
|
begin
|
|
View := OpenFont(Font);
|
|
|
|
try
|
|
PrintFontInfo(View, Stream)
|
|
finally
|
|
View.Free
|
|
end;
|
|
end;
|
|
|
|
procedure PrintFontInfo(FontFile: string; Stream: TStream);
|
|
var
|
|
Font: TStream;
|
|
begin
|
|
Font := TFileStream.Create(FontFile, fmShareDenyWrite);
|
|
|
|
try
|
|
PrintFontInfo(Font, Stream)
|
|
finally
|
|
Font.Free
|
|
end;
|
|
end;
|
|
|
|
procedure PrintFontInfo(Font: TView; Stream: TStream);
|
|
|
|
function SHA1(Stream: TStream): string;
|
|
begin
|
|
Result := string(HashStream('SHA1', Stream))
|
|
end;
|
|
|
|
function BoolStr(b: Boolean): string;
|
|
begin
|
|
if b then
|
|
Result := 'Yes'
|
|
else
|
|
Result := 'No'
|
|
end;
|
|
|
|
function GetGlyphHash(Font: TFontView; Glyph: Word): string;
|
|
begin
|
|
Result := SHA1(Font.Glyph[Glyph].Stream);
|
|
end;
|
|
|
|
procedure PrintCharmap(Res: TFmtStream; Font: TFontView; FirstChar, LastChar: Word);
|
|
var
|
|
Char, Glyph: Word;
|
|
begin
|
|
Res.Puts('%-10s %-10s %-10s', ['Char', 'CharCode', 'GID']);
|
|
Res.Puts;
|
|
|
|
for Char := FirstChar to LastChar do
|
|
begin
|
|
Glyph := Font.GetGlyphIndex(Char);
|
|
|
|
Res.Puts('%-10s %-10d %-10d', [System.Char(Char), Char, Glyph]);
|
|
end;
|
|
end;
|
|
|
|
procedure PrintGlyphs(Output: TFmtStream; Font: TFontView);
|
|
var
|
|
i: Integer;
|
|
Hash: string;
|
|
AW, AH: Integer;
|
|
W, H: Integer;
|
|
Offset, Length: Cardinal;
|
|
IsComposite: Boolean;
|
|
LSB, TSB: Integer;
|
|
begin
|
|
with Output do
|
|
begin
|
|
Puts('%6s - %s', ['GID', 'index']);
|
|
Puts('%6s - %s', ['W', 'width in font units']);
|
|
Puts('%6s - %s', ['H', 'height in font units']);
|
|
Puts('%6s - %s', ['AW', 'advance width in font units']);
|
|
Puts('%6s - %s', ['AH', 'advance height in font units']);
|
|
Puts('%6s - %s', ['LSB', 'left side bearing in font units']);
|
|
Puts('%6s - %s', ['TSB', 'top side bearing in font units']);
|
|
Puts('%6s - %s', ['Offset', 'offset to glyph data from beginning of the "glyf" table']);
|
|
Puts('%6s - %s', ['Length', 'number of bytes in the glyph data']);
|
|
Puts('%6s - %s', ['IsC', 'is glyph composite']);
|
|
Puts('%6s - %s', ['SHA1', 'SHA1 from the glyph data']);
|
|
Puts;
|
|
|
|
Puts('%5s %5s %5s %5s %5s %5s %5s %6s %6s %3s %s',
|
|
['GID', 'W', 'H', 'AW', 'AH', 'LSB', 'TSB', 'Offset', 'Length', 'IsC', 'SHA1']);
|
|
Puts;
|
|
end;
|
|
|
|
for i := 0 to Font.GlyphsCount - 1 do
|
|
begin
|
|
Hash := GetGlyphHash(Font, i);
|
|
|
|
with Font.GlyphMetrics[i] do
|
|
begin
|
|
AW := AdvWidth;
|
|
AH := AdvHeight;
|
|
LSB := LeftSB;
|
|
TSB := TopSB;
|
|
end;
|
|
|
|
with Font.Glyph[i] do
|
|
begin
|
|
W := Width;
|
|
H := Height;
|
|
end;
|
|
|
|
Offset := Font.GlyphPosTable.GlyphOffset[i];
|
|
Length := Font.GlyphPosTable.GlyphLength[i];
|
|
IsComposite := Font.Glyph[i].Composite;
|
|
|
|
Output.Puts('%5d %5d %5d %5d %5d %5d %5d %6x %6d %3s %s',
|
|
[i, W, H, AW, AH, LSB, TSB, Offset, Length, BoolStr(IsComposite), Hash]);
|
|
end;
|
|
end;
|
|
|
|
procedure PrintTitle(Fmt: TFmtStream; Title: string; Width: Integer = 120);
|
|
const
|
|
L = '---';
|
|
R = '---';
|
|
begin
|
|
with Fmt do
|
|
begin
|
|
Puts;
|
|
PutsRaw(L);
|
|
Dec(Width, Length(L));
|
|
|
|
if Title <> '' then
|
|
begin
|
|
PutsRaw(' ' + Title + ' ');
|
|
Dec(Width, 2 + Length(Title));
|
|
end;
|
|
|
|
while Width > 0 do
|
|
begin
|
|
PutsRaw('-');
|
|
Dec(Width);
|
|
end;
|
|
|
|
Puts;
|
|
Puts;
|
|
end;
|
|
end;
|
|
|
|
procedure AnalyseFont(ResFmt: TFmtStream; Font: TFontView);
|
|
begin
|
|
PrintTitle(ResFmt, 'ASCII printset mapping');
|
|
PrintCharmap(ResFmt, Font, 32, 126);
|
|
|
|
//PrintTitle(ResFmt, 'Glyphs');
|
|
//PrintGlyphs(ResFmt, Font);
|
|
end;
|
|
|
|
procedure AnalyseFontCollection(ResFmt: TFmtStream; FC: TFontCollectionView);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FC.FontsCount - 1 do
|
|
begin
|
|
PrintTitle(ResFmt, 'Font #' + IntToStr(i));
|
|
AnalyseFont(ResFmt, FC.Font[i]);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Printer: TVisitor;
|
|
ResFmt: TFmtStream;
|
|
begin
|
|
ResFmt := nil;
|
|
Printer := nil;
|
|
|
|
try
|
|
ResFmt := TFmtStream.Create(Stream, False);
|
|
ResFmt.Formatted := True;
|
|
ResFmt.Puts('SHA1 ' + SHA1(Font.Stream));
|
|
ResFmt.Puts;
|
|
|
|
Printer := TPrintVisitor.Create(ResFmt);
|
|
Font.Accept(Printer);
|
|
|
|
if Font is TFontView then
|
|
AnalyseFont(ResFmt, Font as TFontView)
|
|
else if Font is TFontCollectionView then
|
|
AnalyseFontCollection(ResFmt, Font as TFontCollectionView)
|
|
else
|
|
ResFmt.Puts('Unknown font type %s', [Font.ClassName]);
|
|
finally
|
|
ResFmt.Free;
|
|
Printer.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TPrintVisitor }
|
|
|
|
constructor TPrintVisitor.Create(Stream: TFmtStream);
|
|
begin
|
|
FOut := Stream;
|
|
FIndent := 4;
|
|
end;
|
|
|
|
procedure TPrintVisitor.PrintProp(Key, Value: string);
|
|
begin
|
|
FOut.Puts('%s = %s', [Key, Value])
|
|
end;
|
|
|
|
procedure TPrintVisitor.PrintProp(Key: string; Value: Int64);
|
|
begin
|
|
FOut.Puts('%s = %d', [Key, Value])
|
|
end;
|
|
|
|
procedure TPrintVisitor.PrintPropHex(Key: string; Value: Int64);
|
|
begin
|
|
FOut.Puts('%s = 0x%X', [Key, Value])
|
|
end;
|
|
|
|
procedure TPrintVisitor.Visit(Obj: TWinMetrics1TableView);
|
|
begin
|
|
with Obj.Header do
|
|
begin
|
|
PrintProp('version', Version);
|
|
PrintProp('AvgWidth', AvgWidth);
|
|
PrintProp('Weight', Weight);
|
|
PrintProp('Width', Width);
|
|
PrintProp('Family', Family);
|
|
PrintProp('Vendor', string(Vendor));
|
|
PrintProp('Ascender', Ascender);
|
|
PrintProp('Descender', Descender);
|
|
PrintProp('WinAscent', WinAscent);
|
|
PrintProp('WinDescent', WinDescent);
|
|
PrintProp('LineGap', LineGap);
|
|
{
|
|
PrintProp('Height', Height);
|
|
PrintProp('CapHeight', CapHeight);
|
|
PrintProp('DefChar', DefChar);
|
|
PrintProp('BreakChar', BreakChar);
|
|
}
|
|
|
|
PrintPropBits('Selection', Selection);
|
|
PrintPropBits('Rights', Rights);
|
|
end;
|
|
end;
|
|
|
|
procedure TPrintVisitor.PrintPropBits(Key: string; Value: Int64);
|
|
var
|
|
j: Integer;
|
|
s: string;
|
|
begin
|
|
if Value = 0 then
|
|
begin
|
|
FOut.Puts('%s = 0', [Key]);
|
|
Exit;
|
|
end;
|
|
|
|
s := Format('%s = %d (bits', [Key, Value]);
|
|
|
|
for j := 0 to 8 * SizeOf(Value) do
|
|
begin
|
|
if Value and 1 = 1 then
|
|
s := s + ' ' + IntToStr(j);
|
|
|
|
Value := Value shr 1;
|
|
end;
|
|
|
|
s := s + ')';
|
|
FOut.Puts(s);
|
|
end;
|
|
|
|
procedure TPrintVisitor.Visit(Obj: TFontView);
|
|
|
|
function Percent(n: Cardinal): Cardinal;
|
|
begin
|
|
Result := 100 * n div Obj.Size
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
Len: Cardinal;
|
|
t: TTableRecordEntry;
|
|
begin
|
|
with Obj do
|
|
try
|
|
Len := 0;
|
|
|
|
try
|
|
for i := 0 to TablesCount - 1 do
|
|
Inc(Len, GetTable(i).Size);
|
|
except
|
|
end;
|
|
|
|
FOut.Puts('Family: %s', [FamilyName]);
|
|
FOut.Puts('Subfamily: %s', [SubfamilyName]);
|
|
FOut.Puts('%d glyphs', [GlyphsCount]);
|
|
FOut.Puts('All tables occupy %d bytes', [Len]);
|
|
FOut.Puts;
|
|
|
|
FOut.IncIndent(+Indent);
|
|
|
|
for i := 0 to TablesCount - 1 do
|
|
try
|
|
t := GetTableHeader(i);
|
|
|
|
FOut.Puts('%s %s %x-%x %d %d%% sum:%x (sha1:%s)', [
|
|
Format('#%d', [i]),
|
|
AnsiString(t.Tag),
|
|
t.Offset,
|
|
t.Offset + t.Length - 1,
|
|
t.Length,
|
|
Percent(t.Length),
|
|
t.Checksum,
|
|
HashStream('SHA1', GetTable(i).Stream)]);
|
|
|
|
FOut.IncIndent(+Indent);
|
|
GetTable(i).Accept(Self);
|
|
FOut.IncIndent(-Indent);
|
|
except
|
|
on e: Exception do
|
|
FOut.Puts(e.ClassName + ': ' + e.Message);
|
|
end;
|
|
|
|
FOut.IncIndent(-Indent);
|
|
except
|
|
on e: Exception do
|
|
FOut.Puts(e.ClassName + ': ' + e.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TPrintVisitor.Visit(Obj: TCharmapTableView);
|
|
var
|
|
i: Integer;
|
|
t: TCharmapSubtableView;
|
|
begin
|
|
with Obj do
|
|
for i := 0 to SubtablesCount - 1 do
|
|
begin
|
|
t := Subtable[i];
|
|
|
|
with GetSubtableRecordEntry(i) do
|
|
FOut.Puts('%-6s %-6s %-5s %-6s +%-8x %-6d (sha1:%s)', [
|
|
Format('fmt:%d', [t.Format]),
|
|
Format('plat:%d', [Platform]),
|
|
Format('enc:%d', [Encoding]),
|
|
Format('lang:%d', [t.Language]),
|
|
Offset,
|
|
t.Size,
|
|
HashStream('SHA1', t.Stream)]);
|
|
|
|
FOut.IncIndent(+Indent);
|
|
t.Accept(Self);
|
|
FOut.IncIndent(-Indent);
|
|
end;
|
|
end;
|
|
|
|
procedure TPrintVisitor.Visit(Obj: TSegCharmapTableView);
|
|
|
|
function Sign(a: Integer): string;
|
|
begin
|
|
if a < 0 then
|
|
Result := '-'
|
|
else
|
|
Result := '+'
|
|
end;
|
|
|
|
function Abs(a: Integer): Integer;
|
|
begin
|
|
if a < 0 then
|
|
Result := -a
|
|
else
|
|
Result := a
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with Obj do
|
|
for i := 0 to SegCount - 1 do
|
|
FOut.Puts('%4x-%-4x %s%-5d r:%-d', [
|
|
First[i],
|
|
Last[i],
|
|
Sign(Delta[i]),
|
|
Abs(Delta[i]),
|
|
Offset[i]])
|
|
end;
|
|
|
|
procedure TPrintVisitor.Visit(Obj: TFontCollectionView);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with Obj do
|
|
begin
|
|
FOut.Puts('Fonts collection with %d fonts', [FontsCount]);
|
|
|
|
for i := 0 to FontsCount - 1 do
|
|
begin
|
|
FOut.IncIndent(+Indent);
|
|
Font[i].Accept(Self);
|
|
FOut.IncIndent(-Indent);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPrintVisitor.Visit(Obj: TStringTableView);
|
|
|
|
function Fix(const s: AnsiString): AnsiString;
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
SetLength(Result, Length(s));
|
|
j := 1;
|
|
|
|
for i := 1 to Length(s) do
|
|
if Word(s[i]) in [32..126] then
|
|
begin
|
|
Result[j] := s[i];
|
|
Inc(j);
|
|
end;
|
|
|
|
SetLength(Result, j - 1);
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
r: TStringTableEntry;
|
|
begin
|
|
with Obj do
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
r := Entry[i];
|
|
|
|
FOut.Puts('%-5s %-6s %-5s %-8s %-7s %s', [
|
|
Format('id:%d', [r.Id]),
|
|
Format('plat:%d', [r.Platform]),
|
|
Format('enc:%d', [r.Encoding]),
|
|
Format('lang:%x', [r.Language]),
|
|
Format('len:%d', [Length(Strings[i])]),
|
|
Fix(Strings[i])]);
|
|
end;
|
|
end;
|
|
|
|
procedure TPrintVisitor.Visit(Obj: TAsciiCharmapTableView);
|
|
var
|
|
i, n: Integer;
|
|
begin
|
|
n := 0;
|
|
|
|
for i := 0 to 255 do
|
|
if Obj[i] > 0 then
|
|
begin
|
|
FOut.Puts('%3d %-3d ', [i, Obj[i]]);
|
|
Inc(n);
|
|
end;
|
|
|
|
if n = 0 then
|
|
FOut.Puts('All charcodes are mapped to zero by this mapping');
|
|
end;
|
|
|
|
procedure TPrintVisitor.Visit(Obj: THeadTableView);
|
|
begin
|
|
with Obj.Header do
|
|
begin
|
|
PrintPropHex('Version', Version);
|
|
PrintPropHex('Checksum', Checksum);
|
|
PrintPropHex('Signature', Signature);
|
|
PrintProp('XMin', FontBox.XMin);
|
|
PrintProp('XMax', FontBox.XMax);
|
|
PrintProp('YMin', FontBox.YMin);
|
|
PrintProp('YMax', FontBox.YMax);
|
|
PrintProp('Long offsets', LongOffset);
|
|
PrintProp('Glyph format', Format);
|
|
PrintProp('Units per em', UnitsPerEm);
|
|
PrintProp('Smallest size', Smallest);
|
|
PrintPropBits('Flags', Flags);
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|