freetype1/pascal/test/timer.pas

   1 {***************************************************************************}
   2 {*                                                                         *}
   3 {*  FreeType Performance Timer                                             *}
   4 {*                                                                         *}
   5 {*                                                                         *}
   6 {*  This source code has been compiled and run under both Virtual Pascal   *}
   7 {*  on OS/2 and Borland's BP7.                                             *}
   8 {*                                                                         *}
   9 {*                                                                         *}
  10 {*  The C scan-line converter has been highly optimized, unlike the        *}
  11 {*  Pascal one which is still 'aged'. Don't be surprised to see drastic    *}
  12 {*  performance differences then..                                         *}
  13 {*                                                                         *}
  14 {***************************************************************************}
  15
  16 program Timer;
  17
  18 uses
  19 {$IFDEF OS2}
  20      Use32,
  21 {$ENDIF}
  22      Crt,
  23      Dos,     (* for GetTime *)
  24      GMain,
  25      GEvents,
  26      GDriver,
  27      FreeType,
  28
  29      TTError,  (* for CheckError      *)
  30      TTTypes;  (* for commodity types *)
  31
  32 {$DEFINE VISUAL}
  33
  34 { $DEFINE DEBUG}
  35
  36 {$IFDEF VISUAL}
  37 {&PMTYPE NOVIO}
  38 {$ENDIF}
  39
  40 const
  41   Precis  = 64;
  42   Precis2 = Precis div 2;
  43
  44   PrecisAux = 1024;
  45
  46   Centre_X : int = 320;
  47   Centre_Y : int = 225;
  48
  49   Max_Glyphs = 512;
  50
  51 var
  52   xC : TT_PCoordinates;
  53   yC : TT_PCoordinates;
  54   Fl : TT_PTouchTable;
  55
  56   cons : PUShort;
  57
  58   outlines  : array[0..Max_Glyphs-1] of TT_Outline;
  59
  60   lastp : int;
  61   lastc : int;
  62
  63   res : int;
  64
  65   numPoints, numContours : int;
  66
  67   Bit : TT_Raster_Map;
  68
  69   Rotation : int;  (* Angle modulo 1024 *)
  70
  71   num_glyphs : int;
  72
  73   gray_level : Boolean;
  74
  75   face     : TT_Face;
  76   instance : TT_Instance;
  77   glyph    : TT_Glyph;
  78
  79   metrics  : TT_Glyph_Metrics;
  80   imetrics : TT_Instance_Metrics;
  81
  82   props    : TT_Face_Properties;
  83
  84   old_glyph : int;
  85   cur_glyph : int;
  86   tot_glyph : int;
  87
  88   grayLines : array[0..2048] of Byte;
  89
  90   error : TT_Error;
  91
  92
  93 Procedure InitRows;
  94 var
  95   i: integer;
  96   P: Pointer;
  97 begin
  98
  99   if gray_level then
 100   begin
 101     Bit.rows  := 200;
 102     Bit.cols  := 320;
 103     Bit.width := 320*2;
 104     Bit.flow  := TT_Flow_Down;
 105     Bit.size  := 320*200;
 106   end
 107   else
 108   begin
 109     Bit.rows  := 450;
 110     Bit.cols  := 80;
 111     Bit.width := 640;
 112     Bit.flow  := TT_Flow_Down;
 113     Bit.size  := 80*450;
 114   end;
 115
 116   GetMem( Bit.buffer, Bit.size );
 117   if Bit.buffer = NIL then
 118    begin
 119     Writeln('ERREUR:InitRows:Not enough memory to allocate BitMap');
 120     halt(1);
 121    end;
 122
 123   FillChar( Bit.Buffer^, Bit.Size, 0 );
 124 end;
 125
 126
 127 Procedure ClearData;
 128 var i: integer;
 129 begin
 130   FillChar( Bit.Buffer^, Bit.Size, 0 );
 131 end;
 132
 133
 134 procedure Preload_Glyphs( var start : Int );
 135 var
 136   i, j, fin, np, nc : integer;
 137   outline           : TT_Outline;
 138
 139 begin
 140   fin := start + Max_Glyphs;
 141   if fin > num_glyphs then fin := num_glyphs;
 142
 143   tot_glyph := fin-start;
 144
 145   cur_glyph := 0;
 146   lastp     := 0;
 147   lastc     := 0;
 148
 149   {$IFNDEF VISUAL}
 150   Write('Loading ', fin-start,' glyphs ');
 151   {$ENDIF}
 152
 153   for i := start to fin-1 do
 154   begin
 155
 156     if TT_Load_Glyph( instance,
 157                       glyph,
 158                       i,
 159                       TT_Load_Default ) = TT_Err_Ok then
 160     begin
 161       TT_Get_Glyph_Outline( glyph, outline );
 162
 163       TT_New_Outline( outline.n_points,
 164                       outline.n_contours,
 165                       outlines[cur_glyph] );
 166
 167       outline.high_precision := false;
 168       outline.second_pass    := false;
 169
 170       TT_Copy_Outline( outline, outlines[cur_glyph] );
 171
 172
 173       TT_Translate_Outline( outlines[cur_glyph],
 174                             vio_Width*16,
 175                             vio_Height*16 );
 176       inc( cur_glyph );
 177     end;
 178
 179   end;
 180
 181   start := fin;
 182 end;
 183
 184
 185
 186 function ConvertRaster(index : integer) : boolean;
 187 begin
 188   if gray_level then
 189     error := TT_Get_Outline_Pixmap( outlines[index], Bit )
 190   else
 191     error := TT_Get_Outline_Bitmap( outlines[index], Bit );
 192
 193   ConvertRaster := (error <> TT_Err_Ok);
 194 end;
 195
 196
 197 procedure Usage;
 198 begin
 199     Writeln('Simple TrueType Glyphs viewer - part of the FreeType project' );
 200     Writeln;
 201     Writeln('Usage : ',paramStr(0),' FontName[.TTF]');
 202     Halt(1);
 203 end;
 204
 205
 206 function Get_Time : LongInt;
 207 var
 208   heure,
 209   min,
 210   sec,
 211   cent :
 212 {$IFDEF OS2}
 213   longint;
 214 {$ELSE}
 215   word;
 216 {$ENDIF}
 217 begin
 218   GetTime( heure, min, sec, cent );
 219   Get_Time := 6000*longint(min) + 100*longint(sec) + cent;
 220 end;
 221
 222
 223
 224 var i         : integer;
 225     Filename  : String;
 226     Fail      : Int;
 227     T, T0, T1 : Long;
 228
 229     start : Int;
 230
 231 begin
 232   xC := NIL;
 233   yC := NIL;
 234   Fl := NIL;
 235
 236   TT_Init_FreeType;
 237
 238   if ParamCount = 0 then Usage;
 239
 240   gray_level := ParamStr(1)='-g';
 241
 242   if gray_level then
 243     if ParamCount <> 2 then Usage else
 244   else
 245     if ParamCount <> 1 then Usage;
 246
 247   if gray_level then Filename := ParamStr(2)
 248                 else Filename := ParamStr(1);
 249
 250   if Pos('.',FileName) = 0 then FileName:=FileName+'.TTF';
 251
 252   error := TT_Open_Face( filename, face );
 253
 254   if error <> TT_Err_Ok then
 255     begin
 256       Writeln('ERROR: Could not open ', FileName );
 257       Check_Error(error);
 258     end;
 259
 260   TT_Get_Face_Properties( face, props );
 261
 262   num_glyphs := props.num_Glyphs;
 263
 264   i := length(FileName);
 265   while (i > 1) and (FileName[i] <> '\') do dec(i);
 266
 267   FileName := Copy( FileName, i+1, length(FileName) );
 268
 269   error := TT_New_Glyph( face, glyph );
 270   if error <> TT_Err_Ok then
 271     begin
 272       Writeln('ERROR : Could not get glyph' );
 273       Check_Error(error);
 274     end;
 275
 276   i := props.max_Points * num_glyphs;
 277
 278   GetMem( fl, i );
 279   i := i * sizeof(Long);
 280
 281   GetMem( xC, i );
 282   GetMem( yC, i );
 283
 284   i := props.max_Contours * num_glyphs;
 285
 286   GetMem( cons, i*sizeof(UShort) );
 287
 288   error := TT_New_Instance( face, instance );
 289   if error <> TT_Err_Ok then
 290     begin
 291       Writeln('ERROR: Could not open face instance from ', Filename );
 292       Check_Error(error);
 293     end;
 294
 295   error := TT_Set_Instance_PointSize( instance, 400 );
 296   if error <> TT_Err_Ok then
 297     begin
 298       Writeln('ERROR: Could set pointsize' );
 299       Check_Error(error);
 300     end;
 301
 302   Rotation := 0;
 303   Fail     := 0;
 304
 305   InitRows;
 306
 307   {$IFDEF VISUAL}
 308   if gray_level then
 309     begin
 310       if not Set_Graph_Screen( Graphics_Mode_Gray ) then
 311         Panic1( 'could not set grayscale graphics mode' );
 312     end
 313   else
 314     begin
 315       if not Set_Graph_Screen( Graphics_Mode_Mono ) then
 316         Panic1( 'could not set mono graphics mode' );
 317     end;
 318
 319   {$ENDIF}
 320
 321   start := 0;
 322
 323   T  := Get_Time;
 324   T1 := 0;
 325
 326   while start < num_glyphs do
 327   begin
 328
 329     Preload_Glyphs(start);
 330
 331     {$IFNDEF VISUAL}
 332     write('... ');
 333     {$ENDIF}
 334
 335     T0 := Get_Time;
 336
 337     for cur_glyph := 0 to tot_glyph-1 do
 338     begin
 339       if not ConvertRaster(cur_glyph) then
 340       {$IFDEF VISUAL}
 341       begin
 342         Display_Bitmap_On_Screen( Bit.Buffer^, Bit.rows, Bit.cols  );
 343         ClearData;
 344       end
 345       {$ELSE}
 346       begin
 347       end
 348       {$ENDIF}
 349       else
 350         inc( Fail );
 351     end;
 352
 353     T0 := Get_Time - T0;
 354     writeln( T0/100:0:2,' s' );
 355
 356     inc( T1, T0 );
 357
 358     for cur_glyph := 0 to tot_glyph-1 do
 359       TT_Done_Outline( outlines[cur_glyph] );
 360   end;
 361
 362   T := Get_Time - T;
 363
 364   {$IFDEF VISUAL}
 365   Restore_Screen;
 366   {$ENDIF}
 367
 368   writeln;
 369   writeln('Render time   : ', T1/100:0:2,' s' );
 370   writeln('Total time    : ', T /100:0:2,' s');
 371   writeln('Glyphs/second : ', Long(num_glyphs)*100/T1:0:1 );
 372   writeln('Fails         : ',Fail );
 373 end.
 374
 375 begin
 376 end.
 377