program Abc;
uses Crt,
Common,
Use32,
FreeType,
TTObjs;
const
Precis = 64;
Precis2 = Precis div 2;
PrecisAux = 1024;
Screen_Width = 640;
Screen_Height = 480;
Screen_Cols = Screen_Width div 8;
Screen_Size = Screen_Cols * Screen_Height;
Grid_Width = Screen_Width div 8;
Grid_Height = Screen_Height div 8;
Grid_Cols = Grid_Width div 8;
Grid_Size = Grid_Cols * Grid_Height;
Screen_Center_X = Screen_Width div 2;
Screen_Center_Y = Screen_Height div 2;
Grid_Center_X = Grid_Width div 2;
Grid_Center_Y = Grid_Height div 2;
Profile_Buff_Size = 64000;
var
res, old_res : integer;
numPoints, numContours : integer;
Bitmap_small : TT_Raster_Map;
Bitmap_big : TT_Raster_Map;
Rotation : integer;
num_glyphs : integer;
face : TT_Face;
instance : TT_Instance;
glyph : TT_Glyph;
metrics : TT_Glyph_Metrics;
imetrics : TT_Instance_Metrics;
props : TT_Face_Properties;
point_size : integer;
error : TT_Error;
display_outline : boolean;
hint_glyph : boolean;
scan_type : Byte;
old_glyph : integer;
FOut : Text;
Function LoadTrueTypeChar( index : integer;
hint : boolean ) : TT_Error;
var
j, load_flag : integer;
result : TT_Error;
begin
if hint then load_flag := TT_Load_Scale_Glyph or TT_Load_Hint_Glyph
else load_flag := TT_Load_Scale_Glyph;
result := TT_Load_Glyph( instance,
glyph,
index,
load_flag );
LoadTrueTypeChar := result;
end;
procedure Usage;
begin
Writeln('Simple TrueType Glyphs viewer - part of the FreeType project' );
Writeln;
Writeln('Usage : ',paramStr(0),' size fontname[.ttf] [fontname.. ]');
Writeln;
Halt(1);
end;
var i: integer;
heure,
min1,
min2,
sec1,
sec2,
cent1,
cent2 :
longint;
word;
C : Char;
Filename : String;
label Fin;
var
Fail : Integer;
PtSize : Integer;
Param : Integer;
code : Integer;
glyphStr : String[4];
cur_file : Integer;
valid : Boolean;
Mem0 : Longint;
label
Lopo;
begin
Mem0 := MemAvail;
TT_Init_FreeType;
if ParamCount < 2 then Usage;
val( ParamStr(1), point_size, code );
if code <> 0 then Usage;
if ( point_size <= 0 ) then
begin
Writeln('Invalid argument : pointsize must be >= 1');
Usage;
end;
Expand_WildCards( 2, '.ttf' );
for cur_file := 0 to num_arguments-1 do
begin
FileName := arguments[cur_file]^;
if Pos('.',FileName) = 0 then FileName:=FileName+'.TTF';
Write( MemAvail:6, ' ' );
error := TT_Open_Face( filename, face );
i := length(FileName);
while (i > 1) and (FileName[i] <> '\') do dec(i);
FileName := Copy( FileName, i+1, length(FileName) );
Write( cur_file:3,' ', filename:12, ': ' );
if error <> TT_Err_Ok then
begin
Writeln( 'could not open file, error code = ', error );
goto Lopo;
end;
TT_Get_Face_Properties( face, props );
num_glyphs := props.num_Glyphs;
error := TT_New_Glyph( face, glyph );
if error <> TT_Err_Ok then
begin
Writeln( 'could not create glyph, error code = ',
error );
goto Lopo;
end;
error := TT_New_Instance( face, instance );
if error <> TT_Err_Ok then
begin
Writeln( 'could not create instance, error code = ',
error );
goto Lopo;
end;
error := TT_Set_Instance_PointSize( instance, point_size );
if error <> TT_Err_Ok then
begin
Writeln( 'could not set point size, error code = ', error );
goto Lopo;
end;
Fail := 0;
for i := 0 to num_glyphs-1 do
begin
error := LoadTrueTypeChar( i, true );
if error <> TT_Err_Ok then
begin
inc( Fail );
if Fail < 10 then
Writeln( 'error hinting glyph ', i, ', code = ',
error );
end;
with PGlyph(glyph.z)^ do
begin
if (precalc_width >= 0) and
(precalc_width <> computed_width) then
begin
Write( i:5,' hdmx = ',precalc_width:3 );
Write( ', engine = ',computed_width );
if is_composite then Write( ' (composite)' );
Writeln;
end
end;
end;
if Fail >= 10 then
Writeln( 'there were ',Fail,' failed glyphs' );
if Fail = 0 then
Writeln( 'ok' );
Lopo:
TT_Close_Face( face );
end;
Fin:
Writeln('Memory consumed by lint = ', Mem0 - MemAvail );
TT_Done_FreeType;
Writeln('Memory leaked after engine termination = ', Mem0 - MemAvail );
end.