program View;
uses Crt,
Common,
Use32,
GMain,
GEvents,
GDriver,
FreeType;
const
Precis = 64;
Precis2 = Precis div 2;
PrecisAux = 1024;
Profile_Buff_Size = 32000;
Max_Files = 1024;
var
face : TT_Face;
instance : TT_Instance;
glyph : TT_Glyph;
metrics : TT_Glyph_Metrics;
imetrics : TT_Instance_Metrics;
props : TT_Face_Properties;
ymin, ymax, xmax, xmin, xsize : longint;
res, old_res : int;
numPoints, numContours : int;
Bit : TT_Raster_Map;
Rotation : int;
num_glyphs : int;
error : TT_Error;
gray_level : Boolean;
display_outline : boolean;
hint_glyph : boolean;
scan_type : Byte;
old_glyph : int;
cur_glyph : int;
scale_shift : Int;
grayLines : array[0..2048] of Byte;
procedure Set_Raster_Area;
begin
Bit.rows := vio_Height;
Bit.width := vio_Width;
Bit.flow := TT_Flow_Up;
if gray_level then
Bit.cols := Bit.width
else
Bit.cols := (Bit.width+7) div 8;
Bit.size := Bit.rows * Bit.cols;
end;
procedure Clear_Data;
begin
if gray_level then
fillchar( Bit.buffer^, Bit.size, gray_palette[0] )
else
fillchar( Bit.buffer^, Bit.size, 0 );
end;
procedure Init_Engine( maxRes : Int );
begin
Set_Raster_Area;
GetMem( Bit.buffer, Bit.size );
Clear_Data;
end;
function Reset_Scale( res : Int ) : Boolean;
begin
error := TT_Set_Instance_CharSize( instance, res*64 );
Reset_Scale := (error = TT_Err_Ok);
end;
Function LoadTrueTypeChar( index : integer;
hint : boolean ) : TT_Error;
var
j, load_flag : int;
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;
var
Error_String : String;
ine : Int;
function Render_ABC( glyph_index : integer ) : boolean;
var
i, j : integer;
x, y : longint;
start_x,
start_y,
step_x,
step_y : longint;
fail : Int;
begin
Render_ABC := True;
TT_Get_Instance_Metrics( instance, imetrics );
start_x := 4;
start_y := vio_Height - 30 - imetrics.y_ppem;
step_x := imetrics.x_ppem + 4;
step_y := imetrics.y_ppem + 10;
x := start_x;
y := start_y;
fail := 0;
ine := glyph_index;
while ine < num_glyphs do
begin
if LoadTrueTypeChar( ine, hint_glyph ) = TT_Err_Ok then
begin
TT_Get_Glyph_Metrics( glyph, metrics );
if gray_level then
TT_Get_Glyph_Pixmap( glyph, Bit, x*64, y*64 )
else
TT_Get_Glyph_Bitmap( glyph, Bit, x*64, y*64 );
inc( x, (metrics.advance div 64) + 1 );
if x > vio_Width - 40 then
begin
x := start_x;
dec( y, step_y );
if y < 10 then
begin
Render_ABC := False;
exit;
end;
end;
end
else
inc( fail );
inc(ine);
end;
Render_ABC := False;
end;
procedure Erreur( s : String );
begin
Restore_Screen;
Writeln( 'Error : ', s, ', error code = ', error );
Halt(1);
end;
procedure Usage;
begin
Writeln('Simple TrueType Glyphs viewer - part of the FreeType project' );
Writeln;
Writeln('Usage : ',paramStr(0),' FontName[.TTF]');
Halt(1);
end;
var
i: integer;
heure,
min1,
min2,
sec1,
sec2,
cent1,
cent2 :
longint;
word;
C : Char;
Filename : String;
label Fin;
var
Fail : Int;
glyphStr : String[4];
ev : Event;
Code : Int;
init_memory, end_memory : LongInt;
num_args : Integer;
point_size : Integer;
cur_file : Integer;
first_arg : Int;
sortie : Boolean;
valid : Boolean;
errmsg : String;
label
Lopo;
begin
TextMode( co80+Font8x8 );
TT_Init_FreeType;
num_args := ParamCount;
if num_args = 0 then
Usage;
first_arg := 1;
gray_level := False;
if ParamStr(first_arg) = '-g' then
begin
inc( first_arg );
gray_level := True;
end;
if first_arg > num_args+1 then
Usage;
val( ParamStr(first_arg), point_size, Code );
if Code <> 0 then
point_size := 24
else
inc( first_arg );
Expand_Wildcards( first_arg, '.ttf' );
cur_file := 0;
if num_arguments = 0 then
begin
Writeln('Could not find file(s)');
Halt(3);
end;
if gray_level then
begin
if not Set_Graph_Screen( Graphics_Mode_Gray ) then
Erreur( 'could not set grayscale graphics mode' );
end
else
begin
if not Set_Graph_Screen( Graphics_Mode_Mono ) then
Erreur( 'could not set mono graphics mode' );
end;
Init_Engine( 24 );
repeat
valid := True;
FileName := arguments[cur_file]^;
if Pos('.',FileName) = 0 then FileName:=FileName+'.TTF';
error := TT_Open_Face( filename, face );
if error <> TT_Err_Ok then
begin
str( error, errmsg );
errmsg := 'Could not open '+filename+', error code = '+errmsg;
valid := false;
goto Lopo;
end;
TT_Get_Face_Properties( face, props );
num_glyphs := props.num_Glyphs;
i := length(FileName);
while (i > 1) and (FileName[i] <> '\') do dec(i);
FileName := Copy( FileName, i+1, length(FileName) );
error := TT_New_Glyph( face, glyph );
if error <> TT_Err_Ok then
Erreur('Could not create glyph container');
error := TT_New_Instance( face, instance );
if error <> TT_Err_Ok then
begin
str( error, errmsg );
errmsg := 'Could not create instance, error code = '+errmsg;
valid := false;
goto Lopo;
end;
TT_Set_Instance_Resolutions( instance, 96, 96 );
Rotation := 0;
Fail := 0;
res := point_size;
scan_type := 2;
Reset_Scale( res );
Lopo:
display_outline := true;
hint_glyph := true;
old_glyph := -1;
old_res := res;
cur_glyph := 0;
sortie := false;
Repeat
if valid then
begin
if Render_ABC( cur_glyph ) then
inc( Fail )
else
Display_Bitmap_On_Screen( Bit.Buffer^, Bit.rows, Bit.cols );
Clear_Data;
Print_XY( 0, 0, FileName );
TT_Get_Instance_Metrics( instance, imetrics );
Print_Str(' pt size = ');
Str( imetrics.pointSize div 64:3, glyphStr );
Print_Str( glyphStr );
Print_Str(' ppem = ');
Str( imetrics.y_ppem:3, glyphStr );
Print_Str( glyphStr );
Print_Str(' glyph = ');
Str( cur_glyph, glyphStr );
Print_Str( glyphStr );
Print_XY( 0, 1, 'Hinting (''z'') : ' );
if hint_glyph then Print_Str('on ')
else Print_Str('off');
Print_XY( 0, 2, 'scan type(''e'') : ' );
case scan_type of
0 : Print_Str('none ');
1 : Print_Str('level 1');
2 : Print_Str('level 2');
4 : Print_Str('level 4');
5 : Print_Str('level 5');
end;
end
else
begin
Clear_Data;
Display_Bitmap_On_Screen( Bit.buffer^, Bit.rows, Bit.cols );
Print_XY( 0, 0, errmsg );
end;
Get_Event(ev);
case ev.what of
event_Quit : goto Fin;
event_Keyboard : case char(ev.info) of
'n' : begin
sortie := true;
if cur_file+1 < num_arguments then
inc( cur_file );
end;
'p' : begin
sortie := true;
if cur_file > 0 then
dec( cur_file );
end;
'z' : hint_glyph := not hint_glyph;
'e' : begin
inc( scan_type );
if scan_type = 3 then scan_type := 4;
if scan_type >= 6 then scan_type := 0;
end;
end;
event_Scale_Glyph : begin
inc( res, ev.info );
if res < 1 then res := 1;
if res > 1400 then res := 1400;
end;
event_Change_Glyph : begin
inc( cur_glyph, ev.info );
if cur_glyph < 0 then cur_glyph := 0;
if cur_glyph >= num_glyphs
then cur_glyph := num_glyphs-1;
end;
end;
if res <> old_res then
begin
if not Reset_Scale(res) then
Erreur( 'Could not resize font' );
old_res := res;
end;
Until sortie;
TT_Done_Glyph( glyph );
TT_Close_Face( face );
until false;
Fin:
Restore_Screen;
Writeln;
Writeln('Fails : ', Fail );
TT_Done_FreeType;
end.