378 lines
7.3 KiB
ObjectPascal
378 lines
7.3 KiB
ObjectPascal
{***************************************************************************}
|
|
{* *}
|
|
{* FreeType Performance Timer *}
|
|
{* *}
|
|
{* *}
|
|
{* This source code has been compiled and run under both Virtual Pascal *}
|
|
{* on OS/2 and Borland's BP7. *}
|
|
{* *}
|
|
{* *}
|
|
{* The C scan-line converter has been highly optimized, unlike the *}
|
|
{* Pascal one which is still 'aged'. Don't be surprised to see drastic *}
|
|
{* performance differences then.. *}
|
|
{* *}
|
|
{***************************************************************************}
|
|
|
|
program Timer;
|
|
|
|
uses
|
|
{$IFDEF OS2}
|
|
Use32,
|
|
{$ENDIF}
|
|
Crt,
|
|
Dos, (* for GetTime *)
|
|
GMain,
|
|
GEvents,
|
|
GDriver,
|
|
FreeType,
|
|
|
|
TTError, (* for CheckError *)
|
|
TTTypes; (* for commodity types *)
|
|
|
|
{$DEFINE VISUAL}
|
|
|
|
{ $DEFINE DEBUG}
|
|
|
|
{$IFDEF VISUAL}
|
|
{&PMTYPE NOVIO}
|
|
{$ENDIF}
|
|
|
|
const
|
|
Precis = 64;
|
|
Precis2 = Precis div 2;
|
|
|
|
PrecisAux = 1024;
|
|
|
|
Centre_X : int = 320;
|
|
Centre_Y : int = 225;
|
|
|
|
Max_Glyphs = 512;
|
|
|
|
var
|
|
xC : TT_PCoordinates;
|
|
yC : TT_PCoordinates;
|
|
Fl : TT_PTouchTable;
|
|
|
|
cons : PUShort;
|
|
|
|
outlines : array[0..Max_Glyphs-1] of TT_Outline;
|
|
|
|
lastp : int;
|
|
lastc : int;
|
|
|
|
res : int;
|
|
|
|
numPoints, numContours : int;
|
|
|
|
Bit : TT_Raster_Map;
|
|
|
|
Rotation : int; (* Angle modulo 1024 *)
|
|
|
|
num_glyphs : int;
|
|
|
|
gray_level : Boolean;
|
|
|
|
face : TT_Face;
|
|
instance : TT_Instance;
|
|
glyph : TT_Glyph;
|
|
|
|
metrics : TT_Glyph_Metrics;
|
|
imetrics : TT_Instance_Metrics;
|
|
|
|
props : TT_Face_Properties;
|
|
|
|
old_glyph : int;
|
|
cur_glyph : int;
|
|
tot_glyph : int;
|
|
|
|
grayLines : array[0..2048] of Byte;
|
|
|
|
error : TT_Error;
|
|
|
|
|
|
Procedure InitRows;
|
|
var
|
|
i: integer;
|
|
P: Pointer;
|
|
begin
|
|
|
|
if gray_level then
|
|
begin
|
|
Bit.rows := 200;
|
|
Bit.cols := 320;
|
|
Bit.width := 320*2;
|
|
Bit.flow := TT_Flow_Down;
|
|
Bit.size := 320*200;
|
|
end
|
|
else
|
|
begin
|
|
Bit.rows := 450;
|
|
Bit.cols := 80;
|
|
Bit.width := 640;
|
|
Bit.flow := TT_Flow_Down;
|
|
Bit.size := 80*450;
|
|
end;
|
|
|
|
GetMem( Bit.buffer, Bit.size );
|
|
if Bit.buffer = NIL then
|
|
begin
|
|
Writeln('ERREUR:InitRows:Not enough memory to allocate BitMap');
|
|
halt(1);
|
|
end;
|
|
|
|
FillChar( Bit.Buffer^, Bit.Size, 0 );
|
|
end;
|
|
|
|
|
|
Procedure ClearData;
|
|
var i: integer;
|
|
begin
|
|
FillChar( Bit.Buffer^, Bit.Size, 0 );
|
|
end;
|
|
|
|
|
|
procedure Preload_Glyphs( var start : Int );
|
|
var
|
|
i, j, fin, np, nc : integer;
|
|
outline : TT_Outline;
|
|
|
|
begin
|
|
fin := start + Max_Glyphs;
|
|
if fin > num_glyphs then fin := num_glyphs;
|
|
|
|
tot_glyph := fin-start;
|
|
|
|
cur_glyph := 0;
|
|
lastp := 0;
|
|
lastc := 0;
|
|
|
|
{$IFNDEF VISUAL}
|
|
Write('Loading ', fin-start,' glyphs ');
|
|
{$ENDIF}
|
|
|
|
for i := start to fin-1 do
|
|
begin
|
|
|
|
if TT_Load_Glyph( instance,
|
|
glyph,
|
|
i,
|
|
TT_Load_Default ) = TT_Err_Ok then
|
|
begin
|
|
TT_Get_Glyph_Outline( glyph, outline );
|
|
|
|
TT_New_Outline( outline.n_points,
|
|
outline.n_contours,
|
|
outlines[cur_glyph] );
|
|
|
|
outline.high_precision := false;
|
|
outline.second_pass := false;
|
|
|
|
TT_Copy_Outline( outline, outlines[cur_glyph] );
|
|
|
|
|
|
TT_Translate_Outline( outlines[cur_glyph],
|
|
vio_Width*16,
|
|
vio_Height*16 );
|
|
inc( cur_glyph );
|
|
end;
|
|
|
|
end;
|
|
|
|
start := fin;
|
|
end;
|
|
|
|
|
|
|
|
function ConvertRaster(index : integer) : boolean;
|
|
begin
|
|
if gray_level then
|
|
error := TT_Get_Outline_Pixmap( outlines[index], Bit )
|
|
else
|
|
error := TT_Get_Outline_Bitmap( outlines[index], Bit );
|
|
|
|
ConvertRaster := (error <> TT_Err_Ok);
|
|
end;
|
|
|
|
|
|
procedure Usage;
|
|
begin
|
|
Writeln('Simple TrueType Glyphs viewer - part of the FreeType project' );
|
|
Writeln;
|
|
Writeln('Usage : ',paramStr(0),' FontName[.TTF]');
|
|
Halt(1);
|
|
end;
|
|
|
|
|
|
function Get_Time : LongInt;
|
|
var
|
|
heure,
|
|
min,
|
|
sec,
|
|
cent :
|
|
{$IFDEF OS2}
|
|
longint;
|
|
{$ELSE}
|
|
word;
|
|
{$ENDIF}
|
|
begin
|
|
GetTime( heure, min, sec, cent );
|
|
Get_Time := 6000*longint(min) + 100*longint(sec) + cent;
|
|
end;
|
|
|
|
|
|
|
|
var i : integer;
|
|
Filename : String;
|
|
Fail : Int;
|
|
T, T0, T1 : Long;
|
|
|
|
start : Int;
|
|
|
|
begin
|
|
xC := NIL;
|
|
yC := NIL;
|
|
Fl := NIL;
|
|
|
|
TT_Init_FreeType;
|
|
|
|
if ParamCount = 0 then Usage;
|
|
|
|
gray_level := ParamStr(1)='-g';
|
|
|
|
if gray_level then
|
|
if ParamCount <> 2 then Usage else
|
|
else
|
|
if ParamCount <> 1 then Usage;
|
|
|
|
if gray_level then Filename := ParamStr(2)
|
|
else Filename := ParamStr(1);
|
|
|
|
if Pos('.',FileName) = 0 then FileName:=FileName+'.TTF';
|
|
|
|
error := TT_Open_Face( filename, face );
|
|
|
|
if error <> TT_Err_Ok then
|
|
begin
|
|
Writeln('ERROR: Could not open ', FileName );
|
|
Check_Error(error);
|
|
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
|
|
begin
|
|
Writeln('ERROR : Could not get glyph' );
|
|
Check_Error(error);
|
|
end;
|
|
|
|
i := props.max_Points * num_glyphs;
|
|
|
|
GetMem( fl, i );
|
|
i := i * sizeof(Long);
|
|
|
|
GetMem( xC, i );
|
|
GetMem( yC, i );
|
|
|
|
i := props.max_Contours * num_glyphs;
|
|
|
|
GetMem( cons, i*sizeof(UShort) );
|
|
|
|
error := TT_New_Instance( face, instance );
|
|
if error <> TT_Err_Ok then
|
|
begin
|
|
Writeln('ERROR: Could not open face instance from ', Filename );
|
|
Check_Error(error);
|
|
end;
|
|
|
|
error := TT_Set_Instance_PointSize( instance, 400 );
|
|
if error <> TT_Err_Ok then
|
|
begin
|
|
Writeln('ERROR: Could set pointsize' );
|
|
Check_Error(error);
|
|
end;
|
|
|
|
Rotation := 0;
|
|
Fail := 0;
|
|
|
|
InitRows;
|
|
|
|
{$IFDEF VISUAL}
|
|
if gray_level then
|
|
begin
|
|
if not Set_Graph_Screen( Graphics_Mode_Gray ) then
|
|
Panic1( 'could not set grayscale graphics mode' );
|
|
end
|
|
else
|
|
begin
|
|
if not Set_Graph_Screen( Graphics_Mode_Mono ) then
|
|
Panic1( 'could not set mono graphics mode' );
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
start := 0;
|
|
|
|
T := Get_Time;
|
|
T1 := 0;
|
|
|
|
while start < num_glyphs do
|
|
begin
|
|
|
|
Preload_Glyphs(start);
|
|
|
|
{$IFNDEF VISUAL}
|
|
write('... ');
|
|
{$ENDIF}
|
|
|
|
T0 := Get_Time;
|
|
|
|
for cur_glyph := 0 to tot_glyph-1 do
|
|
begin
|
|
if not ConvertRaster(cur_glyph) then
|
|
{$IFDEF VISUAL}
|
|
begin
|
|
Display_Bitmap_On_Screen( Bit.Buffer^, Bit.rows, Bit.cols );
|
|
ClearData;
|
|
end
|
|
{$ELSE}
|
|
begin
|
|
end
|
|
{$ENDIF}
|
|
else
|
|
inc( Fail );
|
|
end;
|
|
|
|
T0 := Get_Time - T0;
|
|
writeln( T0/100:0:2,' s' );
|
|
|
|
inc( T1, T0 );
|
|
|
|
for cur_glyph := 0 to tot_glyph-1 do
|
|
TT_Done_Outline( outlines[cur_glyph] );
|
|
end;
|
|
|
|
T := Get_Time - T;
|
|
|
|
{$IFDEF VISUAL}
|
|
Restore_Screen;
|
|
{$ENDIF}
|
|
|
|
writeln;
|
|
writeln('Render time : ', T1/100:0:2,' s' );
|
|
writeln('Total time : ', T /100:0:2,' s');
|
|
writeln('Glyphs/second : ', Long(num_glyphs)*100/T1:0:1 );
|
|
writeln('Fails : ',Fail );
|
|
end.
|
|
|
|
begin
|
|
end.
|
|
|