FreeType 1.31.1
This commit is contained in:
248
pascal/test/codetv.pas
Normal file
248
pascal/test/codetv.pas
Normal file
@@ -0,0 +1,248 @@
|
||||
{****************************************************************************}
|
||||
{* *}
|
||||
{* CodeView.PAS *}
|
||||
{* *}
|
||||
{* This unit implements a simple TrueType bytecode viewer for the *}
|
||||
{* FREETYPE project debugger. *}
|
||||
{* *}
|
||||
{****************************************************************************}
|
||||
|
||||
Unit CodeTV;
|
||||
|
||||
interface
|
||||
|
||||
uses Objects, Views, Drivers, TTTypes, TTDebug;
|
||||
|
||||
{$I DEBUGGER.INC}
|
||||
|
||||
type
|
||||
|
||||
{ TCodeViewer }
|
||||
|
||||
{ This TView is a simple code list viewer ( IP + focused + breaks ) }
|
||||
|
||||
PCodeViewer = ^TCodeViewer;
|
||||
TCodeViewer = object( TListViewer )
|
||||
|
||||
constructor Init( var Bounds : TRect;
|
||||
ARange : PRangeRec );
|
||||
|
||||
procedure Draw; virtual;
|
||||
procedure HandleEvent( var Event : TEvent ); virtual;
|
||||
|
||||
procedure Change_Range( ARange : PRangeRec );
|
||||
procedure Change_Focus( ALine : integer );
|
||||
|
||||
procedure Get_Cursor_Addr( P : PLong );
|
||||
|
||||
private
|
||||
CodeRange : PRangeRec;
|
||||
IP : Int;
|
||||
end;
|
||||
|
||||
{ TCodeWindow }
|
||||
|
||||
PCodeWindow = ^TCodeWindow;
|
||||
TCodeWindow = object( TWindow )
|
||||
CodeView : PCodeViewer;
|
||||
constructor Init( var Bounds : TRect;
|
||||
ARange : PRangeRec );
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TCodeViewer }
|
||||
|
||||
constructor TCodeViewer.Init;
|
||||
begin
|
||||
inherited Init( Bounds, 1, nil, nil );
|
||||
|
||||
GrowMode := gfGrowHiX or gfGrowHiY;
|
||||
DragMode := dmDragGrow or dmLimitLoX or dmLimitLoY;
|
||||
EventMask := EventMask or evWave;
|
||||
|
||||
IP := 0;
|
||||
|
||||
Change_Range( ARange );
|
||||
end;
|
||||
|
||||
|
||||
procedure TCodeViewer.Change_Range;
|
||||
begin
|
||||
codeRange := ARange;
|
||||
|
||||
if codeRange <> nil then
|
||||
SetRange( codeRange^.NLines )
|
||||
else
|
||||
SetRange( 0 );
|
||||
end;
|
||||
|
||||
procedure TCodeViewer.Change_Focus;
|
||||
begin
|
||||
|
||||
if ALine < 0 then
|
||||
begin
|
||||
IP := -1;
|
||||
DrawView;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if ALine >= TopItem + Size.Y then TopItem := ALine;
|
||||
|
||||
if codeRange <> nil then
|
||||
begin
|
||||
FocusItem( ALine );
|
||||
IP := codeRange^.Disassembled^[ALine];
|
||||
end;
|
||||
DrawView;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCodeViewer.Get_Cursor_Addr( P : PLong );
|
||||
begin
|
||||
with codeRange^ do
|
||||
begin
|
||||
if (Focused < 0) or (Focused >= NLines) then
|
||||
P^[0] := -1
|
||||
else
|
||||
P^[0] := disassembled^[Focused];
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCodeViewer.HandleEvent( var Event : TEvent );
|
||||
var
|
||||
Limits : TRect;
|
||||
Mini, Maxi : Objects.TPoint;
|
||||
begin
|
||||
|
||||
inherited HandleEvent(Event);
|
||||
|
||||
case Event.What of
|
||||
|
||||
evCommand : case Event.Command of
|
||||
|
||||
cmChangeRange : Change_Range( Event.InfoPtr );
|
||||
|
||||
cmQueryCursorAddr : Get_Cursor_Addr( Event.InfoPtr );
|
||||
|
||||
cmResize: begin
|
||||
Owner^.GetExtent(Limits);
|
||||
SizeLimits( Mini, Maxi );
|
||||
DragView(Event, DragMode, Limits, Mini, Maxi );
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
evWave : case Event.Command of
|
||||
|
||||
cmReFocus : Change_Focus( Event.InfoInt );
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCodeViewer.Draw;
|
||||
const
|
||||
Colors : array[0..3] of byte
|
||||
= ($1E,$40,$0E,$30);
|
||||
Prefix : array[1..3] of Char
|
||||
= ( 'f', 'c', 'g' );
|
||||
var
|
||||
I, J, Item : Int;
|
||||
B : TDrawBuffer;
|
||||
S : String;
|
||||
Indent : Int;
|
||||
Ligne : Int;
|
||||
|
||||
Color : word;
|
||||
|
||||
On_BP : boolean;
|
||||
BP : PBreakPoint;
|
||||
|
||||
begin
|
||||
|
||||
{
|
||||
Colors[0] := GetColor(1); (* Normal line *)
|
||||
Colors[1] := GetColor(2); (* Normal breakpoint *)
|
||||
Colors[2] := GetColor(3); (* Focused line *)
|
||||
Colors[3] := GetColor(4); (* Focused breakpoint *)
|
||||
}
|
||||
if HScrollBar <> nil then Indent := HScrollBar^.Value
|
||||
else Indent := 0;
|
||||
|
||||
with CodeRange^ do
|
||||
begin
|
||||
|
||||
BP := Breaks;
|
||||
|
||||
if (BP <> nil) and (NLines > TopItem) then
|
||||
while (BP <> nil) and (BP^.Address < Disassembled^[TopItem]) do
|
||||
BP := BP^.Next;
|
||||
|
||||
for I := 0 to Self.Size.Y-1 do
|
||||
begin
|
||||
|
||||
Item := TopItem + I;
|
||||
|
||||
Color := 0;
|
||||
|
||||
if Item < NLines then
|
||||
begin
|
||||
|
||||
Ligne := Disassembled^[Item];
|
||||
|
||||
if (BP <> nil) and (BP^.Address = Ligne) then
|
||||
begin
|
||||
Color := 1;
|
||||
Repeat
|
||||
BP := BP^.Next
|
||||
until (BP = nil) or (BP^.Address > Ligne);
|
||||
end;
|
||||
|
||||
if (Range > 0) and
|
||||
( Focused = Item ) then
|
||||
|
||||
Color := Color or 2;
|
||||
|
||||
S := ' ' + Cur_U_Line( Code, Ligne );
|
||||
|
||||
S[2] := Prefix[index];
|
||||
|
||||
S := copy( S, 1 + Indent, Self.Size.X );
|
||||
|
||||
if Ligne = IP then
|
||||
begin
|
||||
S[1] := '=';
|
||||
S[7] := '>';
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
S := '';
|
||||
end;
|
||||
|
||||
Color := Colors[Color];
|
||||
|
||||
MoveChar( B, ' ', Color, Self.Size.X );
|
||||
MoveStr( B, S, Color );
|
||||
|
||||
WriteLine( 0, I, Self.Size.X, 1, B );
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TCodeWindow }
|
||||
|
||||
constructor TCodeWindow.Init;
|
||||
begin
|
||||
inherited Init( Bounds,'Code',wnNoNumber );
|
||||
GetExtent( Bounds );
|
||||
Bounds.Grow(-1,-1);
|
||||
New( CodeView, Init( Bounds, ARange ) );
|
||||
Insert( CodeView );
|
||||
end;
|
||||
|
||||
end.
|
||||
84
pascal/test/common.pas
Normal file
84
pascal/test/common.pas
Normal file
@@ -0,0 +1,84 @@
|
||||
Unit Common;
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
Max_Arguments = 1024;
|
||||
|
||||
var
|
||||
num_arguments : integer;
|
||||
(* the number of arguments contained in the 'arguments' array *)
|
||||
|
||||
arguments : array[0..Max_Arguments-1] of ^string;
|
||||
(* This array will hold all arguments after wildcard expansion *)
|
||||
(* note that it will not contain the original arguments that *)
|
||||
(* were before 'first_argument' of Expand_Wildcards *)
|
||||
|
||||
procedure Expand_WildCards( first_argument : integer;
|
||||
default_extension : string );
|
||||
(* expand all wildcards into filenames *)
|
||||
|
||||
implementation
|
||||
|
||||
uses Dos;
|
||||
|
||||
procedure Split( Original : String;
|
||||
var Base : String;
|
||||
var Name : String );
|
||||
var
|
||||
n : integer;
|
||||
begin
|
||||
n := length(Original);
|
||||
|
||||
while ( n > 0 ) do
|
||||
if ( Original[n] = '\' ) or
|
||||
( Original[n] = '/' ) then
|
||||
begin
|
||||
Base := Copy( Original, 1, n-1 );
|
||||
Name := Copy( Original, n+1, length(Original) );
|
||||
exit;
|
||||
end
|
||||
else
|
||||
dec(n);
|
||||
|
||||
Base := '';
|
||||
Name := Original;
|
||||
end;
|
||||
|
||||
|
||||
procedure Expand_WildCards( first_argument : integer;
|
||||
default_extension : string );
|
||||
var
|
||||
i, n : integer;
|
||||
base, name : string;
|
||||
SRec : SearchRec;
|
||||
begin
|
||||
num_arguments := 0;
|
||||
i := first_argument;
|
||||
|
||||
while ( i <= ParamCount ) do
|
||||
begin
|
||||
Split( ParamStr(i), base, name );
|
||||
if base <> '' then
|
||||
base := base + '\';
|
||||
|
||||
FindFirst( base+name, Archive+ReadOnly+Hidden, SRec );
|
||||
if DosError <> 0 then
|
||||
FindFirst( base+name+default_extension, AnyFile, SRec );
|
||||
|
||||
while (DosError = 0) and (num_arguments < Max_Arguments) do
|
||||
begin
|
||||
GetMem( arguments[num_arguments], length(base)+length(SRec.Name)+1 );
|
||||
arguments[num_arguments]^ := base + SRec.Name;
|
||||
inc( num_arguments );
|
||||
FindNext( SRec );
|
||||
end;
|
||||
|
||||
{$IFDEF OS2}
|
||||
FindClose( SRec );
|
||||
{$ENDIF}
|
||||
inc( i );
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
42
pascal/test/debugger.inc
Normal file
42
pascal/test/debugger.inc
Normal file
@@ -0,0 +1,42 @@
|
||||
{ DEBUGGER.INC : Constantes des commandes du debugger FREETYPE }
|
||||
|
||||
const
|
||||
|
||||
evWave = $200; { Broadcast messages }
|
||||
|
||||
cmNewWin = 200;
|
||||
cmFileOpen = 201;
|
||||
|
||||
cmNewExecution = 300;
|
||||
cmRefocus = 301;
|
||||
cmChangeRange = 302;
|
||||
cmQueryCursorAddr = 303;
|
||||
|
||||
cmRun = 400;
|
||||
kb_val_Run = kbCtrlF9;
|
||||
kb_str_Run = 'Ctrl-F9';
|
||||
|
||||
cmGotoCursor = 401;
|
||||
kb_val_GotoCursor = kbF4;
|
||||
kb_str_GotoCursor = 'F4';
|
||||
|
||||
cmTraceInto = 402;
|
||||
kb_val_TraceInto = kbF7;
|
||||
kb_str_TraceInto = 'F7';
|
||||
|
||||
cmStepOver = 403;
|
||||
kb_val_StepOver = kbF8;
|
||||
kb_str_StepOver = 'F8';
|
||||
|
||||
cmUntilReturn = 404;
|
||||
kb_val_UntilReturn = kbAltF8;
|
||||
kb_str_UntilReturn = 'Alt-F8';
|
||||
|
||||
cmToggleBreak = 500;
|
||||
kb_val_ToggleBreak = kbCtrlF8;
|
||||
|
||||
cmClearBreaks = 501;
|
||||
|
||||
cmViewGlyph = 600;
|
||||
kb_val_ViewGlyph = kbF9;
|
||||
kb_str_ViewGlyph = 'F9';
|
||||
924
pascal/test/debugger.pas
Normal file
924
pascal/test/debugger.pas
Normal file
@@ -0,0 +1,924 @@
|
||||
program Debugger;
|
||||
|
||||
uses
|
||||
{$IFDEF OS2}
|
||||
Use32,
|
||||
{$ENDIF}
|
||||
|
||||
(* Turbo Vision units *)
|
||||
Drivers,
|
||||
Objects,
|
||||
Views,
|
||||
Menus,
|
||||
App,
|
||||
MsgBox,
|
||||
|
||||
Crt,
|
||||
|
||||
(* FreeType units *)
|
||||
FreeType,
|
||||
TTInterp,
|
||||
TTTypes,
|
||||
TTMemory,
|
||||
TTError,
|
||||
TTTables,
|
||||
TTObjs,
|
||||
TTFile,
|
||||
TTCalc,
|
||||
TTDebug,
|
||||
TTRaster,
|
||||
|
||||
(* graphics system units *)
|
||||
GDriver,
|
||||
GMain,
|
||||
GEvents,
|
||||
|
||||
(* Debugger's Turbo Vision enhancements *)
|
||||
CodeTv,
|
||||
StackTv,
|
||||
StateTv,
|
||||
ZoneTv;
|
||||
|
||||
{$I DEBUGGER.INC}
|
||||
|
||||
(* define this variable if you want to debug the CVT rather than a *)
|
||||
(* glyph's instruction set.. *)
|
||||
{ $DEFINE DEBUG_CVT}
|
||||
|
||||
const
|
||||
Precis = 64;
|
||||
|
||||
Screen_Width = 640;
|
||||
Screen_Height = 480;
|
||||
Screen_Cols = Screen_Width div 8;
|
||||
Screen_Size = Screen_Cols * Screen_Height;
|
||||
|
||||
Grid_Width = Screen_Width div 16;
|
||||
Grid_Height = Screen_Height div 16;
|
||||
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;
|
||||
|
||||
|
||||
type
|
||||
TDebug_Mode = ( debug_code, view_glyph );
|
||||
|
||||
TMyApp = object( TApplication )
|
||||
constructor Init;
|
||||
procedure NewWindow; virtual;
|
||||
procedure InitMenuBar; virtual;
|
||||
procedure HandleEvent( var Event : TEvent ); virtual;
|
||||
|
||||
procedure Single_Step;
|
||||
procedure Execute_Loop;
|
||||
procedure New_Execution;
|
||||
procedure ReFocus;
|
||||
end;
|
||||
|
||||
TEtat = ( etat_Termine, etat_Arret, etat_Execution );
|
||||
|
||||
TVolatileBreakPoint = record
|
||||
range : Int;
|
||||
address : Int;
|
||||
end;
|
||||
|
||||
var
|
||||
CW : PCodeWindow;
|
||||
SW : PStackWindow;
|
||||
GW : PStateWindow;
|
||||
ZW : PZoneWindow;
|
||||
|
||||
Code_Range : array[1..3] of PCodeRange;
|
||||
|
||||
Gen_Range : array[1..3] of TRangeRec;
|
||||
|
||||
old_Range : Int;
|
||||
|
||||
stream : TT_Stream;
|
||||
|
||||
the_face : TT_Face;
|
||||
the_glyph : TT_Glyph;
|
||||
the_instance : TT_Instance;
|
||||
|
||||
face : PFace;
|
||||
glyph : PGlyph;
|
||||
glyph2 : PGlyph;
|
||||
instance : PInstance;
|
||||
exec : PExec_Context;
|
||||
|
||||
error : TT_Error;
|
||||
|
||||
Etat : TEtat;
|
||||
|
||||
Volatiles : PBreakPoint;
|
||||
|
||||
xCoord : TT_PCoordinates;
|
||||
yCoord : TT_PCoordinates;
|
||||
Flag : TT_PTouchTable;
|
||||
|
||||
Bitmap_small : TT_Raster_Map;
|
||||
Bitmap_big : TT_Raster_Map;
|
||||
|
||||
display_outline : boolean;
|
||||
hint_glyph : boolean;
|
||||
|
||||
debug_mode : TDebug_Mode;
|
||||
MyApp : TMyApp;
|
||||
|
||||
Range : Int;
|
||||
P : PByteArray;
|
||||
FileName : String;
|
||||
Font_Buffer : PStorage;
|
||||
Out_File : Text;
|
||||
T, I : int;
|
||||
|
||||
glyph_number : Int;
|
||||
point_size : Int;
|
||||
|
||||
procedure Initialize;
|
||||
var
|
||||
i : int;
|
||||
begin
|
||||
for i := 1 to 3 do Code_Range[i] := Get_CodeRange(exec,i);
|
||||
for i := 1 to 3 do Generate_Range( Code_Range[i], i, Gen_Range[i] );
|
||||
|
||||
Volatiles := nil;
|
||||
|
||||
display_outline := true;
|
||||
Debug_Mode := debug_code;
|
||||
end;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : InitRows
|
||||
*
|
||||
* Description : Allocates the target bitmaps
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
Procedure Init_Engine;
|
||||
var
|
||||
P: Pointer;
|
||||
begin
|
||||
|
||||
(* The big bitmap will contain the grid, the glyph contours and *)
|
||||
(* the magnified bitmap *)
|
||||
|
||||
Bitmap_big.rows := Screen_Height;
|
||||
Bitmap_big.cols := Screen_Cols;
|
||||
Bitmap_big.width := Screen_Width;
|
||||
Bitmap_big.flow := TT_Flow_Up;
|
||||
Bitmap_big.size := Screen_Size;
|
||||
|
||||
GetMem( Bitmap_big.buffer, Bitmap_big.size );
|
||||
if Bitmap_big.buffer = NIL then
|
||||
begin
|
||||
Writeln('ERREUR:InitRows:Not enough memory to allocate big BitMap');
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
(* The small bitmap contains the rendered glyph, and is then later *)
|
||||
(* magnified into the big bitmap *)
|
||||
|
||||
Bitmap_small.rows := Grid_Height;
|
||||
Bitmap_small.cols := Grid_Cols;
|
||||
Bitmap_small.width := Grid_Width;
|
||||
Bitmap_small.flow := TT_Flow_Up;
|
||||
Bitmap_small.size := Grid_Size;
|
||||
|
||||
GetMem( Bitmap_small.buffer, Bitmap_small.size );
|
||||
if Bitmap_small.buffer = NIL then
|
||||
begin
|
||||
Writeln('ERREUR:InitRows:Not enough memory to allocate big BitMap');
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
FillChar( Bitmap_big.Buffer^, Bitmap_big.Size, 0 );
|
||||
FillChar( Bitmap_small.Buffer^, Bitmap_small.size, 0 );
|
||||
end;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : ClearData
|
||||
*
|
||||
* Description : Clears the bitmaps
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
Procedure ClearData;
|
||||
var i: integer;
|
||||
begin
|
||||
FillChar( Bitmap_big. Buffer^, Bitmap_big. Size, 0 );
|
||||
FillChar( Bitmap_small.Buffer^, Bitmap_small.size, 0 );
|
||||
end;
|
||||
|
||||
|
||||
function Render_Magnified : boolean;
|
||||
label
|
||||
Exit_1;
|
||||
type
|
||||
TBlock = array[0..7] of Byte;
|
||||
PBlock = ^TBlock;
|
||||
const
|
||||
{
|
||||
Grid_Empty : TBlock
|
||||
= ( $10, $10, $10, $FF, $10, $10, $10, $10 );
|
||||
}
|
||||
Grid_Pixel2 : TBlock
|
||||
= ( $FE, $FE, $FE, $FE, $FE, $FE, $FE, $00 );
|
||||
|
||||
Pixel_Center_X = 3;
|
||||
Pixel_Center_Y = 3;
|
||||
|
||||
Grid_Empty : TBlock
|
||||
= ( $00, $00, $00, $10, $00, $00, $00, $00 );
|
||||
|
||||
Grid_Pixel1 : TBlock
|
||||
= ( $00, $00, $38, $38, $38, $00, $00, $00 );
|
||||
|
||||
Big_Center_X = Grid_Center_X*16 + Pixel_Center_X;
|
||||
Big_Center_Y = Grid_Center_Y*16 + Pixel_Center_Y;
|
||||
|
||||
var
|
||||
r, w, w2, u, v, b, c : integer;
|
||||
|
||||
x, y : Long;
|
||||
|
||||
block : PBlock;
|
||||
G : TT_Outline;
|
||||
|
||||
pixel,
|
||||
empty : PBlock;
|
||||
|
||||
numPoints : integer;
|
||||
begin
|
||||
Render_Magnified := False;
|
||||
|
||||
ClearData;
|
||||
|
||||
numpoints := exec^.pts.n_points - 2; (* Remove phantom points *)
|
||||
|
||||
for r := 0 to numPoints-1 do with exec^.pts do
|
||||
begin
|
||||
glyph2^.outline.points^[r].x := exec^.pts.cur^[r].x+64;
|
||||
glyph2^.outline.points^[r].y := exec^.pts.cur^[r].y+64;
|
||||
end;
|
||||
|
||||
(* We begin rendering the glyph within the small bitmap *)
|
||||
|
||||
G.n_contours := glyph^.outline.n_contours;
|
||||
G.conEnds := glyph^.outline.conEnds;
|
||||
G.Points := glyph^.outline.points;
|
||||
G.points := glyph2^.outline.points;
|
||||
G.Flags := glyph^.outline.flags;
|
||||
|
||||
G.second_pass := True;
|
||||
G.high_precision := True;
|
||||
G.dropout_mode := 2;
|
||||
|
||||
if Render_Glyph ( G, Bitmap_small ) then goto Exit_1;
|
||||
|
||||
(* Then, we render the glyph outline in the bit bitmap *)
|
||||
|
||||
for r := 0 to numPoints-1 do
|
||||
begin
|
||||
x := exec^.pts.cur^[r].x;
|
||||
y := exec^.pts.cur^[r].y;
|
||||
|
||||
x := (x - Precis*Grid_Center_X)*16 + Big_Center_X*Precis;
|
||||
y := (y - Precis*Grid_Center_Y)*16 + Big_Center_Y*Precis;
|
||||
|
||||
glyph2^.outline.points^[r].x := x + 8*64;
|
||||
glyph2^.outline.points^[r].y := y + 8*64;
|
||||
end;
|
||||
|
||||
(* first compute the magnified coordinates *)
|
||||
|
||||
G.n_contours := glyph^.outline.n_contours;
|
||||
G.conEnds := glyph^.outline.conEnds;
|
||||
G.Points := glyph^.outline.points;
|
||||
G.points := glyph2^.outline.points;
|
||||
G.Flags := glyph^.outline.flags;
|
||||
|
||||
G.second_pass := True;
|
||||
G.high_precision := True;
|
||||
G.dropout_mode := 2;
|
||||
|
||||
if display_outline then
|
||||
if Render_Glyph ( G, Bitmap_big ) then goto Exit_1;
|
||||
|
||||
(* Now, magnify the small bitmap, XORing it to the big bitmap *)
|
||||
|
||||
r := 0;
|
||||
w := 0;
|
||||
b := 0;
|
||||
|
||||
empty := @Grid_Empty;
|
||||
|
||||
if display_outline then pixel := @Grid_Pixel1
|
||||
else pixel := @Grid_Pixel2;
|
||||
|
||||
for y := 0 to Grid_Height-1 do
|
||||
begin
|
||||
|
||||
for x := 0 to Grid_Width-1 do
|
||||
begin
|
||||
|
||||
w2 := w;
|
||||
b := b shr 1;
|
||||
|
||||
if b = 0 then
|
||||
begin
|
||||
c := PByte(Bitmap_small.Buffer)^[r];
|
||||
b := $80;
|
||||
inc( r );
|
||||
end;
|
||||
|
||||
if c and b <> 0 then block := pixel
|
||||
else block := empty;
|
||||
|
||||
for v := 0 to 7 do
|
||||
begin
|
||||
PByte(Bitmap_Big.Buffer)^[w2] := PByte(Bitmap_Big.Buffer)^[w2]
|
||||
xor block^[v];
|
||||
inc( w2, Bitmap_Big.cols );
|
||||
end;
|
||||
|
||||
inc( w, 2 );
|
||||
|
||||
end;
|
||||
|
||||
inc( w, 15*Screen_Cols );
|
||||
|
||||
end;
|
||||
|
||||
|
||||
(* Display the resulting big bitmap *)
|
||||
|
||||
Display_BitMap_On_Screen( Bitmap_big.Buffer^, 450, 80 );
|
||||
|
||||
Exit_1:
|
||||
(* Clear the bitmaps *)
|
||||
|
||||
Render_Magnified := True;
|
||||
end;
|
||||
|
||||
|
||||
function Render_Simple : boolean;
|
||||
label
|
||||
Exit_1;
|
||||
var
|
||||
r, w, w2, u, v, b, c : integer;
|
||||
|
||||
x, y : Long;
|
||||
|
||||
G : TT_Outline;
|
||||
|
||||
numPoints : integer;
|
||||
begin
|
||||
Render_Simple := False;
|
||||
|
||||
numpoints := exec^.pts.n_points - 2; (* Remove phantom points *)
|
||||
|
||||
for r := 0 to numPoints-1 do with exec^.pts do
|
||||
begin
|
||||
glyph2^.outline.points^[r].x := exec^.pts.cur^[r].x + 32;
|
||||
glyph2^.outline.points^[r].y := exec^.pts.cur^[r].y + 32;
|
||||
end;
|
||||
|
||||
(* We begin rendering the glyph within the small bitmap *)
|
||||
|
||||
G.n_contours := glyph^.outline.n_contours;
|
||||
G.conEnds := glyph^.outline.conEnds;
|
||||
G.Points := glyph^.outline.points;
|
||||
G.points := glyph2^.outline.points;
|
||||
G.Flags := glyph^.outline.flags;
|
||||
|
||||
G.second_pass := True;
|
||||
G.high_precision := True;
|
||||
G.dropout_mode := 2;
|
||||
|
||||
|
||||
if display_outline then
|
||||
if Render_Glyph ( G, Bitmap_big ) then goto Exit_1;
|
||||
|
||||
(* Display the resulting big bitmap *)
|
||||
|
||||
Display_BitMap_On_Screen( Bitmap_big.Buffer^, 450, 80 );
|
||||
|
||||
Exit_1:
|
||||
(* Clear the bitmaps *)
|
||||
|
||||
ClearData;
|
||||
|
||||
Render_Simple := True;
|
||||
end;
|
||||
|
||||
|
||||
procedure Exit_Viewer;
|
||||
begin
|
||||
Restore_Screen;
|
||||
debug_mode := debug_code;
|
||||
MyApp.SetScreenMode( smCo80 + smFont8x8 );
|
||||
MyApp.Show;
|
||||
MyApp.ReDraw;
|
||||
end;
|
||||
|
||||
|
||||
procedure Enter_Viewer;
|
||||
begin
|
||||
Set_Graph_Screen( Graphics_Mode_Mono );
|
||||
|
||||
if not Render_Magnified then
|
||||
Exit_Viewer
|
||||
else
|
||||
debug_mode := view_glyph;
|
||||
end;
|
||||
|
||||
|
||||
procedure TMyApp.Execute_Loop;
|
||||
var
|
||||
Out : Boolean;
|
||||
B : PBreakPoint;
|
||||
|
||||
Event : TEvent;
|
||||
begin
|
||||
|
||||
Out := False;
|
||||
etat := etat_Execution;
|
||||
|
||||
repeat
|
||||
|
||||
Single_Step;
|
||||
|
||||
B := Find_BreakPoint( Volatiles, exec^.curRange, exec^.IP );
|
||||
if B <> nil then
|
||||
begin
|
||||
Clear_Break( Volatiles, B );
|
||||
Out := True;
|
||||
end;
|
||||
|
||||
if etat = etat_Execution then
|
||||
begin
|
||||
B := Find_BreakPoint( Gen_Range[exec^.curRange].Breaks,
|
||||
exec^.curRange,
|
||||
exec^.IP );
|
||||
if B <> nil then
|
||||
begin
|
||||
Out := True;
|
||||
Etat := etat_Arret;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Out := True;
|
||||
|
||||
until Out;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TMyApp.New_Execution;
|
||||
var
|
||||
Event : TEvent;
|
||||
begin
|
||||
Event.What := evWave;
|
||||
Event.Command := cmNewExecution;
|
||||
|
||||
HandleEvent( Event );
|
||||
end;
|
||||
|
||||
|
||||
procedure TMyApp.Single_Step;
|
||||
var
|
||||
tempStr : string[6];
|
||||
begin
|
||||
|
||||
if Run_Ins( exec ) then
|
||||
begin
|
||||
etat := etat_Termine;
|
||||
str( exec^.error, tempStr );
|
||||
MessageBox( 'Error : '+tempStr, nil, mfError+mfOkButton );
|
||||
exit;
|
||||
end;
|
||||
|
||||
if exec^.IP >= exec^.codeSize then
|
||||
|
||||
begin
|
||||
if (exec^.curRange <> TT_CodeRange_CVT) or
|
||||
Goto_CodeRange( exec, TT_CodeRange_Glyph, 0 ) then
|
||||
|
||||
begin
|
||||
etat := etat_Termine;
|
||||
MessageBox( 'Completed', nil, mfInformation+mfOkButton );
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
end;
|
||||
|
||||
|
||||
procedure TMyApp.ReFocus;
|
||||
var
|
||||
Event : TEvent;
|
||||
begin
|
||||
Event.What := evCommand;
|
||||
|
||||
if Old_Range <> exec^.curRange then
|
||||
begin
|
||||
Old_Range := exec^.curRange;
|
||||
Event.Command := cmChangeRange;
|
||||
Event.InfoPtr := @Gen_Range[Old_Range];
|
||||
CW^.HandleEvent( Event );
|
||||
end;
|
||||
|
||||
Event.What := evWave;
|
||||
Event.Command := cmRefocus;
|
||||
|
||||
if etat <> etat_Termine then
|
||||
Event.InfoInt := Get_Dis_Line( Gen_Range[Old_Range], exec^.IP )
|
||||
else
|
||||
Event.InfoInt := -1;
|
||||
|
||||
HandleEvent( Event );
|
||||
end;
|
||||
|
||||
|
||||
procedure TMyApp.NewWindow;
|
||||
var
|
||||
R : TRect;
|
||||
RR : TRangeRec;
|
||||
begin
|
||||
Desktop^.GetExtent(R);
|
||||
R.B.X := 32;
|
||||
|
||||
Old_Range := exec^.curRange;
|
||||
|
||||
New( CW, Init( R, @Gen_Range[Old_Range] ) );
|
||||
Desktop^.Insert(CW);
|
||||
|
||||
Desktop^.GetExtent(R);
|
||||
R.A.X := 32;
|
||||
R.B.X := 50;
|
||||
R.B.Y := R.B.Y div 2;
|
||||
|
||||
New( SW, Init( R, exec ) );
|
||||
Desktop^.Insert(SW);
|
||||
|
||||
Desktop^.GetExtent(R);
|
||||
R.A.X := 50;
|
||||
R.B.Y := R.B.Y div 2;
|
||||
|
||||
New( GW, Init( R, exec ) );
|
||||
Desktop^.Insert(GW);
|
||||
|
||||
Desktop^.GetExtent(R);
|
||||
R.A.X := 32;
|
||||
R.A.Y := R.B.Y div 2;
|
||||
|
||||
{$IFDEF DEBUG_CVT}
|
||||
New( ZW, Init( R, @exec^.twilight ) );
|
||||
{$ELSE}
|
||||
New( ZW, Init( R, @exec^.pts ) );
|
||||
{$ENDIF}
|
||||
Desktop^.Insert(ZW);
|
||||
|
||||
etat := etat_Arret;
|
||||
end;
|
||||
|
||||
|
||||
procedure TMyApp.InitMenuBar;
|
||||
var
|
||||
R : TRect;
|
||||
begin
|
||||
GetExtent(R);
|
||||
R.B.Y := R.A.Y + 1;
|
||||
MenuBar := New( PMenuBar, Init( R, NewMenu(
|
||||
NewSubMenu( '~F~ile', hcNoContext, NewMenu(
|
||||
NewItem( '~O~pen','F3', kbF3, cmFileOpen,
|
||||
hcNoContext,
|
||||
nil )),
|
||||
NewSubMenu( '~R~un', hcNoContext,
|
||||
NewMenu(
|
||||
NewItem( '~R~un','Ctrl-F9', kbCtrlF9,
|
||||
cmRun, hcNoContext,
|
||||
|
||||
NewItem( '~G~o to cursor','F4', kbF4,
|
||||
cmGoToCursor, hcNoContext,
|
||||
|
||||
NewItem( '~T~race into', 'F7', kbF7,
|
||||
cmTraceInto, hcNoContext,
|
||||
|
||||
NewItem( '~S~tep over', 'F8', kbF8,
|
||||
cmStepOver, hcNoContext,
|
||||
|
||||
NewItem( '~V~iew glyph', 'F9', kbF9,
|
||||
cmViewGlyph, hcNoContext,
|
||||
nil
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
nil
|
||||
)))));
|
||||
end;
|
||||
|
||||
|
||||
procedure TMyApp.HandleEvent( var Event : TEvent );
|
||||
var
|
||||
Adr : Long;
|
||||
begin
|
||||
|
||||
if debug_mode = view_glyph then
|
||||
begin
|
||||
|
||||
case Event.What of
|
||||
|
||||
evKeyDown : case Event.KeyCode of
|
||||
|
||||
kbF2 : begin
|
||||
display_outline := not display_outline;
|
||||
|
||||
if not Render_Magnified then
|
||||
Exit_Viewer;
|
||||
|
||||
end;
|
||||
|
||||
kbESC : Exit_Viewer;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
ClearEvent( Event );
|
||||
exit;
|
||||
|
||||
end;
|
||||
|
||||
inherited HandleEvent(Event);
|
||||
|
||||
case Event.What of
|
||||
|
||||
evCommand : case Event.Command of
|
||||
|
||||
cmNewWin : NewWindow;
|
||||
|
||||
cmGoToCursor : begin
|
||||
if etat = etat_Termine then exit;
|
||||
|
||||
Event.Command := cmQueryCursorAddr;
|
||||
Event.InfoPtr := @Adr;
|
||||
|
||||
CW^.HandleEvent( Event );
|
||||
|
||||
Set_Break( Volatiles,
|
||||
exec^.curRange,
|
||||
Adr );
|
||||
|
||||
New_Execution;
|
||||
Execute_Loop;
|
||||
ReFocus;
|
||||
end;
|
||||
|
||||
cmTraceInto : begin
|
||||
if etat = etat_termine then exit;
|
||||
|
||||
New_Execution;
|
||||
Single_Step;
|
||||
ReFocus;
|
||||
end;
|
||||
|
||||
cmStepOver : begin
|
||||
if etat = etat_termine then exit;
|
||||
|
||||
New_Execution;
|
||||
with exec^ do
|
||||
case code^[IP] of
|
||||
|
||||
$2A, (* LOOPCALL *)
|
||||
$2B : (* CALL *)
|
||||
|
||||
begin
|
||||
|
||||
Set_Break( Volatiles,
|
||||
exec^.curRange,
|
||||
exec^.IP +
|
||||
Get_Length( exec^.Code,
|
||||
exec^.IP ) );
|
||||
Execute_Loop;
|
||||
end;
|
||||
|
||||
else
|
||||
|
||||
Single_Step;
|
||||
end;
|
||||
|
||||
ReFocus;
|
||||
end;
|
||||
|
||||
cmViewGlyph :
|
||||
Enter_Viewer;
|
||||
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
|
||||
|
||||
constructor TMyApp.Init;
|
||||
begin
|
||||
inherited Init;
|
||||
SetScreenMode( smCo80 + smFont8x8 );
|
||||
NewWindow;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : LoadTrueTypeChar
|
||||
*
|
||||
* Description :
|
||||
*
|
||||
* Notes :
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
Function LoadTrueTypeChar( index : integer ) : boolean;
|
||||
var
|
||||
j, load_flag : int;
|
||||
|
||||
rc : TT_Error;
|
||||
|
||||
begin
|
||||
LoadTrueTypeChar := FALSE;
|
||||
(*
|
||||
if hint_glyph then load_flag := TT_Load_Scale_Glyph or TT_Load_Hint_Glyph
|
||||
else load_flag := TT_Load_Scale_Glyph;
|
||||
*)
|
||||
|
||||
load_flag := TT_Load_Scale_Glyph or TT_Load_Hint_Glyph or TT_Load_Debug;
|
||||
|
||||
rc := TT_Load_Glyph( the_instance,
|
||||
the_glyph,
|
||||
index,
|
||||
load_flag );
|
||||
if rc <> TT_Err_Ok then exit;
|
||||
|
||||
LoadTrueTypeChar := TRUE;
|
||||
end;
|
||||
|
||||
|
||||
procedure Usage;
|
||||
begin
|
||||
Writeln('Simple Library Debugger -- part of the FreeType project');
|
||||
Writeln('-----------------------------------------------------');
|
||||
Writeln;
|
||||
Writeln(' Usage : debugger glyph_number point_size fontfile[.ttf]');
|
||||
Writeln;
|
||||
halt(2);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
Code : Int;
|
||||
|
||||
begin
|
||||
|
||||
if ParamCount <> 3 then
|
||||
Usage;
|
||||
|
||||
val( ParamStr(1), glyph_number, Code );
|
||||
if Code <> 0 then
|
||||
Usage;
|
||||
|
||||
val( ParamStr(2), point_size, Code );
|
||||
if Code <> 0 then
|
||||
Usage;
|
||||
|
||||
filename := ParamStr(3);
|
||||
if Pos( '.', filename ) = 0 then filename := filename + '.ttf';
|
||||
|
||||
TT_Init_FreeType;
|
||||
|
||||
error := TT_Open_Face( filename, the_face );
|
||||
if error <> TT_Err_Ok then
|
||||
begin
|
||||
Writeln('Could not open file ',filename );
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
face := PFace(the_face.z);
|
||||
|
||||
error := TT_New_Glyph( the_face, the_glyph );
|
||||
if error <> TT_Err_Ok then
|
||||
begin
|
||||
Writeln('ERROR : Could not get glyph' );
|
||||
Check_Error(error);
|
||||
end;
|
||||
|
||||
glyph2 := PGlyph( the_glyph.z );
|
||||
|
||||
error := TT_New_Glyph( the_face, the_glyph );
|
||||
if error <> TT_Err_Ok then
|
||||
begin
|
||||
Writeln('ERROR : Could not get glyph' );
|
||||
Check_Error(error);
|
||||
end;
|
||||
|
||||
glyph := PGlyph( the_glyph.z );
|
||||
|
||||
error := TT_New_Instance( the_face, the_instance );
|
||||
if error <> TT_Err_Ok then
|
||||
begin
|
||||
Writeln('ERROR: Could not create new instance' );
|
||||
Check_Error(error);
|
||||
end;
|
||||
|
||||
instance := PInstance(the_instance.z);
|
||||
|
||||
exec := New_Context( instance );
|
||||
if exec = nil then
|
||||
begin
|
||||
Writeln( 'could not create execution context' );
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
instance^.debug := true;
|
||||
instance^.context := exec;
|
||||
|
||||
TT_Set_Instance_Resolutions( the_instance, 96, 96 );
|
||||
|
||||
{$IFDEF DEBUG_CVT}
|
||||
exec^.curRange := 1;
|
||||
|
||||
(* code taken from freetype.pas *)
|
||||
|
||||
with instance^.metrics do
|
||||
begin
|
||||
x_scale1 := ( Long(point_size*64) * x_resolution ) div 72;
|
||||
x_scale2 := instance^.owner^.fontHeader.units_per_EM;
|
||||
|
||||
y_scale1 := ( Long(point_size*64) * y_resolution ) div 72;
|
||||
y_scale2 := x_scale2;
|
||||
|
||||
if instance^.owner^.fontHeader.flags and 8 <> 0 then
|
||||
begin
|
||||
x_scale1 := (x_scale1 + 32) and -64;
|
||||
y_scale1 := (y_scale1 + 32) and -64;
|
||||
end;
|
||||
|
||||
x_ppem := x_scale1 div 64;
|
||||
y_ppem := y_scale1 div 64;
|
||||
end;
|
||||
|
||||
instance^.metrics.pointsize := point_size*64;
|
||||
instance^.valid := False;
|
||||
|
||||
if Instance_Reset( instance, true ) then
|
||||
Panic1('Could not reset instance before executing CVT');
|
||||
{$ELSE}
|
||||
error := TT_Set_Instance_PointSize( the_instance, point_size );
|
||||
if error <> TT_Err_Ok then
|
||||
begin
|
||||
Writeln('Could not execute CVT program' );
|
||||
Check_Error(error);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
Init_Engine;
|
||||
|
||||
{$IFNDEF DEBUG_CVT}
|
||||
if not LoadTrueTypeChar( glyph_number ) then
|
||||
begin
|
||||
Writeln('Error while loading glyph' );
|
||||
halt(1);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
exec^.instruction_trap := true;
|
||||
|
||||
{$IFNDEF DEBUG_CVT}
|
||||
(* Run_Context( exec, true ); *)
|
||||
{$ENDIF}
|
||||
|
||||
Initialize;
|
||||
|
||||
MyApp.Init;
|
||||
MyApp.Run;
|
||||
MyApp.Done;
|
||||
|
||||
TT_Done_FreeType;
|
||||
end.
|
||||
551
pascal/test/dump.pas
Normal file
551
pascal/test/dump.pas
Normal file
@@ -0,0 +1,551 @@
|
||||
{***************************************************************************}
|
||||
{* *}
|
||||
{* FreeType Font Tester. *}
|
||||
{* *}
|
||||
{* This program is used to compare computed advance widths with the *}
|
||||
{* values present in the "hdmx" table. It is now useless but remains *}
|
||||
{* a good base for other quick font metrics checkers.. *}
|
||||
{* *}
|
||||
{* This source code has been compiled and run under both Virtual Pascal *}
|
||||
{* on OS/2 and Borland's BP7. *}
|
||||
{* *}
|
||||
{***************************************************************************}
|
||||
|
||||
program Dump;
|
||||
|
||||
uses Crt,
|
||||
Dos,
|
||||
{$IFDEF OS2}
|
||||
Use32,
|
||||
{$ENDIF}
|
||||
GMain,
|
||||
GEvents,
|
||||
GDriver,
|
||||
FreeType,
|
||||
TTCalc,
|
||||
TTObjs,
|
||||
TTTables;
|
||||
|
||||
{ &PMTYPE NOVIO}
|
||||
|
||||
{$DEFINE DEBUG}
|
||||
|
||||
type
|
||||
TPathName = string[128];
|
||||
|
||||
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; (* Angle modulo 1024 *)
|
||||
|
||||
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;
|
||||
|
||||
filenames : array[0..Max_Files-1] of ^TPathName;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : Set_Raster_Area
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
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;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : Clear_Data
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
procedure Clear_Data;
|
||||
begin
|
||||
if gray_level then
|
||||
fillchar( Bit.buffer^, Bit.size, gray_palette[0] )
|
||||
else
|
||||
fillchar( Bit.buffer^, Bit.size, 0 );
|
||||
end;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : Init_Engine
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
procedure Init_Engine( maxRes : Int );
|
||||
begin
|
||||
Set_Raster_Area;
|
||||
GetMem( Bit.buffer, Bit.size );
|
||||
Clear_Data;
|
||||
end;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : Reset_Scale
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
function Reset_Scale( res : Int ) : Boolean;
|
||||
begin
|
||||
error := TT_Set_Instance_Pointsize( instance, res );
|
||||
Reset_Scale := (error = TT_Err_Ok);
|
||||
end;
|
||||
|
||||
|
||||
procedure Split( Original : String;
|
||||
var Base : String;
|
||||
var Name : String );
|
||||
var
|
||||
n : integer;
|
||||
begin
|
||||
n := length(Original);
|
||||
|
||||
while ( n > 0 ) do
|
||||
if ( Original[n] = '\' ) or
|
||||
( Original[n] = '/' ) then
|
||||
begin
|
||||
Base := Copy( Original, 1, n-1 );
|
||||
Name := Copy( Original, n+1, length(Original) );
|
||||
exit;
|
||||
end
|
||||
else
|
||||
dec(n);
|
||||
|
||||
Base := '';
|
||||
Name := Original;
|
||||
end;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : LoadTrueTypeChar
|
||||
*
|
||||
* Description : Loads a single glyph into the xcoord, ycoord and
|
||||
* flag arrays, from the instance data.
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
Function LoadTrueTypeChar( index : integer;
|
||||
hint : boolean ) : boolean;
|
||||
var
|
||||
j, load_flag : int;
|
||||
|
||||
result : TT_Error;
|
||||
|
||||
begin
|
||||
LoadTrueTypeChar := True;
|
||||
|
||||
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 );
|
||||
if result <> TT_Err_Ok then
|
||||
exit;
|
||||
|
||||
LoadTrueTypeChar := False;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
Error_String : String;
|
||||
ine : Int;
|
||||
|
||||
procedure Dump_AW( _face : TT_Face );
|
||||
var
|
||||
i, j, n : integer;
|
||||
|
||||
x, y : longint;
|
||||
|
||||
start_x,
|
||||
start_y,
|
||||
step_x,
|
||||
step_y : longint;
|
||||
|
||||
fail : Int;
|
||||
face : PFace;
|
||||
|
||||
rec : PHdmx_Record;
|
||||
|
||||
begin
|
||||
|
||||
face := PFace(_face.z);
|
||||
|
||||
rec := nil;
|
||||
|
||||
for n := 0 to face^.hdmx.num_records-1 do
|
||||
if face^.hdmx.records^[n].ppem = imetrics.x_ppem then
|
||||
rec := @face^.hdmx.records^[n];
|
||||
|
||||
if rec = nil then
|
||||
begin
|
||||
Writeln('Pas de hdmx record pour ', imetrics.x_ppem, ' ppem');
|
||||
exit;
|
||||
end;
|
||||
|
||||
ine := 0;
|
||||
while ine < num_glyphs do
|
||||
begin
|
||||
|
||||
if not LoadTrueTypeChar( ine, true ) then
|
||||
begin
|
||||
|
||||
TT_Get_Glyph_Metrics( glyph, metrics );
|
||||
|
||||
x := metrics.advance div 64;
|
||||
|
||||
if rec^.widths^[ine] <> x then
|
||||
begin
|
||||
Write( '(',ine:3,':',rec^.widths^[ine]:2,' ',x:2,')' );
|
||||
end;
|
||||
end;
|
||||
|
||||
inc( ine );
|
||||
end;
|
||||
Writeln;
|
||||
Writeln;
|
||||
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 :
|
||||
{$IFDEF OS2}
|
||||
longint;
|
||||
{$ELSE}
|
||||
word;
|
||||
{$ENDIF}
|
||||
|
||||
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;
|
||||
num_files : Integer;
|
||||
cur_file : Integer;
|
||||
first_arg : Int;
|
||||
sortie : Boolean;
|
||||
|
||||
base : string;
|
||||
name : string;
|
||||
|
||||
SRec : SearchRec;
|
||||
|
||||
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 );
|
||||
|
||||
num_files := 0;
|
||||
|
||||
while first_arg <= num_args do
|
||||
begin
|
||||
Split( ParamStr(first_arg), base, name );
|
||||
if base <> '' then
|
||||
base := base + '\';
|
||||
|
||||
FindFirst( base+name, Archive+ReadOnly+Hidden, SRec );
|
||||
if DosError <> 0 then
|
||||
FindFirst( base+name+'.ttf', AnyFile, SRec );
|
||||
|
||||
while (DosError = 0) and (num_files < Max_Files) do
|
||||
begin
|
||||
GetMem( filenames[num_files], length(base)+length(SRec.Name)+1 );
|
||||
filenames[num_files]^ := base + SRec.Name;
|
||||
inc( num_files );
|
||||
FindNext( SRec );
|
||||
end;
|
||||
|
||||
{$IFDEF OS2}
|
||||
FindClose( SRec );
|
||||
{$ENDIF}
|
||||
inc( first_arg );
|
||||
end;
|
||||
|
||||
cur_file := 0;
|
||||
|
||||
if num_files = 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( point_size );
|
||||
|
||||
repeat
|
||||
|
||||
FileName := Filenames[cur_file]^;
|
||||
|
||||
if Pos('.',FileName) = 0 then FileName:=FileName+'.TTF';
|
||||
|
||||
error := TT_Open_Face( filename, face );
|
||||
if error <> TT_Err_Ok then
|
||||
Erreur( 'Could not open '+filename );
|
||||
|
||||
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
|
||||
Erreur('Could not create instance');
|
||||
|
||||
Rotation := 0;
|
||||
Fail := 0;
|
||||
res := point_size;
|
||||
scan_type := 2;
|
||||
|
||||
if ( gray_level ) then scale_shift := 1
|
||||
else scale_shift := 0;
|
||||
|
||||
Reset_Scale( res );
|
||||
|
||||
display_outline := true;
|
||||
hint_glyph := true;
|
||||
|
||||
old_glyph := -1;
|
||||
old_res := res;
|
||||
cur_glyph := 0;
|
||||
|
||||
sortie := false;
|
||||
|
||||
Repeat
|
||||
|
||||
(*
|
||||
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(' point size = ');
|
||||
Str( imetrics.pointSize: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;
|
||||
*)
|
||||
TT_Get_Instance_Metrics( instance, imetrics );
|
||||
Writeln( Filename,' ',imetrics.pointsize,' pts = ',imetrics.x_ppem,' ppem' );
|
||||
|
||||
Dump_AW( face );
|
||||
|
||||
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_files then
|
||||
inc( cur_file );
|
||||
end;
|
||||
|
||||
'p' : begin
|
||||
sortie := true;
|
||||
if cur_file > 1 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.
|
||||
|
||||
123
pascal/test/gdriver.pas
Normal file
123
pascal/test/gdriver.pas
Normal file
@@ -0,0 +1,123 @@
|
||||
(*******************************************************************
|
||||
*
|
||||
* gdriver : Graphics utility driver generic interface 1.1
|
||||
*
|
||||
* Generic interface for all drivers of the graphics utility used
|
||||
* by the FreeType test programs.
|
||||
*
|
||||
* Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg.
|
||||
*
|
||||
* This file is part of the FreeType project, and may only be used
|
||||
* modified and distributed under the terms of the FreeType project
|
||||
* license, LICENSE.TXT. By continuing to use, modify or distribute
|
||||
* this file you indicate that you have read the license and
|
||||
* understand and accept it fully.
|
||||
*
|
||||
******************************************************************)
|
||||
|
||||
Unit GDriver;
|
||||
|
||||
interface
|
||||
|
||||
uses GEvents, GMain;
|
||||
|
||||
(* Note that we now support an event based model, even with */
|
||||
/* full-screen modes. It is the responsability of the driver */
|
||||
/* to map its events to the TEvent structure when called */
|
||||
/* through Get_Event *)
|
||||
|
||||
type
|
||||
Event = record
|
||||
what : GEvent; (* event class *)
|
||||
info : Int; (* event parameter *)
|
||||
end;
|
||||
|
||||
(* the event classes are defined in the file 'gevents.h' included *)
|
||||
(* by the test programs, not by the graphics utility *)
|
||||
|
||||
procedure Get_Event( var ev : Event );
|
||||
(* get last event. In full-screen modes, a key-stroke must be */
|
||||
/* translated to an event class with a parameter. *)
|
||||
|
||||
function Driver_Set_Graphics( mode : Int ) : boolean;
|
||||
(* A call to this function must set the graphics mode, the Vio *)
|
||||
(* variable, as well as the values vio_ScanLineWidth, vio_Width *)
|
||||
(* and vio_Height *)
|
||||
|
||||
function Driver_Restore_Mode : boolean;
|
||||
(* Restore previous mode or release display buffer/window *)
|
||||
|
||||
procedure Driver_Display_Bitmap( var buff; line, col : Int );
|
||||
(* Display bitmap on screen *)
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF OS2}
|
||||
|
||||
uses Os2Base, CRT;
|
||||
{$I GDRV_OS2.INC}
|
||||
|
||||
{$ELSE}
|
||||
|
||||
uses CRT;
|
||||
{$I GDRV_DOS.INC}
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
type
|
||||
Translator = record
|
||||
key : char;
|
||||
ev_class : GEvent;
|
||||
ev_info : Int;
|
||||
end;
|
||||
|
||||
const
|
||||
Num_Translators = 15;
|
||||
|
||||
Translators : array[1..Num_Translators] of Translator
|
||||
= (
|
||||
(key:#27; ev_class:event_Quit ; ev_info:0),
|
||||
|
||||
(key:'x'; ev_class: event_Rotate_Glyph; ev_info: -1),
|
||||
(key:'c'; ev_class: event_Rotate_Glyph; ev_info: 1),
|
||||
(key:'v'; ev_class: event_Rotate_Glyph; ev_info: -16),
|
||||
(key:'b'; ev_class: event_Rotate_Glyph; ev_info: 16),
|
||||
|
||||
(key:'9'; ev_class: event_Change_Glyph; ev_info:-100),
|
||||
(key:'0'; ev_class: event_Change_Glyph; ev_info: 100),
|
||||
(key:'i'; ev_class: event_Change_Glyph; ev_info: -10),
|
||||
(key:'o'; ev_class: event_Change_Glyph; ev_info: 10),
|
||||
(key:'k'; ev_class: event_Change_Glyph; ev_info: -1),
|
||||
(key:'l'; ev_class: event_Change_Glyph; ev_info: 1),
|
||||
|
||||
(key:'+'; ev_class: event_Scale_Glyph; ev_info: 10),
|
||||
(key:'-'; ev_class: event_Scale_Glyph; ev_info: -10),
|
||||
(key:'u'; ev_class: event_Scale_Glyph; ev_info: 1),
|
||||
(key:'j'; ev_class: event_Scale_Glyph; ev_info: -1)
|
||||
);
|
||||
|
||||
procedure Get_Event( var ev : Event );
|
||||
var
|
||||
i : Int;
|
||||
c : char;
|
||||
begin
|
||||
c := ReadKey;
|
||||
|
||||
for i := 1 to Num_Translators do
|
||||
begin
|
||||
if c = translators[i].key then
|
||||
begin
|
||||
ev.what := translators[i].ev_class;
|
||||
ev.info := translators[i].ev_info;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
(* unrecognized keystroke *)
|
||||
|
||||
ev.what := event_Keyboard;
|
||||
ev.info := Int(c);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
96
pascal/test/gdrv_dos.inc
Normal file
96
pascal/test/gdrv_dos.inc
Normal file
@@ -0,0 +1,96 @@
|
||||
|
||||
{ Restores screen to the original state }
|
||||
|
||||
function Driver_Restore_Mode: boolean;
|
||||
begin
|
||||
asm
|
||||
mov ax, $0003
|
||||
int $10
|
||||
end;
|
||||
Driver_Restore_Mode := True;
|
||||
end;
|
||||
|
||||
function Driver_Set_Graphics( mode : Int ) : boolean;
|
||||
var
|
||||
rc : Int;
|
||||
begin
|
||||
Driver_Set_Graphics := False;
|
||||
|
||||
rc := 0;
|
||||
|
||||
case Mode of
|
||||
|
||||
Graphics_Mode_Mono : begin
|
||||
asm
|
||||
mov ax, $0012
|
||||
int $10
|
||||
end;
|
||||
Vio_ScanLineWidth := 80;
|
||||
Vio_Width := 640;
|
||||
Vio_Height := 480;
|
||||
end;
|
||||
|
||||
Graphics_Mode_Gray : begin
|
||||
asm
|
||||
mov ax, $0013
|
||||
int $10
|
||||
end;
|
||||
Vio_ScanLineWidth := 320;
|
||||
Vio_Width := 320;
|
||||
Vio_Height := 200;
|
||||
|
||||
(* default gray palette takes the gray levels *)
|
||||
(* the standard VGA 256 colors mode *)
|
||||
|
||||
gray_palette[0] := 0;
|
||||
gray_palette[1] := 23;
|
||||
gray_palette[2] := 27;
|
||||
gray_palette[3] := 29;
|
||||
gray_palette[4] := 31;
|
||||
end;
|
||||
else
|
||||
rc := -1;
|
||||
end;
|
||||
|
||||
if rc <> 0 then exit;
|
||||
|
||||
Vio := @Mem[$A000:0];
|
||||
|
||||
Driver_Set_Graphics := True;
|
||||
end;
|
||||
|
||||
|
||||
procedure Driver_Display_Bitmap; assembler;
|
||||
asm
|
||||
push ds
|
||||
push bp
|
||||
|
||||
les di, [Vio]
|
||||
|
||||
cld
|
||||
|
||||
mov cx,[Vio_ScanLineWidth]
|
||||
mov bx,[col]
|
||||
mov ax,[line]
|
||||
dec ax
|
||||
mul cx
|
||||
add di,ax
|
||||
mov dx,[line]
|
||||
|
||||
lds si,[Buff]
|
||||
|
||||
mov bp,bx
|
||||
add bx,cx
|
||||
|
||||
@1:
|
||||
mov cx,bp
|
||||
rep movsb
|
||||
sub di,bx
|
||||
dec dx
|
||||
jnz @1
|
||||
|
||||
pop bp
|
||||
pop ds
|
||||
end;
|
||||
|
||||
|
||||
148
pascal/test/gdrv_os2.inc
Normal file
148
pascal/test/gdrv_os2.inc
Normal file
@@ -0,0 +1,148 @@
|
||||
|
||||
{$IFDEF DYNAMIC_VERSION}
|
||||
{$Dynamic System}
|
||||
{$L VPRTL.LIB}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
type
|
||||
Ptr16Rec = record
|
||||
Ofs,Sel: SmallWord;
|
||||
end;
|
||||
|
||||
var
|
||||
OrgMode : VioModeInfo;
|
||||
VioBufOfs : Longint;
|
||||
Status : SmallWord;
|
||||
|
||||
{ BIOS Video Mode
|
||||
#13 }
|
||||
|
||||
const
|
||||
VioMode_640x480x16 : VioModeInfo =
|
||||
( cb: SizeOf(VioModeInfo);
|
||||
fbType: vgmt_Other + vgmt_Graphics;
|
||||
Color: colors_16;
|
||||
Col: 80;
|
||||
Row: 35;
|
||||
HRes: 640;
|
||||
VRes: 480
|
||||
);
|
||||
|
||||
VioMode_320x200x256 : VioModeInfo =
|
||||
( cb: SizeOf(VioModeInfo);
|
||||
fbType: vgmt_Other + vgmt_Graphics;
|
||||
Color: colors_256;
|
||||
Col: 40;
|
||||
Row: 25;
|
||||
HRes: 320;
|
||||
VRes: 200
|
||||
);
|
||||
|
||||
VioBuf: VioPhysBuf =
|
||||
( pBuf: Ptr($A0000);
|
||||
cb: 64*1024
|
||||
);
|
||||
|
||||
{ Restores screen to the original state }
|
||||
|
||||
function Driver_Restore_Mode: boolean;
|
||||
begin
|
||||
VioSetMode(OrgMode, 0);
|
||||
Driver_Restore_Mode := True;
|
||||
end;
|
||||
|
||||
function Driver_Set_Graphics( mode : Int )
|
||||
: boolean;
|
||||
var
|
||||
rc : Int;
|
||||
begin
|
||||
Driver_Set_Graphics := False;
|
||||
|
||||
{ Save original video mode }
|
||||
OrgMode.cb := SizeOf(VioModeInfo);
|
||||
VioGetMode(OrgMode, 0);
|
||||
|
||||
case Mode of
|
||||
|
||||
Graphics_Mode_Mono : begin
|
||||
rc := VioSetMode( VioMode_640x480x16, 0 );
|
||||
Vio_ScanLineWidth := 80;
|
||||
Vio_Width := 640;
|
||||
Vio_Height := 480;
|
||||
end;
|
||||
|
||||
Graphics_Mode_Gray : begin
|
||||
rc := VioSetMode( VioMode_320x200x256, 0 );
|
||||
Vio_ScanLineWidth := 320;
|
||||
Vio_Width := 320;
|
||||
Vio_Height := 200;
|
||||
|
||||
(* default gray palette takes the gray levels *)
|
||||
(* the standard VGA 256 colors mode *)
|
||||
|
||||
gray_palette[0] := 0;
|
||||
gray_palette[1] := 23;
|
||||
gray_palette[2] := 27;
|
||||
gray_palette[3] := 29;
|
||||
gray_palette[4] := 31;
|
||||
end;
|
||||
else
|
||||
rc := -1;
|
||||
end;
|
||||
|
||||
{ Set VGA 640x400x16
|
||||
video mode }
|
||||
if rc <> 0 then exit;
|
||||
|
||||
{ Get selector for physical video buffer }
|
||||
if VioGetPhysBuf(VioBuf, 0) <> 0 then exit;
|
||||
|
||||
{ Make flat pointer that points to the physical video buffer}
|
||||
Ptr16Rec(VioBufOfs).Ofs := 0;
|
||||
Ptr16Rec(VioBufOfs).Sel := VioBuf.Sel;
|
||||
SelToFlat(Pointer(VioBufOfs));
|
||||
|
||||
{ Clear the screen. Unlike function 0 of the BIOS INT 10h }
|
||||
{ VioSetMode doesn't clear the screen. }
|
||||
FillChar(Pointer(VioBufOfs)^,64*1024,0);
|
||||
Vio := PVioScreenBuffer(VioBufOfs);
|
||||
|
||||
Driver_Set_Graphics := True;
|
||||
end;
|
||||
|
||||
|
||||
procedure Driver_Display_Bitmap; assembler;
|
||||
asm
|
||||
push esi
|
||||
push edi
|
||||
push ebx
|
||||
push ecx
|
||||
|
||||
mov esi,[Buff]
|
||||
|
||||
mov ecx,[Vio_ScanLineWidth]
|
||||
mov ebx,[Col]
|
||||
mov eax,[Line]
|
||||
|
||||
dec eax
|
||||
mul ecx
|
||||
|
||||
mov edi,[VioBufOfs]
|
||||
add edi,eax
|
||||
|
||||
mov edx,[line]
|
||||
add ebx,[Vio_ScanLineWidth]
|
||||
@1:
|
||||
mov ecx,[col]
|
||||
rep movsb
|
||||
sub edi,ebx
|
||||
dec edx
|
||||
jnz @1
|
||||
|
||||
pop ecx
|
||||
pop ebx
|
||||
pop edi
|
||||
pop esi
|
||||
end;
|
||||
|
||||
42
pascal/test/gevents.pas
Normal file
42
pascal/test/gevents.pas
Normal file
@@ -0,0 +1,42 @@
|
||||
(*******************************************************************
|
||||
*
|
||||
* gevents test programs events definition 1.1
|
||||
*
|
||||
* This file defines the events used by the FreeType test programs
|
||||
* It is _not_ included by 'gmain.c'. This file is also used by the
|
||||
* drivers to translate their own events in GEvents.
|
||||
*
|
||||
* Not a very good design, but we're not rewriting X..
|
||||
*
|
||||
* Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg.
|
||||
*
|
||||
* This file is part of the FreeType project, and may only be used
|
||||
* modified and distributed under the terms of the FreeType project
|
||||
* license, LICENSE.TXT. By continuing to use, modify or distribute
|
||||
* this file you indicate that you have read the license and
|
||||
* understand and accept it fully.
|
||||
*
|
||||
******************************************************************)
|
||||
|
||||
Unit GEvents;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
GEvent = (
|
||||
event_None,
|
||||
event_Quit, (* Quit program *)
|
||||
|
||||
event_Keyboard, (* unknown keystroke *)
|
||||
|
||||
event_Change_Glyph,
|
||||
event_Rotate_Glyph,
|
||||
event_Scale_Glyph,
|
||||
|
||||
event_Change_ScanType,
|
||||
event_Change_Instructions
|
||||
);
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
474
pascal/test/gmain.pas
Normal file
474
pascal/test/gmain.pas
Normal file
@@ -0,0 +1,474 @@
|
||||
(*******************************************************************
|
||||
*
|
||||
* gmain graphics utility main interface 1.1
|
||||
*
|
||||
* This file defines a common interface, implemented in the body
|
||||
* file 'gmain.c'. It relies on system dependent driver files,
|
||||
* like 'gfs_os.c', whose interface is described in 'gdriver.h'.
|
||||
*
|
||||
* Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg.
|
||||
*
|
||||
* This file is part of the FreeType project, and may only be used
|
||||
* modified and distributed under the terms of the FreeType project
|
||||
* license, LICENSE.TXT. By continuing to use, modify or distribute
|
||||
* this file you indicate that you have read the license and
|
||||
* understand and accept it fully.
|
||||
*
|
||||
******************************************************************)
|
||||
|
||||
Unit GMain;
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
Graphics_Mode_Mono = 1;
|
||||
Graphics_Mode_Gray = 2;
|
||||
|
||||
type
|
||||
TVioScreenBuffer = array[0..0] of Byte;
|
||||
PVioScreenBuffer = ^TVioScreenBuffer;
|
||||
|
||||
{$IFDEF OS2}
|
||||
Int = LongInt;
|
||||
{$ELSE}
|
||||
Int = Integer;
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
|
||||
Vio : PVioScreenBuffer;
|
||||
(* pointer to VRAM or display buffer *)
|
||||
|
||||
vio_ScanLineWidth : Int;
|
||||
vio_Width : Int;
|
||||
vio_Height : Int;
|
||||
|
||||
gray_palette : array[0..4] of Byte; (* gray palette *)
|
||||
|
||||
gcursor_x : int;
|
||||
gcursor_y : int;
|
||||
|
||||
gwindow_width : int;
|
||||
gwindow_height : int;
|
||||
|
||||
function Set_Graph_Screen( mode : int ) : boolean;
|
||||
(* Set a Graphics Mode, chosen from the Graphics_Mode_xxx list *)
|
||||
|
||||
function Restore_Screen : boolean;
|
||||
(* Restore a previous ( or text ) video mode *)
|
||||
|
||||
procedure Display_Bitmap_On_Screen( var buff; line, col : Int );
|
||||
(* display bitmap of 'line' line, and 'col' columns ( each *)
|
||||
(* column mode of 1 byte *)
|
||||
|
||||
procedure Goto_XY( x, y : int );
|
||||
|
||||
procedure Print_Str( str : string );
|
||||
|
||||
procedure Print_XY ( x, y : int; str : string );
|
||||
|
||||
implementation
|
||||
|
||||
uses GDriver;
|
||||
|
||||
type
|
||||
TFunction_8x8 = procedure( x, y : Int; c : char );
|
||||
|
||||
TByte = array[0..0] of Byte;
|
||||
PByte = ^TByte;
|
||||
|
||||
var
|
||||
Current_Mode : Byte;
|
||||
Print_8x8 : TFunction_8x8;
|
||||
|
||||
const
|
||||
Font_8x8 : array[0..2047] of Byte
|
||||
= (
|
||||
$00, $00, $00, $00, $00, $00, $00, $00,
|
||||
$7E, $81, $A5, $81, $BD, $99, $81, $7E,
|
||||
$7E, $FF, $DB, $FF, $C3, $E7, $FF, $7E,
|
||||
$6C, $FE, $FE, $FE, $7C, $38, $10, $00,
|
||||
$10, $38, $7C, $FE, $7C, $38, $10, $00,
|
||||
$38, $7C, $38, $FE, $FE, $92, $10, $7C,
|
||||
$00, $10, $38, $7C, $FE, $7C, $38, $7C,
|
||||
$00, $00, $18, $3C, $3C, $18, $00, $00,
|
||||
$FF, $FF, $E7, $C3, $C3, $E7, $FF, $FF,
|
||||
$00, $3C, $66, $42, $42, $66, $3C, $00,
|
||||
$FF, $C3, $99, $BD, $BD, $99, $C3, $FF,
|
||||
$0F, $07, $0F, $7D, $CC, $CC, $CC, $78,
|
||||
$3C, $66, $66, $66, $3C, $18, $7E, $18,
|
||||
$3F, $33, $3F, $30, $30, $70, $F0, $E0,
|
||||
$7F, $63, $7F, $63, $63, $67, $E6, $C0,
|
||||
$99, $5A, $3C, $E7, $E7, $3C, $5A, $99,
|
||||
$80, $E0, $F8, $FE, $F8, $E0, $80, $00,
|
||||
$02, $0E, $3E, $FE, $3E, $0E, $02, $00,
|
||||
$18, $3C, $7E, $18, $18, $7E, $3C, $18,
|
||||
$66, $66, $66, $66, $66, $00, $66, $00,
|
||||
$7F, $DB, $DB, $7B, $1B, $1B, $1B, $00,
|
||||
$3E, $63, $38, $6C, $6C, $38, $86, $FC,
|
||||
$00, $00, $00, $00, $7E, $7E, $7E, $00,
|
||||
$18, $3C, $7E, $18, $7E, $3C, $18, $FF,
|
||||
$18, $3C, $7E, $18, $18, $18, $18, $00,
|
||||
$18, $18, $18, $18, $7E, $3C, $18, $00,
|
||||
$00, $18, $0C, $FE, $0C, $18, $00, $00,
|
||||
$00, $30, $60, $FE, $60, $30, $00, $00,
|
||||
$00, $00, $C0, $C0, $C0, $FE, $00, $00,
|
||||
$00, $24, $66, $FF, $66, $24, $00, $00,
|
||||
$00, $18, $3C, $7E, $FF, $FF, $00, $00,
|
||||
$00, $FF, $FF, $7E, $3C, $18, $00, $00,
|
||||
$00, $00, $00, $00, $00, $00, $00, $00,
|
||||
$18, $3C, $3C, $18, $18, $00, $18, $00,
|
||||
$6C, $6C, $6C, $00, $00, $00, $00, $00,
|
||||
$6C, $6C, $FE, $6C, $FE, $6C, $6C, $00,
|
||||
$18, $7E, $C0, $7C, $06, $FC, $18, $00,
|
||||
$00, $C6, $CC, $18, $30, $66, $C6, $00,
|
||||
$38, $6C, $38, $76, $DC, $CC, $76, $00,
|
||||
$30, $30, $60, $00, $00, $00, $00, $00,
|
||||
$18, $30, $60, $60, $60, $30, $18, $00,
|
||||
$60, $30, $18, $18, $18, $30, $60, $00,
|
||||
$00, $66, $3C, $FF, $3C, $66, $00, $00,
|
||||
$00, $18, $18, $7E, $18, $18, $00, $00,
|
||||
$00, $00, $00, $00, $00, $18, $18, $30,
|
||||
$00, $00, $00, $7E, $00, $00, $00, $00,
|
||||
$00, $00, $00, $00, $00, $18, $18, $00,
|
||||
$06, $0C, $18, $30, $60, $C0, $80, $00,
|
||||
$7C, $CE, $DE, $F6, $E6, $C6, $7C, $00,
|
||||
$30, $70, $30, $30, $30, $30, $FC, $00,
|
||||
$78, $CC, $0C, $38, $60, $CC, $FC, $00,
|
||||
$78, $CC, $0C, $38, $0C, $CC, $78, $00,
|
||||
$1C, $3C, $6C, $CC, $FE, $0C, $1E, $00,
|
||||
$FC, $C0, $F8, $0C, $0C, $CC, $78, $00,
|
||||
$38, $60, $C0, $F8, $CC, $CC, $78, $00,
|
||||
$FC, $CC, $0C, $18, $30, $30, $30, $00,
|
||||
$78, $CC, $CC, $78, $CC, $CC, $78, $00,
|
||||
$78, $CC, $CC, $7C, $0C, $18, $70, $00,
|
||||
$00, $18, $18, $00, $00, $18, $18, $00,
|
||||
$00, $18, $18, $00, $00, $18, $18, $30,
|
||||
$18, $30, $60, $C0, $60, $30, $18, $00,
|
||||
$00, $00, $7E, $00, $7E, $00, $00, $00,
|
||||
$60, $30, $18, $0C, $18, $30, $60, $00,
|
||||
$3C, $66, $0C, $18, $18, $00, $18, $00,
|
||||
$7C, $C6, $DE, $DE, $DC, $C0, $7C, $00,
|
||||
$30, $78, $CC, $CC, $FC, $CC, $CC, $00,
|
||||
$FC, $66, $66, $7C, $66, $66, $FC, $00,
|
||||
$3C, $66, $C0, $C0, $C0, $66, $3C, $00,
|
||||
$F8, $6C, $66, $66, $66, $6C, $F8, $00,
|
||||
$FE, $62, $68, $78, $68, $62, $FE, $00,
|
||||
$FE, $62, $68, $78, $68, $60, $F0, $00,
|
||||
$3C, $66, $C0, $C0, $CE, $66, $3A, $00,
|
||||
$CC, $CC, $CC, $FC, $CC, $CC, $CC, $00,
|
||||
$78, $30, $30, $30, $30, $30, $78, $00,
|
||||
$1E, $0C, $0C, $0C, $CC, $CC, $78, $00,
|
||||
$E6, $66, $6C, $78, $6C, $66, $E6, $00,
|
||||
$F0, $60, $60, $60, $62, $66, $FE, $00,
|
||||
$C6, $EE, $FE, $FE, $D6, $C6, $C6, $00,
|
||||
$C6, $E6, $F6, $DE, $CE, $C6, $C6, $00,
|
||||
$38, $6C, $C6, $C6, $C6, $6C, $38, $00,
|
||||
$FC, $66, $66, $7C, $60, $60, $F0, $00,
|
||||
$7C, $C6, $C6, $C6, $D6, $7C, $0E, $00,
|
||||
$FC, $66, $66, $7C, $6C, $66, $E6, $00,
|
||||
$7C, $C6, $E0, $78, $0E, $C6, $7C, $00,
|
||||
$FC, $B4, $30, $30, $30, $30, $78, $00,
|
||||
$CC, $CC, $CC, $CC, $CC, $CC, $FC, $00,
|
||||
$CC, $CC, $CC, $CC, $CC, $78, $30, $00,
|
||||
$C6, $C6, $C6, $C6, $D6, $FE, $6C, $00,
|
||||
$C6, $C6, $6C, $38, $6C, $C6, $C6, $00,
|
||||
$CC, $CC, $CC, $78, $30, $30, $78, $00,
|
||||
$FE, $C6, $8C, $18, $32, $66, $FE, $00,
|
||||
$78, $60, $60, $60, $60, $60, $78, $00,
|
||||
$C0, $60, $30, $18, $0C, $06, $02, $00,
|
||||
$78, $18, $18, $18, $18, $18, $78, $00,
|
||||
$10, $38, $6C, $C6, $00, $00, $00, $00,
|
||||
$00, $00, $00, $00, $00, $00, $00, $FF,
|
||||
$30, $30, $18, $00, $00, $00, $00, $00,
|
||||
$00, $00, $78, $0C, $7C, $CC, $76, $00,
|
||||
$E0, $60, $60, $7C, $66, $66, $DC, $00,
|
||||
$00, $00, $78, $CC, $C0, $CC, $78, $00,
|
||||
$1C, $0C, $0C, $7C, $CC, $CC, $76, $00,
|
||||
$00, $00, $78, $CC, $FC, $C0, $78, $00,
|
||||
$38, $6C, $64, $F0, $60, $60, $F0, $00,
|
||||
$00, $00, $76, $CC, $CC, $7C, $0C, $F8,
|
||||
$E0, $60, $6C, $76, $66, $66, $E6, $00,
|
||||
$30, $00, $70, $30, $30, $30, $78, $00,
|
||||
$0C, $00, $1C, $0C, $0C, $CC, $CC, $78,
|
||||
$E0, $60, $66, $6C, $78, $6C, $E6, $00,
|
||||
$70, $30, $30, $30, $30, $30, $78, $00,
|
||||
$00, $00, $CC, $FE, $FE, $D6, $D6, $00,
|
||||
$00, $00, $B8, $CC, $CC, $CC, $CC, $00,
|
||||
$00, $00, $78, $CC, $CC, $CC, $78, $00,
|
||||
$00, $00, $DC, $66, $66, $7C, $60, $F0,
|
||||
$00, $00, $76, $CC, $CC, $7C, $0C, $1E,
|
||||
$00, $00, $DC, $76, $62, $60, $F0, $00,
|
||||
$00, $00, $7C, $C0, $70, $1C, $F8, $00,
|
||||
$10, $30, $FC, $30, $30, $34, $18, $00,
|
||||
$00, $00, $CC, $CC, $CC, $CC, $76, $00,
|
||||
$00, $00, $CC, $CC, $CC, $78, $30, $00,
|
||||
$00, $00, $C6, $C6, $D6, $FE, $6C, $00,
|
||||
$00, $00, $C6, $6C, $38, $6C, $C6, $00,
|
||||
$00, $00, $CC, $CC, $CC, $7C, $0C, $F8,
|
||||
$00, $00, $FC, $98, $30, $64, $FC, $00,
|
||||
$1C, $30, $30, $E0, $30, $30, $1C, $00,
|
||||
$18, $18, $18, $00, $18, $18, $18, $00,
|
||||
$E0, $30, $30, $1C, $30, $30, $E0, $00,
|
||||
$76, $DC, $00, $00, $00, $00, $00, $00,
|
||||
$00, $10, $38, $6C, $C6, $C6, $FE, $00,
|
||||
$7C, $C6, $C0, $C6, $7C, $0C, $06, $7C,
|
||||
$00, $CC, $00, $CC, $CC, $CC, $76, $00,
|
||||
$1C, $00, $78, $CC, $FC, $C0, $78, $00,
|
||||
$7E, $81, $3C, $06, $3E, $66, $3B, $00,
|
||||
$CC, $00, $78, $0C, $7C, $CC, $76, $00,
|
||||
$E0, $00, $78, $0C, $7C, $CC, $76, $00,
|
||||
$30, $30, $78, $0C, $7C, $CC, $76, $00,
|
||||
$00, $00, $7C, $C6, $C0, $78, $0C, $38,
|
||||
$7E, $81, $3C, $66, $7E, $60, $3C, $00,
|
||||
$CC, $00, $78, $CC, $FC, $C0, $78, $00,
|
||||
$E0, $00, $78, $CC, $FC, $C0, $78, $00,
|
||||
$CC, $00, $70, $30, $30, $30, $78, $00,
|
||||
$7C, $82, $38, $18, $18, $18, $3C, $00,
|
||||
$E0, $00, $70, $30, $30, $30, $78, $00,
|
||||
$C6, $10, $7C, $C6, $FE, $C6, $C6, $00,
|
||||
$30, $30, $00, $78, $CC, $FC, $CC, $00,
|
||||
$1C, $00, $FC, $60, $78, $60, $FC, $00,
|
||||
$00, $00, $7F, $0C, $7F, $CC, $7F, $00,
|
||||
$3E, $6C, $CC, $FE, $CC, $CC, $CE, $00,
|
||||
$78, $84, $00, $78, $CC, $CC, $78, $00,
|
||||
$00, $CC, $00, $78, $CC, $CC, $78, $00,
|
||||
$00, $E0, $00, $78, $CC, $CC, $78, $00,
|
||||
$78, $84, $00, $CC, $CC, $CC, $76, $00,
|
||||
$00, $E0, $00, $CC, $CC, $CC, $76, $00,
|
||||
$00, $CC, $00, $CC, $CC, $7C, $0C, $F8,
|
||||
$C3, $18, $3C, $66, $66, $3C, $18, $00,
|
||||
$CC, $00, $CC, $CC, $CC, $CC, $78, $00,
|
||||
$18, $18, $7E, $C0, $C0, $7E, $18, $18,
|
||||
$38, $6C, $64, $F0, $60, $E6, $FC, $00,
|
||||
$CC, $CC, $78, $30, $FC, $30, $FC, $30,
|
||||
$F8, $CC, $CC, $FA, $C6, $CF, $C6, $C3,
|
||||
$0E, $1B, $18, $3C, $18, $18, $D8, $70,
|
||||
$1C, $00, $78, $0C, $7C, $CC, $76, $00,
|
||||
$38, $00, $70, $30, $30, $30, $78, $00,
|
||||
$00, $1C, $00, $78, $CC, $CC, $78, $00,
|
||||
$00, $1C, $00, $CC, $CC, $CC, $76, $00,
|
||||
$00, $F8, $00, $B8, $CC, $CC, $CC, $00,
|
||||
$FC, $00, $CC, $EC, $FC, $DC, $CC, $00,
|
||||
$3C, $6C, $6C, $3E, $00, $7E, $00, $00,
|
||||
$38, $6C, $6C, $38, $00, $7C, $00, $00,
|
||||
$18, $00, $18, $18, $30, $66, $3C, $00,
|
||||
$00, $00, $00, $FC, $C0, $C0, $00, $00,
|
||||
$00, $00, $00, $FC, $0C, $0C, $00, $00,
|
||||
$C6, $CC, $D8, $36, $6B, $C2, $84, $0F,
|
||||
$C3, $C6, $CC, $DB, $37, $6D, $CF, $03,
|
||||
$18, $00, $18, $18, $3C, $3C, $18, $00,
|
||||
$00, $33, $66, $CC, $66, $33, $00, $00,
|
||||
$00, $CC, $66, $33, $66, $CC, $00, $00,
|
||||
$22, $88, $22, $88, $22, $88, $22, $88,
|
||||
$55, $AA, $55, $AA, $55, $AA, $55, $AA,
|
||||
$DB, $F6, $DB, $6F, $DB, $7E, $D7, $ED,
|
||||
$18, $18, $18, $18, $18, $18, $18, $18,
|
||||
$18, $18, $18, $18, $F8, $18, $18, $18,
|
||||
$18, $18, $F8, $18, $F8, $18, $18, $18,
|
||||
$36, $36, $36, $36, $F6, $36, $36, $36,
|
||||
$00, $00, $00, $00, $FE, $36, $36, $36,
|
||||
$00, $00, $F8, $18, $F8, $18, $18, $18,
|
||||
$36, $36, $F6, $06, $F6, $36, $36, $36,
|
||||
$36, $36, $36, $36, $36, $36, $36, $36,
|
||||
$00, $00, $FE, $06, $F6, $36, $36, $36,
|
||||
$36, $36, $F6, $06, $FE, $00, $00, $00,
|
||||
$36, $36, $36, $36, $FE, $00, $00, $00,
|
||||
$18, $18, $F8, $18, $F8, $00, $00, $00,
|
||||
$00, $00, $00, $00, $F8, $18, $18, $18,
|
||||
$18, $18, $18, $18, $1F, $00, $00, $00,
|
||||
$18, $18, $18, $18, $FF, $00, $00, $00,
|
||||
$00, $00, $00, $00, $FF, $18, $18, $18,
|
||||
$18, $18, $18, $18, $1F, $18, $18, $18,
|
||||
$00, $00, $00, $00, $FF, $00, $00, $00,
|
||||
$18, $18, $18, $18, $FF, $18, $18, $18,
|
||||
$18, $18, $1F, $18, $1F, $18, $18, $18,
|
||||
$36, $36, $36, $36, $37, $36, $36, $36,
|
||||
$36, $36, $37, $30, $3F, $00, $00, $00,
|
||||
$00, $00, $3F, $30, $37, $36, $36, $36,
|
||||
$36, $36, $F7, $00, $FF, $00, $00, $00,
|
||||
$00, $00, $FF, $00, $F7, $36, $36, $36,
|
||||
$36, $36, $37, $30, $37, $36, $36, $36,
|
||||
$00, $00, $FF, $00, $FF, $00, $00, $00,
|
||||
$36, $36, $F7, $00, $F7, $36, $36, $36,
|
||||
$18, $18, $FF, $00, $FF, $00, $00, $00,
|
||||
$36, $36, $36, $36, $FF, $00, $00, $00,
|
||||
$00, $00, $FF, $00, $FF, $18, $18, $18,
|
||||
$00, $00, $00, $00, $FF, $36, $36, $36,
|
||||
$36, $36, $36, $36, $3F, $00, $00, $00,
|
||||
$18, $18, $1F, $18, $1F, $00, $00, $00,
|
||||
$00, $00, $1F, $18, $1F, $18, $18, $18,
|
||||
$00, $00, $00, $00, $3F, $36, $36, $36,
|
||||
$36, $36, $36, $36, $FF, $36, $36, $36,
|
||||
$18, $18, $FF, $18, $FF, $18, $18, $18,
|
||||
$18, $18, $18, $18, $F8, $00, $00, $00,
|
||||
$00, $00, $00, $00, $1F, $18, $18, $18,
|
||||
$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
|
||||
$00, $00, $00, $00, $FF, $FF, $FF, $FF,
|
||||
$F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
|
||||
$0F, $0F, $0F, $0F, $0F, $0F, $0F, $0F,
|
||||
$FF, $FF, $FF, $FF, $00, $00, $00, $00,
|
||||
$00, $00, $76, $DC, $C8, $DC, $76, $00,
|
||||
$00, $78, $CC, $F8, $CC, $F8, $C0, $C0,
|
||||
$00, $FC, $CC, $C0, $C0, $C0, $C0, $00,
|
||||
$00, $00, $FE, $6C, $6C, $6C, $6C, $00,
|
||||
$FC, $CC, $60, $30, $60, $CC, $FC, $00,
|
||||
$00, $00, $7E, $D8, $D8, $D8, $70, $00,
|
||||
$00, $66, $66, $66, $66, $7C, $60, $C0,
|
||||
$00, $76, $DC, $18, $18, $18, $18, $00,
|
||||
$FC, $30, $78, $CC, $CC, $78, $30, $FC,
|
||||
$38, $6C, $C6, $FE, $C6, $6C, $38, $00,
|
||||
$38, $6C, $C6, $C6, $6C, $6C, $EE, $00,
|
||||
$1C, $30, $18, $7C, $CC, $CC, $78, $00,
|
||||
$00, $00, $7E, $DB, $DB, $7E, $00, $00,
|
||||
$06, $0C, $7E, $DB, $DB, $7E, $60, $C0,
|
||||
$38, $60, $C0, $F8, $C0, $60, $38, $00,
|
||||
$78, $CC, $CC, $CC, $CC, $CC, $CC, $00,
|
||||
$00, $7E, $00, $7E, $00, $7E, $00, $00,
|
||||
$18, $18, $7E, $18, $18, $00, $7E, $00,
|
||||
$60, $30, $18, $30, $60, $00, $FC, $00,
|
||||
$18, $30, $60, $30, $18, $00, $FC, $00,
|
||||
$0E, $1B, $1B, $18, $18, $18, $18, $18,
|
||||
$18, $18, $18, $18, $18, $D8, $D8, $70,
|
||||
$18, $18, $00, $7E, $00, $18, $18, $00,
|
||||
$00, $76, $DC, $00, $76, $DC, $00, $00,
|
||||
$38, $6C, $6C, $38, $00, $00, $00, $00,
|
||||
$00, $00, $00, $18, $18, $00, $00, $00,
|
||||
$00, $00, $00, $00, $18, $00, $00, $00,
|
||||
$0F, $0C, $0C, $0C, $EC, $6C, $3C, $1C,
|
||||
$58, $6C, $6C, $6C, $6C, $00, $00, $00,
|
||||
$70, $98, $30, $60, $F8, $00, $00, $00,
|
||||
$00, $00, $3C, $3C, $3C, $3C, $00, $00,
|
||||
$00, $00, $00, $00, $00, $00, $00, $00
|
||||
);
|
||||
|
||||
{$F+}
|
||||
procedure Print_8x8_Mono( x, y : Int; c : char );
|
||||
var
|
||||
offset, i : Int;
|
||||
bitm : PByte;
|
||||
begin
|
||||
offset := x + y*Vio_ScanLineWidth*8;
|
||||
bitm := @Font_8x8[ ord(c)*8 ];
|
||||
|
||||
for i := 0 to 7 do
|
||||
begin
|
||||
Vio^[offset] := bitm^[i];
|
||||
inc( offset, Vio_ScanLineWidth );
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Print_8x8_Gray( x, y : Int; c : char );
|
||||
var
|
||||
offset, i, bit : Int;
|
||||
|
||||
bitm : PByte;
|
||||
begin
|
||||
offset := ( x + y*Vio_ScanLineWidth )*8;
|
||||
bitm := @font_8x8[ ord(c)*8 ];
|
||||
|
||||
for i := 0 to 7 do
|
||||
begin
|
||||
bit := $80;
|
||||
while bit > 0 do
|
||||
begin
|
||||
if ( bit and bitm^[i] <> 0 ) then Vio^[offset] := $FF
|
||||
else Vio^[offset] := $00;
|
||||
bit := bit shr 1;
|
||||
inc( offset );
|
||||
end;
|
||||
|
||||
inc( offset, Vio_ScanLineWidth-8 );
|
||||
end;
|
||||
|
||||
end;
|
||||
{$F-}
|
||||
|
||||
function Set_Graph_Screen( mode : Int ): boolean;
|
||||
begin
|
||||
Set_Graph_Screen := False;
|
||||
|
||||
gcursor_x := 0;
|
||||
gcursor_y := 0;
|
||||
|
||||
case mode of
|
||||
|
||||
Graphics_Mode_Mono : begin
|
||||
if not Driver_Set_Graphics(mode) then exit;
|
||||
gwindow_width := vio_ScanLineWidth;
|
||||
gwindow_height := vio_Height div 8;
|
||||
|
||||
Print_8x8 := Print_8x8_Mono;
|
||||
end;
|
||||
|
||||
Graphics_Mode_Gray : begin
|
||||
if not Driver_Set_Graphics(mode) then exit;
|
||||
gwindow_width := vio_ScanLineWidth div 8;
|
||||
gwindow_height := vio_Height div 8;
|
||||
|
||||
Print_8x8 := Print_8x8_Gray;
|
||||
end;
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
|
||||
Set_Graph_Screen := True;
|
||||
end;
|
||||
|
||||
|
||||
function Restore_Screen : boolean;
|
||||
begin
|
||||
gcursor_x := 0;
|
||||
gcursor_y := 0;
|
||||
|
||||
gwindow_height := 0;
|
||||
gwindow_width := 0;
|
||||
|
||||
Restore_Screen := Driver_Restore_Mode;
|
||||
end;
|
||||
|
||||
procedure Display_Bitmap_On_Screen;
|
||||
begin
|
||||
Driver_Display_Bitmap( buff, line, col );
|
||||
end;
|
||||
|
||||
procedure Goto_XY( x, y : Int );
|
||||
begin
|
||||
gcursor_x := x;
|
||||
gcursor_y := y;
|
||||
end;
|
||||
|
||||
procedure Print_Str( str : string );
|
||||
var
|
||||
i : Int;
|
||||
begin
|
||||
for i := 1 to length(str) do
|
||||
begin
|
||||
case str[i] of
|
||||
|
||||
#13 : begin
|
||||
gcursor_x := 0;
|
||||
inc( gcursor_y );
|
||||
if gcursor_y > gwindow_height then gcursor_y := 0;
|
||||
end;
|
||||
else
|
||||
Print_8x8( gcursor_x, gcursor_y, str[i] );
|
||||
inc( gcursor_x );
|
||||
if gcursor_x >= gwindow_width then
|
||||
begin
|
||||
gcursor_x := 0;
|
||||
inc( gcursor_y );
|
||||
if gcursor_y >= gwindow_height then gcursor_y := 0;
|
||||
end
|
||||
end
|
||||
end
|
||||
end;
|
||||
|
||||
procedure Print_XY( x, y : Int; str : string );
|
||||
begin
|
||||
Goto_XY( x, y );
|
||||
Print_Str( str );
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
277
pascal/test/lint.pas
Normal file
277
pascal/test/lint.pas
Normal file
@@ -0,0 +1,277 @@
|
||||
{***************************************************************************}
|
||||
{* *}
|
||||
{* FreeType Font glyph programs checker *}
|
||||
{* *}
|
||||
{* *}
|
||||
{* This small program will load a TrueType font file and try to *}
|
||||
{* render it at a given point size. *}
|
||||
{* *}
|
||||
{* This version will also catch differences between the engine's *}
|
||||
{* computed advance widths, and the pre-calc values found in the *}
|
||||
{* "hdmx" table *}
|
||||
{* *}
|
||||
{* This source code has been compiled and run under both Virtual Pascal *}
|
||||
{* on OS/2 and Borland's BP7. *}
|
||||
{* *}
|
||||
{***************************************************************************}
|
||||
|
||||
program Abc;
|
||||
|
||||
uses Crt,
|
||||
Common,
|
||||
{$IFDEF OS2}
|
||||
Use32,
|
||||
{$ENDIF}
|
||||
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; (* Angle modulo 1024 *)
|
||||
|
||||
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
|
||||
*
|
||||
* Description : Loads a single glyph into the xcoord, ycoord and
|
||||
* flag arrays, from the instance data.
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
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 :
|
||||
{$IFDEF OS2}
|
||||
longint;
|
||||
{$ELSE}
|
||||
word;
|
||||
{$ENDIF}
|
||||
|
||||
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;
|
||||
|
||||
{$IFDEF RIEN}
|
||||
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;
|
||||
{$ENDIF}
|
||||
|
||||
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.
|
||||
|
||||
|
||||
148
pascal/test/stacktv.pas
Normal file
148
pascal/test/stacktv.pas
Normal file
@@ -0,0 +1,148 @@
|
||||
(* The Turbo Vision Stack Component. Part of the FreeType Debugger *)
|
||||
|
||||
unit StackTV;
|
||||
|
||||
interface
|
||||
|
||||
uses Objects, Views, Drivers, TTTypes, TTObjs, TTDebug;
|
||||
|
||||
type
|
||||
|
||||
{ TStackView }
|
||||
|
||||
{ A Simple stack display }
|
||||
|
||||
PStackView = ^TStackView;
|
||||
TStackView = object( TListViewer )
|
||||
constructor Init( var Bounds : TRect;
|
||||
aexec : PExec_Context;
|
||||
AVScrollBar : PScrollBar );
|
||||
|
||||
procedure HandleEvent( var Event : TEvent ); virtual;
|
||||
procedure Draw; virtual;
|
||||
procedure Update;
|
||||
|
||||
private
|
||||
exec : PExec_Context;
|
||||
end;
|
||||
|
||||
{ TStackWindow }
|
||||
|
||||
PStackWindow = ^TStackWindow;
|
||||
TStackWindow = object( TWindow )
|
||||
V : PScrollBar;
|
||||
S : PStackView;
|
||||
constructor Init( var Bounds : TRect;
|
||||
exec : PExec_Context );
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$I DEBUGGER.INC}
|
||||
|
||||
{ TStackView }
|
||||
|
||||
constructor TStackView.Init;
|
||||
begin
|
||||
inherited Init( Bounds, 1, nil, AVScrollBar );
|
||||
exec := aexec;
|
||||
|
||||
GrowMode := gfGrowHiX or gfGrowHiY;
|
||||
DragMode := dmDragGrow or dmLimitLoX or dmLimitLoY;
|
||||
EventMask := EventMask or evWave;
|
||||
|
||||
SetRange( exec^.stackSize );
|
||||
end;
|
||||
|
||||
procedure TStackView.Draw;
|
||||
const
|
||||
Colors : array[0..1] of Byte = ($1E,$3E);
|
||||
var
|
||||
B : TDrawBuffer;
|
||||
Color : Byte;
|
||||
I, Item : Int;
|
||||
S : String[16];
|
||||
begin
|
||||
Color := Colors[0];
|
||||
|
||||
if exec^.top <= Size.Y then Item := Size.Y-1
|
||||
else Item := exec^.top-1-TopItem;
|
||||
|
||||
for I := 0 to Size.Y-1 do
|
||||
begin
|
||||
|
||||
MoveChar( B, ' ', Color, Size.X );
|
||||
|
||||
if Item < exec^.top then
|
||||
begin
|
||||
S := ' ' + Hex16( Item ) + ': ' + Hex32( exec^.stack^[Item] );
|
||||
MoveStr( B, S, Color );
|
||||
end;
|
||||
|
||||
WriteLine( 0, I, Size.X, 1, B );
|
||||
dec( Item );
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TStackView.Update;
|
||||
begin
|
||||
FocusItem( 0 );
|
||||
DrawView;
|
||||
end;
|
||||
|
||||
procedure TStackView.HandleEvent;
|
||||
var
|
||||
Limits : TRect;
|
||||
Mini, Maxi : Objects.TPoint;
|
||||
begin
|
||||
case Event.What of
|
||||
|
||||
evWave : case Event.Command of
|
||||
|
||||
cmReFocus : Update;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
inherited HandleEvent( Event );
|
||||
|
||||
case Event.Command of
|
||||
|
||||
cmResize: begin
|
||||
Owner^.GetExtent(Limits);
|
||||
SizeLimits( Mini, Maxi );
|
||||
DragView(Event, DragMode, Limits, Mini, Maxi );
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ TStackWindow }
|
||||
|
||||
constructor TStackWindow.Init;
|
||||
var
|
||||
R : TRect;
|
||||
begin
|
||||
inherited Init( Bounds, 'Pile', wnNoNumber );
|
||||
|
||||
GetExtent( Bounds );
|
||||
R := Bounds;
|
||||
R.A.X := R.B.X-1;
|
||||
inc( R.A.Y );
|
||||
dec( R.B.Y );
|
||||
New( V, Init(R) );
|
||||
Insert( V );
|
||||
|
||||
R := Bounds;
|
||||
R.Grow(-1,-1);
|
||||
New( S, Init( R, exec, V ));
|
||||
|
||||
Insert( S );
|
||||
end;
|
||||
|
||||
end.
|
||||
196
pascal/test/statetv.pas
Normal file
196
pascal/test/statetv.pas
Normal file
@@ -0,0 +1,196 @@
|
||||
unit StateTV;
|
||||
|
||||
interface
|
||||
|
||||
uses Objects, Views, Drivers, TTTypes, TTObjs, TTDebug;
|
||||
|
||||
{$I DEBUGGER.INC}
|
||||
|
||||
type
|
||||
|
||||
{ State Viewer }
|
||||
|
||||
{ A simple TView to show the current graphics state }
|
||||
|
||||
PStateViewer = ^TStateViewer;
|
||||
TStateViewer = object( TView )
|
||||
|
||||
constructor Init( var Bounds : TRect;
|
||||
aexec : PExec_Context );
|
||||
|
||||
procedure HandleEvent( var Event : TEvent ); virtual;
|
||||
procedure Draw; virtual;
|
||||
|
||||
private
|
||||
exec : PExec_Context;
|
||||
end;
|
||||
|
||||
{ PStateWindow }
|
||||
|
||||
PStateWindow = ^TStateWindow;
|
||||
TStateWindow = object( TWindow )
|
||||
stateView : PStateViewer;
|
||||
constructor Init( var Bounds : TRect;
|
||||
exec : PExec_Context );
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TStateViewer }
|
||||
|
||||
constructor TStateViewer.Init;
|
||||
begin
|
||||
inherited Init( Bounds );
|
||||
exec := aexec;
|
||||
Options := Options or ofSelectable;
|
||||
EventMask := EventMask or evWave;
|
||||
end;
|
||||
|
||||
procedure TStateViewer.Draw;
|
||||
var
|
||||
B : TDrawBuffer;
|
||||
S : String;
|
||||
Color : Int;
|
||||
n : Int;
|
||||
begin
|
||||
Color := $1E;
|
||||
n := 0;
|
||||
MoveChar( B, ' ', Color, Self.Size.X );
|
||||
|
||||
S := ' Loop ' + Hex16( exec^.GS.loop );
|
||||
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Auto_flip ';
|
||||
if exec^.GS.auto_flip then S := S + ' Yes'
|
||||
else S := S + ' No';
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Dual ('+Hex16(exec^.GS.dualVector.x)+','+
|
||||
Hex16(exec^.GS.dualVector.y)+')';
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Projection ('+Hex16(exec^.GS.projVector.x)+','+
|
||||
Hex16(exec^.GS.projVector.y)+')';
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Freedom ('+Hex16(exec^.GS.freeVector.x)+','+
|
||||
Hex16(exec^.GS.freeVector.y)+')';
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Gep0 ' + Hex8( exec^.GS.gep0 );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Gep1 ' + Hex8( exec^.GS.gep1 );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Gep2 ' + Hex8( exec^.GS.gep2 );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Ins_Control ' + Hex8( exec^.GS.instruct_control );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Rounding ' + Hex8( exec^.GS.round_state );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Min_Distance ' + Hex32( exec^.GS.minimum_distance );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Rp0 ' + Hex8( exec^.GS.rp0 );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Rp1 ' + Hex8( exec^.GS.rp1 );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Rp2 ' + Hex8( exec^.GS.rp2 );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Ctrl_Val_Cutin ' + Hex32( exec^.GS.control_value_cutin );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Sngl_Width_Cutin ' + Hex32( exec^.GS.single_width_cutin );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Sngl_Widht_Value ' + Hex32( exec^.GS.single_width_value );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
S := ' Scan_type ' + Hex8( exec^.GS.scan_type );
|
||||
MoveStr( B, S, Color );
|
||||
WriteLine( 0, n, Self.Size.X, 1, B );
|
||||
inc( n );
|
||||
|
||||
MoveChar( B, ' ', Color, Self.Size.X );
|
||||
WriteLine( 0, n, Self.Size.X, Size.Y-n, B );
|
||||
|
||||
end;
|
||||
|
||||
procedure TStateViewer.HandleEvent;
|
||||
var
|
||||
Limits : TRect;
|
||||
Mini, Maxi : Objects.TPoint;
|
||||
begin
|
||||
|
||||
inherited HandleEvent( Event );
|
||||
|
||||
case Event.What of
|
||||
|
||||
evWave : case Event.Command of
|
||||
|
||||
cmReFocus : DrawView;
|
||||
(*
|
||||
cmResize: begin
|
||||
Owner^.GetExtent(Limits);
|
||||
SizeLimits( Mini, Maxi );
|
||||
DragView(Event, DragMode, Limits, Mini, Maxi );
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
*)
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
constructor TStateWindow.Init;
|
||||
begin
|
||||
inherited Init( Bounds, 'State', wnNoNumber );
|
||||
GetExtent( Bounds );
|
||||
Bounds.Grow(-1,-1);
|
||||
New( StateView, Init( Bounds, exec ) );
|
||||
Insert( StateView );
|
||||
end;
|
||||
|
||||
end.
|
||||
377
pascal/test/timer.pas
Normal file
377
pascal/test/timer.pas
Normal file
@@ -0,0 +1,377 @@
|
||||
{***************************************************************************}
|
||||
{* *}
|
||||
{* 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.
|
||||
|
||||
523
pascal/test/view.pas
Normal file
523
pascal/test/view.pas
Normal file
@@ -0,0 +1,523 @@
|
||||
{***************************************************************************}
|
||||
{* *}
|
||||
{* FreeType Glyph Viewer. *}
|
||||
{* *}
|
||||
{* *}
|
||||
{* This small program will load a TrueType font file and allow *}
|
||||
{* you to view/scale/rotate its glyphs. Glyphs are in the order *}
|
||||
{* found within the 'glyf' table. *}
|
||||
{* *}
|
||||
{* NOTE : This version displays a magnified view of the glyph *}
|
||||
{* along with the pixel grid. *}
|
||||
{* *}
|
||||
{* This source code has been compiled and run under both Virtual Pascal *}
|
||||
{* on OS/2 and Borland's BP7. *}
|
||||
{* *}
|
||||
{***************************************************************************}
|
||||
|
||||
program View;
|
||||
|
||||
uses Crt,
|
||||
Common,
|
||||
{$IFDEF OS2}
|
||||
Use32,
|
||||
{$ENDIF}
|
||||
GMain,
|
||||
GEvents,
|
||||
GDriver,
|
||||
FreeType;
|
||||
|
||||
{&PMTYPE NOVIO}
|
||||
|
||||
{$DEFINE DEBUG}
|
||||
|
||||
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; (* Angle modulo 1024 *)
|
||||
|
||||
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;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : Set_Raster_Area
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
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;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : Clear_Data
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
procedure Clear_Data;
|
||||
begin
|
||||
if gray_level then
|
||||
fillchar( Bit.buffer^, Bit.size, gray_palette[0] )
|
||||
else
|
||||
fillchar( Bit.buffer^, Bit.size, 0 );
|
||||
end;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : Init_Engine
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
procedure Init_Engine( maxRes : Int );
|
||||
begin
|
||||
Set_Raster_Area;
|
||||
GetMem( Bit.buffer, Bit.size );
|
||||
Clear_Data;
|
||||
end;
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : Reset_Scale
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
function Reset_Scale( res : Int ) : Boolean;
|
||||
begin
|
||||
error := TT_Set_Instance_CharSize( instance, res*64 );
|
||||
Reset_Scale := (error = TT_Err_Ok);
|
||||
end;
|
||||
|
||||
|
||||
(*******************************************************************
|
||||
*
|
||||
* Function : LoadTrueTypeChar
|
||||
*
|
||||
* Description : Loads a single glyph into the xcoord, ycoord and
|
||||
* flag arrays, from the instance data.
|
||||
*
|
||||
*****************************************************************)
|
||||
|
||||
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 :
|
||||
{$IFDEF OS2}
|
||||
longint;
|
||||
{$ELSE}
|
||||
word;
|
||||
{$ENDIF}
|
||||
|
||||
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.
|
||||
|
||||
222
pascal/test/zonetv.pas
Normal file
222
pascal/test/zonetv.pas
Normal file
@@ -0,0 +1,222 @@
|
||||
{****************************************************************************}
|
||||
{* *}
|
||||
{* ZoneTV.PAS *}
|
||||
{* *}
|
||||
{* This unit implements a simple TrueType zone points viewer for the *}
|
||||
{* FREETYPE project debugger. *}
|
||||
{* *}
|
||||
{****************************************************************************}
|
||||
|
||||
Unit ZoneTV;
|
||||
|
||||
interface
|
||||
|
||||
uses Objects, Views, Drivers, FreeType, TTTypes, TTTables, TTObjs, TTDebug;
|
||||
|
||||
{$I DEBUGGER.INC}
|
||||
|
||||
type
|
||||
|
||||
{ TZoneViewer }
|
||||
|
||||
{ This TView is a simple point array viewer }
|
||||
|
||||
PZoneViewer = ^TZoneViewer;
|
||||
TZoneViewer = object( TListViewer )
|
||||
|
||||
constructor Init( var Bounds : TRect;
|
||||
AZone : PGlyph_Zone );
|
||||
|
||||
procedure Draw; virtual;
|
||||
procedure HandleEvent( var Event : TEvent ); virtual;
|
||||
|
||||
private
|
||||
Zone : PGlyph_Zone; { Pointer to the zone being displayed }
|
||||
Save : TGlyph_Zone; { A copy of the zone to highlight }
|
||||
{ changes }
|
||||
procedure Copy_Zone;
|
||||
|
||||
end;
|
||||
|
||||
{ TCodeWindow }
|
||||
|
||||
PZoneWindow = ^TZoneWindow;
|
||||
TZoneWindow = object( TWindow )
|
||||
ZoneView : PZoneViewer;
|
||||
constructor Init( var Bounds : TRect;
|
||||
AZone : PGlyph_Zone );
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TZoneViewer }
|
||||
|
||||
constructor TZoneViewer.Init;
|
||||
var
|
||||
n : Int;
|
||||
begin
|
||||
inherited Init( Bounds, 1, nil, nil );
|
||||
|
||||
GrowMode := gfGrowHiX or gfGrowHiY;
|
||||
DragMode := dmDragGrow or dmLimitLoX or dmLimitLoY;
|
||||
Options := Options or ofSelectable;
|
||||
EventMask := EventMask or evWave;
|
||||
|
||||
Zone := AZone;
|
||||
|
||||
GetMem( Save.org, zone^.n_points*2*sizeof(Long) );
|
||||
GetMem( Save.cur, zone^.n_points*2*sizeof(Long) );
|
||||
GetMem( Save.flags, zone^.n_points*sizeof(Byte) );
|
||||
|
||||
Save.n_points := Zone^.n_points;
|
||||
Save.n_contours := Zone^.n_contours;
|
||||
|
||||
Copy_Zone;
|
||||
|
||||
SetRange( Save.n_points );
|
||||
end;
|
||||
|
||||
|
||||
procedure TZoneViewer.Copy_Zone;
|
||||
var
|
||||
n : Int;
|
||||
begin
|
||||
n := 2*zone^.n_points * sizeof(Long);
|
||||
|
||||
(* Note that we save also the original coordinates, as we're not sure *)
|
||||
(* that the debugger is debugged ! *)
|
||||
|
||||
move( Zone^.org^, Save.org^, n );
|
||||
move( Zone^.cur^, Save.cur^, n );
|
||||
move( Zone^.flags^, Save.flags^, zone^.n_points );
|
||||
end;
|
||||
|
||||
|
||||
procedure TZoneViewer.HandleEvent( var Event : TEvent );
|
||||
var
|
||||
Limits : TRect;
|
||||
Mini, Maxi : Objects.TPoint;
|
||||
begin
|
||||
|
||||
inherited HandleEvent(Event);
|
||||
|
||||
Case Event.What of
|
||||
|
||||
evWave : case Event.Command of
|
||||
|
||||
cmNewExecution : Copy_Zone;
|
||||
|
||||
cmRefocus : DrawView;
|
||||
|
||||
end;
|
||||
|
||||
evCommand : case Event.Command of
|
||||
|
||||
cmResize: begin
|
||||
Owner^.GetExtent(Limits);
|
||||
SizeLimits( Mini, Maxi );
|
||||
DragView(Event, DragMode, Limits, Mini, Maxi );
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TZoneViewer.Draw;
|
||||
const
|
||||
Colors : array[0..3] of byte
|
||||
= ($30,$3F,$0B,$0E);
|
||||
Touchs : array[0..3] of Char
|
||||
= (' ','x','y','b');
|
||||
OnOff : array[0..1] of Char
|
||||
= (' ',':');
|
||||
var
|
||||
I, J, Item : Int;
|
||||
B : TDrawBuffer;
|
||||
S : String;
|
||||
Indent : Int;
|
||||
Ligne : Int;
|
||||
|
||||
Changed : Boolean;
|
||||
|
||||
Back_Color,
|
||||
Color : word;
|
||||
|
||||
On_BP : boolean;
|
||||
BP : PBreakPoint;
|
||||
|
||||
begin
|
||||
|
||||
if HScrollBar <> nil then Indent := HScrollBar^.Value
|
||||
else Indent := 0;
|
||||
|
||||
with Save do
|
||||
begin
|
||||
|
||||
for I := 0 to Self.Size.Y-1 do
|
||||
begin
|
||||
|
||||
MoveChar( B, ' ', Colors[0], Self.Size.X );
|
||||
|
||||
Item := TopItem + I;
|
||||
|
||||
if (Range > 0) and
|
||||
( Focused = Item ) then Back_Color := 2
|
||||
else Back_Color := 0;
|
||||
|
||||
if Item < n_points then
|
||||
begin
|
||||
|
||||
Color := Back_Color;
|
||||
if ( flags^[item] <> Zone^.flags^[item] ) then inc( Color );
|
||||
|
||||
S := Hex16( Item ) + ': ';
|
||||
S[1] := OnOff[Zone^.flags^[item] and 1];
|
||||
S[7] := Touchs[(Zone^.flags^[item] and TT_Flag_Touched_Both) shr 1];
|
||||
|
||||
MoveStr( B, S, Colors[Color] );
|
||||
|
||||
Color := Back_Color;
|
||||
if ( org^[item].x <> Zone^.org^[item].x ) then inc( Color );
|
||||
|
||||
MoveStr ( B[8], Hex32( Zone^.org^[item].x ), Colors[Color] );
|
||||
MoveChar( B[16], ',', Colors[0], 1 );
|
||||
|
||||
Color := Back_Color;
|
||||
if ( org^[item].y <> Zone^.org^[item].y ) then inc( Color );
|
||||
|
||||
MoveStr( B[17], Hex32( Zone^.org^[item].y ), Colors[Color] );
|
||||
MoveStr( B[25], ' : ', Colors[0] );
|
||||
|
||||
Color := Back_Color;
|
||||
if ( cur^[item].x <> Zone^.cur^[item].x ) then inc( Color );
|
||||
|
||||
MoveStr ( B[28], Hex32( Zone^.cur^[item].x ), Colors[Color] );
|
||||
MoveChar( B[36], ',', Colors[0], 1 );
|
||||
|
||||
Color := Back_Color;
|
||||
if ( cur^[item].y <> Zone^.cur^[item].y ) then inc( Color );
|
||||
|
||||
MoveStr( B[37], Hex32( Zone^.cur^[item].y ), Colors[Color] );
|
||||
|
||||
end;
|
||||
|
||||
WriteLine( 0, I, Self.Size.X, 1, B );
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TZoneWindow }
|
||||
|
||||
constructor TZoneWindow.Init;
|
||||
begin
|
||||
inherited Init( Bounds,'Zone',wnNoNumber );
|
||||
GetExtent( Bounds );
|
||||
Bounds.Grow(-1,-1);
|
||||
New( ZoneView, Init( Bounds, AZone ) );
|
||||
Insert( ZoneView );
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user