diff options
Diffstat (limited to 'tools/makefont/u_parsettf.pas')
-rw-r--r-- | tools/makefont/u_parsettf.pas | 708 |
1 files changed, 708 insertions, 0 deletions
diff --git a/tools/makefont/u_parsettf.pas b/tools/makefont/u_parsettf.pas new file mode 100644 index 00000000..e7a1584c --- /dev/null +++ b/tools/makefont/u_parsettf.pas @@ -0,0 +1,708 @@ +unit u_parsettf; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils, StrUtils, + fpg_dialogs; + +type + T_Parser= class(TObject) + private + OriginalSize: Longint; + FEncoding: string; + UnitsPerEm: Integer; + Coef: Extended; + BBox: array[0..3] of Smallint; + NumHMetrix: Integer; + NumGlyphs: Integer; + Widths: array of Smallint; + Chars: array of Word; + PostScriptName: string; + Embeddable: Boolean; + Bold: Boolean; + StemV: SmallInt; + Ascender: SmallInt; + Descender: SmallInt; + CapHeight: SmallInt; + ItalicAngle: Smallint; + Flags: Integer; + MissingWidth: SmallInt; + UnderlinePos: Smallint; + UnderlineThick: Smallint; + IsFixedPitch: Boolean; + CharWidth: array[0..255] of SmallInt; + Differences: widestring; + procedure ParseHead; + procedure ParseHhea; + procedure ParseMaxp; + procedure ParseHmtx; + procedure ParseCmap; + procedure ParseName; + procedure ParseOS2; + procedure ParsePost; + procedure ParseTtfFile(const FontFile: string); + procedure PrepareEncoding; + procedure MakedefinitionFile(FontFile: string); + function MakeDifferences: widestring; + public + procedure MakeFont(const FontFile: string; const Encoding: string; Embed: Boolean); + constructor Create(AOwner: TComponent); + end; + +var + Parser: T_Parser; + RepCourant: string; + +implementation + +uses + u_data; + +var + Flux: TFileStream; + CharNames: array[0..255] of string; + CharCodes: array[0..255] of Word; + CharBase: array[0..255] of string; + +function Puissance(Base,Exposant: Integer): Integer; +begin +if Exposant> 1 +then + Puissance:= Base*Puissance(Base,Pred(Exposant)) +else + Puissance:= Exposant; +end; + +function ReadULong(AFlux: TFileStream): Longword; +var + ALong: Longword; + Chaine: string; + Cpt,Coef: Integer; + Value: array of Longword; +begin +AFlux.Read(ALong,SizeOf(ALong)); +Chaine:= IntToHex(ALong,8); +Chaine:= Copy(Chaine,7,2)+Copy(Chaine,5,2)+Copy(Chaine,3,2)+Copy(Chaine,1,2); +SetLength(Value,8); +for Cpt:= 1 to 8 do + begin + Coef:= 9-Cpt; + case Chaine[Cpt] of + '0'..'9': + Value[Cpt]:= Puissance(16,Coef)*StrToInt(Chaine[Cpt]); + 'A': + Value[Cpt]:= Puissance(16,Coef)*10; + 'B': + Value[Cpt]:= Puissance(16,Coef)*11; + 'C': + Value[Cpt]:= Puissance(16,Coef)*12; + 'D': + Value[Cpt]:= Puissance(16,Coef)*13; + 'E': + Value[Cpt]:= Puissance(16,Coef)*14; + 'F': + Value[Cpt]:= Puissance(16,Coef)*15; + end; + end; +Result:= 0; +for Cpt:= 1 to 8 do + Result:= Result+Value[Cpt]; +end; + +function ReadUShort(AFlux: TFileStream): Word; +var + AWord: Word; + Chaine: string; + Cpt,Coef: Integer; + Value: array of Word; +begin +AFlux.Read(AWord,SizeOf(AWord)); +Chaine:= IntToHex(AWord,4); +Chaine:= Copy(Chaine,3,2)+Copy(Chaine,1,2); +SetLength(Value,4); +for Cpt:= 1 to 4 do + begin + Coef:= 5-Cpt; + case Chaine[Cpt] of + '0'..'9': + Value[Cpt]:= Puissance(16,Coef)*StrToInt(Chaine[Cpt]); + 'A': + Value[Cpt]:= Puissance(16,Coef)*10; + 'B': + Value[Cpt]:= Puissance(16,Coef)*11; + 'C': + Value[Cpt]:= Puissance(16,Coef)*12; + 'D': + Value[Cpt]:= Puissance(16,Coef)*13; + 'E': + Value[Cpt]:= Puissance(16,Coef)*14; + 'F': + Value[Cpt]:= Puissance(16,Coef)*15; + end; + end; +Result:= 0; +for Cpt:= 1 to 4 do + Result:= Result+Value[Cpt]; +end; + +function ReadShort(AFlux: TFileStream): Smallint; +var + AWord: Word; + Chaine: string; + Cpt,Coef: Integer; + Value: array of Word; +begin +AFlux.Read(AWord,SizeOf(AWord)); +Chaine:= IntToHex(AWord,4); +Chaine:= Copy(Chaine,3,2)+Copy(Chaine,1,2); +SetLength(Value,4); +for Cpt:= 1 to 4 do + begin + Coef:= 5-Cpt; + case Chaine[Cpt] of + '0'..'9': + Value[Cpt]:= Puissance(16,Coef)*StrToInt(Chaine[Cpt]); + 'A': + Value[Cpt]:= Puissance(16,Coef)*10; + 'B': + Value[Cpt]:= Puissance(16,Coef)*11; + 'C': + Value[Cpt]:= Puissance(16,Coef)*12; + 'D': + Value[Cpt]:= Puissance(16,Coef)*13; + 'E': + Value[Cpt]:= Puissance(16,Coef)*14; + 'F': + Value[Cpt]:= Puissance(16,Coef)*15; + end; + end; +Result:= 0; +for Cpt:= 1 to 4 do + Result:= Result+Value[Cpt]; +end; + +procedure T_Parser.ParseHead; +var + AWord: Word; + ALong: Longword; + MagicNumber: Longword; + Cpt: Integer; +begin +for Cpt:= 1 to 3 do + Flux.Read(ALong,SizeOf(ALong)); // skip 12 bytes - Version, FontRevision, ChecksumAdjustment +MagicNumber:= ReadULong(Flux); // 4 bytes - MagicNumber +if IntToHex(MagicNumber,4)<> '5F0F3CF5' +then + begin + ShowMessage('Incorrect magic number',True); + Exit; + end; +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - Flags +UnitsPerEm:= ReadUShort(Flux); // 2 bytes - UnitsPerEm +Coef:= 1000/UnitsPerEm; +for Cpt:= 1 to 4 do + Flux.Read(ALong,SizeOf(ALong)); // skip 16 bytes - Created, Modified +BBox[0]:= Round(Coef*ReadShort(Flux)); // 2 bytes +BBox[1]:= Round(Coef*ReadShort(Flux)); // 2 bytes +BBox[2]:= Round(Coef*ReadShort(Flux)); // 2 bytes +BBox[3]:= Round(Coef*ReadShort(Flux)); // 2 bytes +end; + +procedure T_Parser.ParseHhea; +var + AWord: Word; + ALong: Longword; + Cpt: Integer; +begin +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes +for Cpt:= 1 to 15 do + Flux.Read(AWord,SizeOf(AWord)); // skip 30 bytes +NumHMetrix:= ReadUShort(Flux); // 2 bytes +end; + +procedure T_Parser.ParseMaxp; +var + ALong: Longword; +begin +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes +NumGlyphs:= ReadUShort(Flux); // 2 bytes +end; + +procedure T_Parser.ParseHmtx; +var + AWord: Word; + Cpt: Integer; +begin +SetLength(Widths,NumGlyphs); +for Cpt:= 0 to Pred(NumHMetrix) do + begin + Widths[Cpt]:= ReadUShort(Flux); // 2 bytes + Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - Lsb + end; +if NumHMetrix< NumGlyphs +then + for Cpt:= NumHMetrix to Pred(NumGlyphs) do + Widths[Cpt]:= 0; +//MissingWidth:= Round(Coef*Widths[0]); +//for Cpt:= 0 to 255 do +// CharWidth[Cpt]:= MissingWidth; +end; + +procedure T_Parser.ParseCmap; +var + AWord: Word; + ALong: Longword; + NumTables: Word; + SubTableFormat: Word; + SegCount: Word; + Gid: Word; + EndCount: array of Word; + StartCount: array of Word; + IDDelta: array of Word; + IDRangeOffset: array of Word; + Cpt,Cpt2: Integer; + PlatformID,EncodingID: Word; + Offset,Offset31,TableStartPos,TablePos: LongWord; +begin +TableStartPos:= Flux.Position; // memorize Table start position +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - version +NumTables:= ReadUShort(Flux); // 2 bytes +Offset31:= 0; +for Cpt:= 1 to NumTables do + begin + PlatformID:= ReadUShort(Flux); // 2 bytes + EncodingID:= ReadUShort(Flux); // 2 bytes + Offset:= ReadULong(Flux); // 4 bytes - Offset of subtable + if (PlatformID= 3) and (EncodingID= 1) + then + Offset31:= Offset; + end; +if Offset31= 0 +then + begin + ShowMessage('No unicode encoding found',True); + Exit; + end; +Flux.Position:= TableStartPos+Offset31; +SubTableFormat:= ReadUShort(Flux); // 2 bytes - Format of subtable +if SubTableFormat<> 4 +then + begin + ShowMessage('Unexpected subtable format',True); + Exit; + end; +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - Length, language +SegCount:= Round(ReadUShort(Flux)/2); // 2 bytes - Segments count +for Cpt:= 1 to 3 do + Flux.Read(AWord,SizeOf(AWord)); // skip 6 bytes - SearchRange, EntrySelector, RangeShift +SetLength(EndCount,SegCount); +for Cpt:= 0 to Pred(SegCount) do + EndCount[Cpt]:= ReadUShort(Flux); // 2 bytes * SegCount +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - ReservedPad +SetLength(StartCount,SegCount); +for Cpt:= 0 to Pred(SegCount) do + StartCount[Cpt]:= ReadUShort(Flux); // 2 bytes * SegCount +SetLength(IDDelta,SegCount); +for Cpt:= 0 to Pred(SegCount) do + IDDelta[Cpt]:= ReadUShort(Flux); // 2 bytes * SegCount +TablePos:= Flux.Position; // set position to Table offset +SetLength(IDRangeOffset,SegCount); +for Cpt:= 0 to Pred(SegCount) do + IDRangeOffset[Cpt]:= ReadUShort(Flux); // 2 bytes * SegCount +for Cpt:= 0 to Pred(SegCount) do + begin + if IDRangeOffset[Cpt]> 0 + then + Flux.Position:= TablePos+2*Cpt+IDRangeOffset[Cpt]; // set position + SetLength(Chars,Length(Chars)+EndCount[Cpt]); + for Cpt2:= StartCount[Cpt] to EndCount[Cpt] do + begin + if Cpt2= 65535 + then + Break; + if IDRangeOffset[Cpt]> 0 + then + begin + Gid:= ReadUShort(Flux); + if Gid> 0 + then + Gid:= Gid+IDDelta[Cpt]; + end + else + Gid:= Cpt2+IDDelta[Cpt]; + if Gid>= 65536 + then + Gid:= Gid-65536; + if Gid> 0 + then + Chars[Cpt2]:= Gid; + end; + end; +end; + +procedure T_Parser.ParseName; +var + AWord: Word; + NameID: Word; + Count: Word; + Long: Word; + StringOffset: Word; + Offset: Word; + TableStartPos: LongWord; + Cpt,Cpt2: Integer; + Chaine: string; + CharIdent: Char; +begin +TableStartPos:= Flux.Position; // memorize Table start position +PostScriptName:= ''; +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - Format +Count:= ReadUShort(Flux); // 2 bytes +StringOffset:= ReadUShort(Flux); // 2 bytes +for Cpt:= 0 to Pred(Count) do + begin + for Cpt2:= 1 to 3 do + Flux.Read(AWord,SizeOf(AWord)); // skip 6 bytes - PlatformID, encodingID, languageID + NameID:= ReadUShort(Flux); // 2 bytes + Long:= ReadUShort(Flux); // 2 bytes + Offset:= ReadUShort(Flux); // 2 bytes + if NameID= 6 + then + begin + Flux.Position:= TableStartPos+StringOffset+Offset; // set position + Chaine:= ''; + for Cpt2:= 1 to Long do + begin + Flux.Read(CharIdent,SizeOf(CharIdent)); // 1 byte + Chaine:= Chaine+CharIdent; + end; + PostScriptName:= Chaine; + Break; + end; + end; +end; + +procedure T_Parser.ParseOS2; +var + AWord: Word; + ALong: Longword; + Version: Word; + FsType: Word; + Cpt: Integer; +begin +Version:= ReadUShort(Flux); // 2 bytes +for Cpt:= 1 to 3 do + Flux.Read(AWord,SizeOf(AWord)); // skip 6 bytes - xAvgCharWidth, usWeightClass, usWidthClass +FsType:= ReadUShort(Flux); // 2 bytes +Embeddable:= (FsType<> 2) and ((FsType and 512)= 0); +if not Embeddable +then + begin + ShowMessage('Font licence does not allow embedding',True); + Exit; + end; +for Cpt:= 1 to 13 do + Flux.Read(ALong,SizeOf(ALong)); // skip 52 bytes +Bold:= (ReadUShort(Flux) and 32)<> 0 ; // 2 bytes +if Bold +then + StemV:= 120 +else + StemV:= 70; +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - usFirstCharIndex, usLastCharIndex +Ascender:= Round(Coef*ReadShort(Flux)); // 2 bytes +Descender:= Round(Coef*ReadShort(Flux)); // 2 bytes +if Version>= 2 +then + begin + for Cpt:= 1 to 4 do + Flux.Read(ALong,SizeOf(ALong)); // skip 16 bytes + CapHeight:= Round(Coef*ReadShort(Flux)); // 2 bytes + end +else + CapHeight:= Ascender; +end; + +procedure T_Parser.ParsePost; +var + AWord: Word; + ALong: Longint; +begin +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - Version +ItalicAngle:= ReadShort(Flux); // 2 bytes +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - decimal part +UnderlinePos:= Round(Coef*ReadShort(Flux)); // 2 bytes +UnderlineThick:= Round(Coef*ReadShort(Flux)); // 2 bytes +IsFixedPitch:= ReadULong(Flux)<> 0; // 4 bytes +Flags:= 32; // non symbolic +if IsFixedPitch +then + Flags:= Flags+1; +if ItalicAngle<> 0 +then + Flags:= Flags+64; +end; + +procedure T_Parser.ParseTtfFile(const FontFile: string); +var + Version: Longint; + NumTables: Word; + AWord: Word; + ALong: Longword; + TableIdent: array of string; + TableOffset: array of Longword; + Cpt,Cpt2: Integer; + CharIdent: Char; +begin +Flux:= TFileStream.Create(FontFile,fmOpenRead); +try + OriginalSize:= Flux.Size; + Flux.Position:= 0; // Affset Table (starts at byte 0 + Flux.Read(Version,SizeOf(Version)); // 4 bytes + NumTables:= ReadUShort(Flux); // 2 bytes - Number of Tables + Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes + Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes + SetLength(TableIdent,NumTables); + SetLength(TableOffset,NumTables); + for Cpt:= 0 to Pred(NumTables) do // Table Directory (start at byte 12) + begin + for Cpt2:= 1 to 4 do + begin + Flux.Read(CharIdent,SizeOf(CharIdent)); // 1 byte + TableIdent[Cpt]:= TableIdent[Cpt]+CharIdent; + end; + Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - Checksum + TableOffset[Cpt]:= ReadULong(Flux); // 4 bytes - Offset + Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - Length + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'head' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseHead; // lecture table "Head" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'hhea' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseHhea; // lecture table "Hhea" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'maxp' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseMaxp; // lecture table "Maxp" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'hmtx' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseHmtx; // lecture table "Hmtx" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'cmap' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseCmap; // lecture table "Cmap" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'name' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseName; // lecture table "Name" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'OS/2' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseOS2; // lecture table "OS/2" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'post' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParsePost; // lecture table "Post" + Break; + end; +finally + Flux.Free; + end; +end; + +procedure T_Parser.PrepareEncoding; +var + Cpt: Integer; +begin +if FEncoding= 'cp874' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp874_n[Cpt]; + CharCodes[Cpt]:= cp874_v[Cpt]; + end; +if FEncoding= 'cp1250' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp1250_n[Cpt]; + CharCodes[Cpt]:= cp1250_v[Cpt]; + end; +if FEncoding= 'cp1251' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp1251_n[Cpt]; + CharCodes[Cpt]:= cp1251_v[Cpt]; + end; +if FEncoding= 'cp1252' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp1252_n[Cpt]; + CharCodes[Cpt]:= cp1252_v[Cpt]; + end +else + for Cpt:= 0 to 255 do + CharBase[Cpt]:= cp1252_n[Cpt]; +if FEncoding= 'cp1253' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp1253_n[Cpt]; + CharCodes[Cpt]:= cp1253_v[Cpt]; + end; +end; + +procedure T_Parser.MakedefinitionFile(FontFile: string); +var + FileDlg: TfpgFileDialog; + DestFile: TStringList; + Chaine,Fichier: widestring; + Cpt: Integer; +begin +DestFile:= TStringList.Create; +Chaine:= 'FontType=TrueType'; +DestFile.Add(Chaine); +Chaine:= 'FontName='+PostScriptName; +DestFile.Add(Chaine); +Chaine:= 'Ascent='+IntToStr(Ascender); +DestFile.Add(Chaine); +Chaine:= 'Descent='+IntToStr(Descender); +DestFile.Add(Chaine); +Chaine:= 'CapHeight='+IntToStr(CapHeight); +DestFile.Add(Chaine); +Chaine:= 'Flags='+IntToStr(Flags); +DestFile.Add(Chaine); +Chaine:= 'FontBBox='; +for Cpt:= 0 to 3 do + Chaine:= Chaine+IntToStr(BBox[Cpt])+' '; +Chaine:= Chaine+']'; +DestFile.Add(Chaine); +Chaine:= 'ItalicAngle='+IntToStr(ItalicAngle); +DestFile.Add(Chaine); +Chaine:= 'StemV='+IntToStr(StemV); +DestFile.Add(Chaine); +Chaine:= 'MissingWidth='+IntToStr(MissingWidth); +DestFile.Add(Chaine); +Chaine:= 'FontUp='+IntToStr(UnderlinePos); +DestFile.Add(Chaine); +Chaine:= 'FontUt='+IntToStr(UnderlineThick); +DestFile.Add(Chaine); +Chaine:= 'Encoding='+FEncoding; +DestFile.Add(Chaine); +Chaine:= 'FontFile='+Copy(FontFile,1,Length(FontFile)-4)+'.z'; +//Chaine:= 'FontFile='+FontFile; +DestFile.Add(Chaine); +Chaine:= 'OriginalSize='+IntToStr(OriginalSize); +DestFile.Add(Chaine); +if Differences> '' +then + begin + Chaine:= 'Diffs='+Differences; + DestFile.Add(Chaine); + end; +Chaine:= 'CharWidth='; +for Cpt:= 32 to 255 do + Chaine:= Chaine+IntToStr(CharWidth[Cpt])+' '; +Chaine:= Chaine+']'; +DestFile.Add(Chaine); +FileDlg:= TfpgFileDialog.Create(nil); +FileDlg.InitialDir:= RepCourant; +FileDlg.Filter:= 'Fichiers fnt |*.fnt'; +FontFile:= StringReplace(FontFile,'-Regular','',[rfIgnoreCase]); +Fichier:= Copy(FontFile,1,Length(FontFile)-3)+'fnt'; +FileDlg.FileName:= Fichier; +try + if FileDlg.RunSaveFile + then + DestFile.SaveToFile(Fichier); +finally + FileDlg.Free; + DestFile.Free; + end; +end; + +function T_Parser.MakeDifferences: widestring; +var + Cpt,Last: Integer; +begin +Result:= ''; +Last:= 0; +for Cpt:=32 to 255 do + if CharNames[Cpt]<> CharBase[Cpt] + then + begin + if Cpt<> Succ(Cpt) + then + Result:= Result+IntToStr(Cpt)+' '; + Last:= Cpt; + Result:= Result+'/'+CharNames[Cpt]+' '; + end; +end; + +procedure T_Parser.MakeFont(const FontFile: string; const Encoding:string; Embed: Boolean); +var + Cpt: Integer; +begin +FEncoding:= Encoding; +PrepareEncoding; +ParseTtfFile(FontFile); +MissingWidth:= Round(Coef*Widths[Chars[CharCodes[32]]]); +for Cpt:= 0 to 255 do + begin + if (Widths[Chars[CharCodes[Cpt]]]> 0) and (CharNames[Cpt]<> '.notdef') + then + CharWidth[Cpt]:= Round(Coef*Widths[Chars[CharCodes[Cpt]]]) + else + CharWidth[Cpt]:= MissingWidth; + end; +if Encoding<> 'cp1252' +then + Differences:= MakeDifferences; +MakeDefinitionFile(FontFile); +end; + +constructor T_Parser.Create(AOwner: TComponent); +begin +inherited Create; +end; + +end. + |