unit TTInterp;
interface
uses FreeType,
TTTypes,
TTObjs;
function Run_Ins( exec : PExec_Context ) : Boolean;
implementation
uses
TTError,
TTMemory,
TTCalc;
type
TInstruction_Function = procedure( args : PStorage );
const
Null_Vector : TT_Vector = (x:0;y:0);
var
exc : TExec_Context;
const
Pop_Push_Count : array[0..511] of byte
= (
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
0, 2,
0, 2,
0, 0,
5, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
0, 0,
0, 0,
1, 0,
0, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 2,
1, 0,
0, 0,
2, 2,
0, 1,
1, 1,
1, 0,
2, 0,
0, 0,
1, 0,
2, 0,
1, 0,
1, 0,
0, 0,
1, 0,
1, 0,
0, 0,
0, 0,
0, 0,
0, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
0, 0,
2, 0,
2, 0,
0, 0,
0, 0,
2, 0,
2, 0,
0, 0,
0, 0,
2, 0,
1, 1,
2, 0,
1, 1,
1, 1,
1, 1,
2, 0,
2, 1,
2, 1,
0, 1,
0, 1,
0, 0,
0, 0,
1, 0,
2, 1,
2, 1,
2, 1,
2, 1,
2, 1,
2, 1,
1, 1,
1, 1,
1, 0,
0, 0,
2, 1,
2, 1,
1, 1,
1, 0,
1, 0,
1, 0,
2, 1,
2, 1,
2, 1,
2, 1,
1, 1,
1, 1,
1, 1,
1, 1,
1, 1,
1, 1,
1, 1,
1, 1,
1, 1,
1, 1,
1, 1,
1, 1,
2, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
2, 0,
2, 0,
0, 0,
0, 0,
0, 0,
0, 0,
1, 0,
1, 0,
0, 0,
2, 0,
2, 0,
0, 0,
0, 0,
1, 0,
2, 0,
2, 0,
1, 1,
1, 0,
3, 3,
2, 1,
2, 1,
1, 0,
2, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 0,
0, 1,
0, 2,
0, 3,
0, 4,
0, 5,
0, 6,
0, 7,
0, 8,
0, 1,
0, 2,
0, 3,
0, 4,
0, 5,
0, 6,
0, 7,
0, 8,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0,
2, 0
);
function Norm( X, Y : TT_F26dot6 ): TT_F26dot6;
var
T1, T2 : Int64;
begin
MulTo64( X, X, T1 );
MulTo64( Y, Y, T2 );
Add64( T1, T2, T1 );
if ( (T1.lo or T1.Hi) = 0 ) then Norm := 0
else Norm := Sqrt64( T1 );
end;
function Scale_Pixels( value : long ) : TT_F26Dot6;
inline;
begin
Scale_Pixels := MulDiv_Round( value,
exc.metrics.scale1,
exc.metrics.scale2 );
end;
function Get_Current_Ratio : Long;
var
x, y : Long;
begin
if exc.metrics.ratio <> 0 then
Get_Current_Ratio := exc.metrics.ratio
else
begin
if exc.GS.projVector.y = 0 then
exc.metrics.ratio := exc.metrics.x_ratio
else if exc.GS.projVector.x = 0 then
exc.metrics.ratio := exc.metrics.y_ratio
else
begin
x := MulDiv_Round( exc.GS.projVector.x,
exc.metrics.x_ratio,
$4000 );
y := MulDiv_Round( exc.GS.projVector.y,
exc.metrics.y_ratio,
$4000 );
exc.metrics.ratio := Norm( x, y );
end;
Get_Current_Ratio := exc.metrics.ratio;
end
end;
function Get_Ppem : Long;
inline;
begin
Get_Ppem := MulDiv_Round( exc.metrics.ppem, Get_Current_Ratio, $10000 );
end;
function Read_CVT( index : Int ) : TT_F26Dot6;
far;
begin
Read_CVT := exc.cvt^[index];
end;
function Read_CVT_Stretched( index : Int ) : TT_F26Dot6; far;
begin
Read_CVT_Stretched := MulDiv_Round( exc.cvt^[index],
Get_Current_Ratio,
$10000 );
end;
procedure Write_CVT( index : Int; value : TT_F26Dot6 ); far;
begin
exc.cvt^[index] := value;
end;
procedure Write_CVT_Stretched( index : Int; value : TT_F26Dot6 ); far;
begin
exc.cvt^[index] := MulDiv_Round( value,
$10000,
Get_Current_Ratio );
end;
procedure Move_CVT( index : Int; value : TT_F26Dot6 ); far;
begin
inc( exc.cvt^[index], value );
end;
procedure Move_CVT_Stretched( index : Int; value : TT_F26dot6 ); far;
begin
inc( exc.cvt^[index], MulDiv_Round( value,
$10000,
Get_Current_Ratio ));
end;
function Calc_Length : boolean;
begin
Calc_Length := false;
exc.opcode := exc.Code^[exc.IP];
case exc.opcode of
$40 : if exc.IP+1 >= exc.codeSize
then exit
else
exc.length := exc.code^[exc.IP+1] + 2;
$41 : if exc.IP+1 >= exc.codeSize
then exit
else
exc.length := exc.code^[exc.IP+1]*2 + 2;
$B0..$B7 : exc.length := exc.opcode-$B0 + 2;
$B8..$BF : exc.length := (exc.opcode-$B8)*2 + 3;
else
exc.length := 1;
end;
Calc_Length := exc.IP+exc.length <= exc.codeSize;
end;
function GetShort : Short;
var
L : Array[0..1] of Byte;
resultat : Short absolute L;
begin
L[1] := exc.code^[exc.IP]; inc(exc.IP);
L[0] := exc.code^[exc.IP]; inc(exc.IP);
GetShort := resultat;
end;
function Goto_CodeRange( aRange,
aIP : Int ): boolean;
begin
Goto_CodeRange := False;
with exc do
begin
if (aRange<1) or (aRange>3) then
begin
exc.error := TT_Err_Bad_Argument;
exit;
end;
with CodeRangeTable[ARange] do
begin
if Base = nil then
begin
error := TT_Err_Invalid_Coderange;
exit;
end;
if AIP > Size then
begin
error := TT_Err_Code_Overflow;
Goto_CodeRange := False;
exit;
end;
Code := PByte(Base);
CodeSize := Size;
IP := AIP;
end;
curRange := ARange;
end;
Goto_CodeRange := True;
end;
procedure Direct_Move( zone : PGlyph_Zone;
point : Int;
distance : TT_F26dot6 );
var
v : TT_F26dot6;
begin
v := exc.GS.freeVector.x;
if v <> 0 then
begin
inc( zone^.cur^[point].x, MulDiv_Round( distance,
Long(v)*$10000,
exc.F_dot_P ));
zone^.flags^[point] := zone^.flags^[point] or TT_Flag_Touched_X;
end;
v := exc.GS.freeVector.y;
if v <> 0 then
begin
inc( zone^.cur^[point].y, MulDiv_Round( distance,
Long(v)*$10000,
exc.F_dot_P ));
zone^.flags^[point] := zone^.flags^[point] or TT_Flag_Touched_Y;
end;
end;
procedure Direct_Move_X( zone : PGlyph_Zone;
point : Int;
distance : TT_F26dot6 );
begin
inc( zone^.cur^[point].x, distance );
zone^.flags^[point] := zone^.flags^[point] or TT_Flag_Touched_X;
end;
procedure Direct_Move_Y( zone : PGlyph_Zone;
point : Int;
distance : TT_F26dot6 );
begin
inc( zone^.cur^[point].y, distance );
zone^.flags^[point] := zone^.flags^[point] or TT_Flag_Touched_Y;
end;
function Round_None( distance : TT_F26dot6;
compensation : TT_F26dot6 ) : TT_F26dot6;
var
val : TT_F26dot6;
begin
if distance >= 0 then
begin
val := distance + compensation;
if val < 0 then val := 0;
end
else
begin
val := distance - compensation;
if val > 0 then val := 0;
end;
Round_None := val;
end;
function Round_To_Grid( distance : TT_F26dot6;
compensation : TT_F26dot6 ) : TT_F26dot6;
var
val : TT_F26dot6;
begin
if distance >= 0 then
begin
val := (distance + 32 + compensation) and -64;
if val < 0 then val := 0;
end
else
begin
val := - ((compensation - distance + 32) and -64);
if val > 0 then val := 0;
end;
Round_To_Grid := val;
end;
function Round_To_Half_Grid( distance : TT_F26dot6;
compensation : TT_F26dot6 ) : TT_F26dot6;
var
val : TT_F26dot6;
begin
if distance >= 0 then
begin
val := (distance + compensation) and -64 + 32;
if val < 0 then val := 0;
end
else
begin
val := - ((-distance + compensation) and -64 + 32);
if val > 0 then val := 0;
end;
Round_To_Half_Grid := val;
end;
function Round_Down_To_Grid( distance : TT_F26dot6;
compensation : TT_F26dot6 ) : TT_F26dot6;
var
val : TT_F26dot6;
begin
if distance >= 0 then
begin
val := (distance + compensation) and -64;
if val < 0 then val := 0;
end
else
begin
val := - ((-distance + compensation) and -64);
if val > 0 then val := 0;
end;
Round_Down_To_Grid := val;
end;
function Round_Up_To_Grid( distance : TT_F26dot6;
compensation : TT_F26dot6 ) : TT_F26dot6;
var
val : TT_F26dot6;
begin
if distance >= 0 then
begin
val := (distance + 63 + compensation) and -64;
if val < 0 then val := 0;
end
else
begin
val := - ((-distance + 63 + compensation) and -64);
if val > 0 then val := 0;
end;
Round_Up_To_Grid := val;
end;
function Round_To_Double_Grid( distance : TT_F26dot6;
compensation : TT_F26dot6 ) : TT_F26dot6;
var
val : TT_F26dot6;
begin
if distance >= 0 then
begin
val := (distance + 16 + compensation) and -32;
if val < 0 then val := 0;
end
else
begin
val := - ((-distance + 16 + compensation) and -32);
if val > 0 then val := 0;
end;
Round_To_Double_Grid := val;
end;
function Round_Super( distance : TT_F26dot6;
compensation : TT_F26dot6 ) : TT_F26dot6;
var
val : TT_F26dot6;
begin
with exc do
if distance >= 0 then
begin
val := (distance - phase + threshold + compensation) and -period;
if val < 0 then val := 0;
val := val + phase;
end
else
begin
val := -((-distance - phase + threshold + compensation) and -period);
if val > 0 then val := 0;
val := val - phase;
end;
Round_Super := val;
end;
function Round_Super_45( distance : TT_F26dot6;
compensation : TT_F26dot6 ) : TT_F26dot6;
var
val : TT_F26dot6;
begin
with exc do
if distance >= 0 then
begin
val := ((distance - phase + threshold + compensation) div period)
* period;
if val < 0 then val := 0;
val := val + phase;
end
else
begin
val := -((-distance - phase + threshold + compensation) div period
* period );
if val > 0 then val := 0;
val := val - phase;
end;
Round_Super_45 := val;
end;
procedure Compute_Round( round_mode : Byte );
begin
case Round_Mode of
TT_Round_Off : exc.func_round := @Round_None;
TT_Round_To_Grid : exc.func_round := @Round_To_Grid;
TT_Round_Up_To_Grid : exc.func_round := @Round_Up_To_Grid;
TT_Round_Down_To_Grid : exc.func_round := @Round_Down_To_Grid;
TT_Round_To_Half_Grid : exc.func_round := @Round_To_Half_Grid;
TT_Round_To_Double_Grid : exc.func_round := @Round_To_Double_Grid;
TT_Round_Super : exc.func_round := @Round_Super;
TT_Round_Super_45 : exc.func_round := @Round_Super_45;
TT_Round_Off : exc.func_round := Round_None;
TT_Round_To_Grid : exc.func_round := Round_To_Grid;
TT_Round_Up_To_Grid : exc.func_round := Round_Up_To_Grid;
TT_Round_Down_To_Grid : exc.func_round := Round_Down_To_Grid;
TT_Round_To_Half_Grid : exc.func_round := Round_To_Half_Grid;
TT_Round_To_Double_Grid : exc.func_round := Round_To_Double_Grid;
TT_Round_Super : exc.func_round := Round_Super;
TT_Round_Super_45 : exc.func_round := Round_Super_45;
end;
end;
procedure SetSuperRound( GridPeriod : TT_F26dot6; selector : Long );
begin
with exc do
begin
Case selector and $C0 of
$00 : period := GridPeriod div 2;
$40 : period := GridPeriod;
$80 : period := GridPeriod * 2;
$C0 : period := GridPeriod;
end;
Case selector and $30 of
$00 : phase := 0;
$10 : phase := period div 4;
$20 : phase := period div 2;
$30 : phase := gridPeriod*3 div 4;
end;
if selector and $F = 0 then
Threshold := Period-1
else
Threshold := (Integer( selector and $F )-4)*period div 8;
period := period div 256;
phase := phase div 256;
threshold := threshold div 256;
end
end;
function Project( var P1, P2 : TT_Vector ) : TT_F26dot6;
var
T1, T2 : Int64;
begin
with exc.GS.projVector do
begin
MulTo64( P1.x - P2.x, x, T1 );
MulTo64( P1.y - P2.y, y, T2 );
end;
Add64( T1, T2, T1 );
Project := Div64by32( T1, $4000 );
end;
function Dual_Project( var P1, P2 : TT_Vector ) : TT_F26dot6;
var
T1, T2 : Int64;
begin
with exc.GS.dualVector do
begin
MulTo64( P1.x - P2.x, x, T1 );
MulTo64( P1.y - P2.y, y, T2 );
end;
Add64( T1, T2, T1 );
Dual_Project := Div64by32( T1, $4000 );
end;
function Free_Project( var P1, P2 : TT_Vector ) : TT_F26dot6;
var
T1, T2 : Int64;
begin
with exc.GS.freeVector do
begin
MulTo64( P1.x - P2.x, x, T1 );
MulTo64( P1.y - P2.y, y, T2 );
end;
Add64( T1, T2, T1 );
Free_Project := Div64by32( T1, $4000 );
end;
function Project_x( var P1, P2 : TT_Vector ) : TT_F26dot6;
begin
Project_x := P1.x - P2.x;
end;
function Project_y( var P1, P2 : TT_Vector ) : TT_F26dot6;
begin
Project_y := P1.y - P2.y;
end;
procedure Compute_Funcs;
begin
with exc, GS do
begin
if (freeVector.x = $4000) then
begin
func_freeProj := @Project_x;
func_freeProj := Project_x;
F_dot_P := Long(projVector.x) * $10000;
end
else
if (freeVector.y = $4000) then
begin
func_freeProj := @Project_y;
func_freeProj := Project_y;
F_dot_P := Long(projVector.y) * $10000;
end
else
begin
func_move := @Direct_Move;
func_freeProj := @Free_Project;
func_move := Direct_Move;
func_freeProj := Free_Project;
F_dot_P := Long(projVector.x) * freeVector.x * 4 +
Long(projVector.y) * freeVector.y * 4;
end;
if (projVector.x = $4000) then func_Project := @Project_x
else
if (projVector.y = $4000) then func_Project := @Project_y
else
func_Project := @Project;
if (dualVector.x = $4000) then func_dualproj := @Project_x
else
if (dualVector.y = $4000) then func_dualproj := @Project_y
else
func_dualproj := @Dual_Project;
func_move := @Direct_Move;
if F_dot_P = $40000000 then
if freeVector.x = $4000 then func_move := @Direct_Move_x
else
if freeVector.y = $4000 then func_move := @Direct_Move_y;
if (projVector.x = $4000) then func_Project := Project_x
else
if (projVector.y = $4000) then func_Project := Project_y
else
func_Project := Project;
if (dualVector.x = $4000) then func_dualproj := Project_x
else
if (dualVector.y = $4000) then func_dualproj := Project_y
else
func_dualproj := Dual_Project;
func_move := Direct_Move;
if F_dot_P = $40000000 then
if freeVector.x = $4000 then func_move := Direct_Move_x
else
if freeVector.y = $4000 then func_move := Direct_Move_y;
if abs( F_dot_P ) < $4000000 then F_dot_P := $40000000;
metrics.ratio := 0;
end;
end;
function Normalize( U, V : TT_F26dot6; var R : TT_UnitVector ): boolean;
var
Vec : TT_Vector;
W : TT_F26dot6;
S1, S2 : Boolean;
T : Int64;
begin
if (Abs(U) < $10000) and (Abs(V) < $10000) then
begin
U := U*$100;
V := V*$100;
W := Norm( U, V );
if W = 0 then
begin
Normalize := SUCCESS;
exit;
end;
R.x := MulDiv( U, $4000, W );
R.y := MulDiv( V, $4000, W );
end
else
begin
W := Norm( U, V );
if W > 0 then
begin
U := MulDiv( U, $4000, W );
V := MulDiv( V, $4000, W );
W := U*U + V*V;
if U < 0 then begin U := -U; S1 := True; end else S1 := False;
if V < 0 then begin V := -V; S2 := True; end else S2 := False;
while W < $1000000 do
begin
if U < V then inc( U )
else inc( V );
W := U*U + V*V;
end;
while W >= $1004000 do
begin
if U < V then dec( U )
else dec( V );
W := U*U + V*V;
end;
if S1 then U := -U;
if S2 then V := -V;
R.x := U;
R.y := V;
end
else
begin
Normalize := False;
exc.error := TT_Err_Divide_By_Zero;
end;
end;
Normalize := True;
end;
procedure Ins_DUP( args : PStorage );
begin
args^[1] := args^[0];
end;
procedure Ins_POP( args : PStorage );
begin
end;
procedure Ins_CLEAR( args : PStorage );
begin
exc.new_top := 0;
end;
procedure Ins_SWAP( args : PStorage );
var L : Long;
begin
L := args^[0];
args^[0] := args^[1];
args^[1] := L;
end;
procedure Ins_DEPTH( args : PStorage );
begin
args^[0] := exc.top;
end;
procedure Ins_CINDEX( args : PStorage );
var
L : Long;
begin
L := args^[0];
if (L <= 0) or (L > exc.args) then
exc.error := TT_Err_Invalid_Reference
else
args^[0] := exc.stack^[exc.args-l];
end;
procedure Ins_MINDEX( args : PStorage );
var
L, K : Long;
begin
L := args^[0];
if (L <= 0) or (L > exc.args) then
exc.Error := TT_Err_Invalid_Reference
else
begin
K := exc.stack^[exc.args-L];
move( exc.stack^[exc.args-L+1],
exc.stack^[exc.args-L],
(L-1)*sizeof(Long) );
exc.stack^[exc.args-1] := K;
end;
end;
procedure Ins_ROLL( args : PStorage );
var
A, B, C : Long;
begin
A := args^[2];
B := args^[1];
C := args^[0];
args^[2] := C;
args^[1] := A;
args^[0] := B;
end;
function SkipCode : boolean;
var
b : Boolean;
begin
b := False;
inc( exc.IP, exc.length );
b := exc.IP < exc.codeSize;
if b then b := Calc_Length;
if not b then
exc.error := TT_Err_Code_Overflow;
SkipCode := b;
end;
procedure Ins_IF( args : PStorage );
var
nIfs : Int;
Out : Boolean;
begin
if args^[0] <> 0 then exit;
nIfs := 1;
Out := False;
Repeat
if not SkipCode then exit;
Case exc.opcode of
$58 : inc( nIfs );
$1B : out:= nIfs=1;
$59 : begin
dec( nIfs );
out:= nIfs=0;
end;
end;
until Out;
end;
procedure Ins_ELSE( args : PStorage );
var
nIfs : Int;
begin
nIfs := 1;
Repeat
if not SkipCode then exit;
case exc.opcode of
$58 : inc( nIfs );
$59 : dec( nIfs );
end;
until nIfs=0;
end;
procedure Ins_EIF( args : PStorage );
begin
end;
procedure Ins_JROT( args : PStorage );
begin
if args^[1] <> 0 then
begin
inc( exc.IP, args^[0] );
exc.step_ins := false;
end;
end;
procedure Ins_JMPR( args : PStorage );
begin
inc( exc.IP, args^[0] );
exc.step_ins := false;
end;
procedure Ins_JROF( args : PStorage );
begin
if args^[1] = 0 then
begin
inc( exc.IP, args^[0] );
exc.step_ins := false;
end;
end;
procedure Ins_LT( args : PStorage );
begin
if args^[0] < args^[1] then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_LTEQ( args : PStorage );
begin
if args^[0] <= args^[1] then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_GT( args : PStorage );
begin
if args^[0] > args^[1] then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_GTEQ( args : PStorage );
begin
if args^[0] >= args^[1] then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_EQ( args : PStorage );
begin
if args^[0] = args^[1] then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_NEQ( args : PStorage );
begin
if args^[0] <> args^[1] then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_ODD( args : PStorage );
begin
if exc.func_round( args^[0], 0 ) and 127 = 64 then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_EVEN( args : PStorage );
begin
if exc.func_round( args^[0], 0 ) and 127 = 0 then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_AND( args : PStorage );
begin
if ( args^[0] <> 0 ) and
( args^[1] <> 0 ) then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_OR( args : PStorage );
begin
if ( args^[0] <> 0 ) or
( args^[1] <> 0 ) then args^[0] := 1
else args^[0] := 0;
end;
procedure Ins_NOT( args : PStorage );
begin
if args^[0] <> 0 then args^[0] := 0
else args^[0] := 1;
end;
procedure Ins_ADD( args : PStorage );
begin
inc( args^[0], args^[1] );
end;
procedure Ins_SUB( args : PStorage );
begin
dec( args^[0], args^[1] );
end;
procedure Ins_DIV( args : PStorage );
begin
if args^[1] = 0 then
begin
exc.error := TT_Err_Divide_By_Zero;
exit;
end;
args^[0] := MulDiv_Round( args^[0], 64, args^[1] );
end;
procedure Ins_MUL( args : PStorage );
begin
args^[0] := MulDiv_Round( args^[0], args^[1], 64 );
end;
procedure Ins_ABS( args : PStorage );
begin
args^[0] := abs( args^[0] );
end;
procedure Ins_NEG( args : PStorage );
begin
args^[0] := -args^[0];
end;
procedure Ins_FLOOR( args : PStorage );
begin
args^[0] := args^[0] and -64;
end;
procedure Ins_CEILING( args : PStorage );
begin
args^[0] := ( args^[0]+63 ) and -64;
end;
procedure Ins_MAX( args : PStorage );
begin
if args^[1] > args^[0] then args^[0] := args^[1];
end;
procedure Ins_MIN( args : PStorage );
begin
if args^[1] < args^[0] then args^[0] := args^[1];
end;
procedure Ins_ROUND( args : PStorage );
begin
args^[0] := exc.func_round( args^[0],
exc.metrics.compensations[ exc.opcode-$68 ] );
end;
procedure Ins_NROUND( args : PStorage );
begin
args^[0] := Round_None( args^[0],
exc.metrics.compensations[ exc.opcode-$6C ] );
end;
procedure Ins_FDEF( args : PStorage );
var
func : int;
label
Suite;
begin
if exc.numFDefs >= exc.maxFDefs then begin
exc.error := TT_Err_Too_Many_FuncDefs;
exit;
end;
func := Int(args^[0]);
with exc.FDefs^[exc.numFDefs] do
begin
Range := exc.curRange;
Opc := func;
Start := exc.IP+1;
Active := True;
end;
if func > exc.maxFunc then
exc.maxFunc := func;
inc(exc.numFDefs);
while SkipCode do
case exc.opcode of
$89,
$2C :
begin
exc.error := TT_Err_Nested_Defs;
exit;
end;
$2D :
exit;
end;
end;
procedure Ins_ENDF( args : PStorage );
begin
if exc.callTop <= 0 then
begin
exc.error := TT_Err_ENDF_in_Exec_Stream;
exit;
end;
dec( exc.CallTop );
with exc.Callstack^[exc.CallTop] do
begin
dec( Cur_Count );
exc.step_ins := false;
if Cur_Count > 0 then
begin
inc( exc.callTop );
exc.IP := Cur_Restart;
end
else
Goto_CodeRange( Caller_Range, Caller_IP )
end;
end;
procedure Ins_CALL( args : PStorage );
var
ii, nn : Int;
def : PDefRecord;
label
Fail;
begin
if (args^[0] < 0) or (args^[0] > exc.maxFunc) then
goto Fail;
nn := Int(args^[0]);
def := @exc.FDefs^[nn];
if ( exc.maxFunc+1 <> exc.numFDefs ) or ( def^.opc <> nn ) then begin
ii := 0;
def := @exc.FDefs^[0];
while (ii < exc.numFDefs) and (def^.opc <> nn) do begin
inc(ii);
inc(def);
end;
if ii >= exc.numFDefs then
goto Fail;
end;
if not def^.active then
goto Fail;
if exc.callTop >= exc.callSize then
begin
exc.error := TT_Err_Stack_Overflow;
exit;
end;
with exc.callstack^[exc.callTop] do
begin
Caller_Range := exc.curRange;
Caller_IP := exc.IP+1;
Cur_Count := 1;
Cur_Restart := def^.Start;
end;
inc( exc.CallTop );
with def^ do Goto_CodeRange( Range, Start );
exc.step_ins := false;
exit;
Fail:
exc.error := TT_Err_Invalid_Reference;
exit;
end;
procedure Ins_LOOPCALL( args : PStorage );
begin
if ( args^[1] < 0 ) or ( args^[1] >= exc.numFDefs ) or
( not exc.FDefs^[args^[1]].Active ) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
if exc.callTop >= exc.callSize then
begin
exc.error := TT_Err_Stack_Overflow;
exit;
end;
if args^[0] > 0 then
begin
with exc.callstack^[exc.callTop] do
begin
Caller_Range := exc.curRange;
Caller_IP := exc.IP+1;
Cur_Count := args^[0];
Cur_Restart := exc.FDefs^[args^[1]].Start;
end;
inc( exc.CallTop );
with exc.FDefs^[args^[1]] do Goto_CodeRange( Range, Start );
exc.step_ins := false;
end;
end;
procedure Ins_IDEF( args : PStorage );
var
i, A : Int;
begin
A := 0;
while ( A < exc.numIDefs ) do
with exc.IDefs^[A] do
begin
if not Active then
begin
Opc := args^[0];
Start := exc.IP+1;
Range := exc.curRange;
Active := True;
A := exc.numIDefs;
while SkipCode do
case exc.opcode of
$89,
$2C :
begin
exc.error := TT_Err_Nested_Defs;
exit;
end;
$2D :
exit;
end;
end
else
inc( A );
end;
end;
procedure Ins_NPUSHB( args : PStorage );
var
L, K : Long;
begin
L := exc.code^[exc.IP+1];
if exc.top + L > exc.stackSize then
begin
exc.error := TT_Err_Stack_Overflow;
exit;
end;
for K := 1 to L do
args^[k-1] := exc.code^[exc.IP+1+k];
inc( exc.new_top, L );
end;
procedure Ins_NPUSHW( args : PStorage );
var
L, K : Long;
begin
L := exc.code^[exc.IP+1];
if exc.top + L > exc.stackSize then
begin
exc.error := TT_Err_Stack_Overflow;
exit;
end;
inc( exc.IP, 2 );
for K := 1 to L do
args^[k-1] := GetShort;
exc.step_ins := false;
inc( exc.new_top, L );
end;
procedure Ins_PUSHB( args : PStorage );
var
L, K : Long;
begin
L := exc.opcode - $B0+1;
if exc.top + L >= exc.stackSize then
begin
exc.error := TT_Err_Stack_Overflow;
exit;
end;
for k := 1 to L do
args^[k-1] := exc.code^[exc.ip+k];
end;
procedure Ins_PUSHW( args : PStorage );
var
L, K : Long;
begin
L := exc.opcode - $B8+1;
if exc.top + L >= exc.stackSize then
begin
exc.error := TT_Err_Stack_Overflow;
exit;
end;
inc( exc.IP );
for k := 1 to L do
args^[k-1] := GetShort;
exc.step_ins := false;
end;
procedure Ins_RS( args : PStorage );
begin
if (args^[0] < 0) or (args^[0] >= exc.storeSize) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
args^[0] := exc.storage^[args^[0]];
end;
procedure Ins_WS( args : PStorage );
begin
if (args^[0] < 0) or (args^[0] >= exc.storeSize) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
exc.storage^[args^[0]] := args^[1];
end;
procedure Ins_WCVTP( args : PStorage );
begin
if (args^[0] < 0) or (args^[0] >= exc.cvtSize) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
exc.func_write_cvt( args^[0], args^[1] );
end;
procedure Ins_WCVTF( args : PStorage );
begin
if (args^[0] < 0) or (args^[0] >= exc.cvtSize) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
exc.cvt^[args^[0]] := Scale_Pixels(args^[1]);
end;
procedure Ins_RCVT( args : PStorage );
begin
if (args^[0] < 0) or (args^[0] >= exc.cvtSize) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
args^[0] := exc.func_read_cvt(args^[0]);
end;
procedure Ins_SVTCA( args : PStorage );
var A, B : Short;
begin
case (exc.opcode and 1) of
0 : A := $0000;
1 : A := $4000;
end;
B := A xor $4000;
exc.GS.freeVector.x := A;
exc.GS.projVector.x := A;
exc.GS.dualVector.x := A;
exc.GS.freeVector.y := B;
exc.GS.projVector.y := B;
exc.GS.dualVector.y := B;
Compute_Funcs;
end;
procedure Ins_SPVTCA( args : PStorage );
var A, B : Short;
begin
case (exc.opcode and 1) of
0 : A := $0000;
1 : A := $4000;
end;
B := A xor $4000;
exc.GS.projVector.x := A;
exc.GS.dualVector.x := A;
exc.GS.projVector.y := B;
exc.GS.dualVector.y := B;
Compute_Funcs;
end;
procedure Ins_SFVTCA( args : PStorage );
var A, B : Short;
begin
case (exc.opcode and 1) of
0 : A := $0000;
1 : A := $4000;
end;
B := A xor $4000;
exc.GS.freeVector.x := A;
exc.GS.freeVector.y := B;
Compute_Funcs;
end;
function Ins_SxVTL( aIdx1 : Int;
aIdx2 : Int;
aOpc : Int;
var Vec : TT_UnitVector ) : boolean;
var
A, B, C : Long;
begin
Ins_SxVTL := False;
with exc do
begin
if (aIdx2 >= zp1.n_points) or (aIdx1 >= zp2.n_points) then
begin
Error := TT_Err_Invalid_Reference;
exit;
end;
with zp1.Cur^[aIdx2] do
begin
A := x;
B := y;
end;
with zp2.Cur^[aIdx1] do
begin
dec( A, x );
dec( B, y );
end;
if aOpc and 1 <> 0 then
begin
C := B;
B := A;
A := -C;
end;
if not Normalize( A, B, Vec ) then
begin
exc.error := TT_Err_Ok;
Vec.x := $4000;
Vec.y := $0000;
end;
Ins_SxVTL := True;
end;
end;
procedure Ins_SPVTL( args : PStorage );
begin
if not INS_SxVTL( args^[1],
args^[0],
exc.opcode,
exc.GS.projVector ) then exit;
exc.GS.dualVector := exc.GS.projVector;
Compute_Funcs;
end;
procedure Ins_SFVTL( args : PStorage );
begin
if not INS_SxVTL( args^[1],
args^[0],
exc.opcode,
exc.GS.freeVector ) then exit;
Compute_Funcs;
end;
procedure Ins_SFVTPV( args : PStorage );
begin
exc.GS.freeVector := exc.GS.projVector;
Compute_Funcs;
end;
procedure Ins_SDPVTL( args : PStorage );
var
A, B, C : Long;
p1, p2 : Int;
begin
p1 := args^[1];
p2 := args^[0];
if (args^[0] < 0) or (args^[0] >= exc.zp1.n_points) or
(args^[1] < 0) or (args^[1] >= exc.zp2.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
A := exc.zp1.org^[p2].x - exc.zp2.org^[p1].x;
B := exc.zp1.org^[p2].y - exc.zp2.org^[p1].y;
if exc.opcode and 1 <> 0 then
begin
C := B;
B := A;
A := -C;
end;
Normalize( A, B, exc.GS.dualVector );
A := exc.zp1.cur^[p2].x - exc.zp2.cur^[p1].x;
B := exc.zp1.cur^[p2].y - exc.zp2.cur^[p1].y;
if exc.opcode and 1 <> 0 then
begin
C := B;
B := A;
A := -C;
end;
Normalize( A, B, exc.GS.projVector );
Compute_Funcs;
exc.error := TT_Err_Ok;
end;
procedure Ins_SPVFS( args : PStorage );
var
S : Short;
X, Y : Long;
begin
S := args^[1]; Y := S;
S := args^[0]; X := S;
if not Normalize( X, Y, exc.GS.projVector ) then exit;
exc.GS.dualVector := exc.GS.projVector;
Compute_Funcs;
end;
procedure Ins_SFVFS( args : PStorage );
var
S : Short;
X, Y : Long;
begin
S := args^[1]; Y := S;
S := args^[0]; X := S;
if not Normalize( X, Y, exc.GS.freeVector ) then exit;
Compute_Funcs;
end;
procedure Ins_GPV( args : PStorage );
begin
args^[0] := exc.GS.projVector.x;
args^[1] := exc.GS.projVector.y;
end;
procedure Ins_GFV( args : PStorage );
begin
args^[0] := exc.GS.freeVector.x;
args^[1] := exc.GS.freeVector.y;
end;
procedure Ins_SRP0( args : PStorage );
begin
exc.GS.rp0 := args^[0];
end;
procedure Ins_SRP1( args : PStorage );
begin
exc.GS.rp1 := args^[0];
end;
procedure Ins_SRP2( args : PStorage );
begin
exc.GS.rp2 := args^[0];
end;
procedure Ins_SZP0( args : PStorage );
begin
case args^[0] of
0 : exc.zp0 := exc.Twilight;
1 : exc.zp0 := exc.Pts;
else
exc.error := TT_Err_Invalid_Reference;
exit;
end;
exc.GS.gep0 := args^[0];
end;
procedure Ins_SZP1( args : PStorage );
begin
case args^[0] of
0 : exc.zp1 := exc.Twilight;
1 : exc.zp1 := exc.Pts;
else
exc.error := TT_Err_Invalid_Reference;
exit;
end;
exc.GS.gep1 := args^[0];
end;
procedure Ins_SZP2( args : PStorage );
begin
case args^[0] of
0 : exc.zp2 := exc.Twilight;
1 : exc.zp2 := exc.Pts;
else
exc.error := TT_Err_Invalid_Reference;
exit;
end;
exc.GS.gep2 := args^[0];
end;
procedure Ins_SZPS( args : PStorage );
begin
case args^[0] of
0 : exc.zp0 := exc.Twilight;
1 : exc.zp0 := exc.Pts;
else
exc.error := TT_Err_Invalid_Reference;
exit;
end;
exc.zp1 := exc.zp0;
exc.zp2 := exc.zp0;
exc.GS.gep0 := args^[0];
exc.GS.gep1 := args^[0];
exc.GS.gep2 := args^[0];
end;
procedure Ins_RTHG( args : PStorage );
begin
exc.GS.round_state := TT_Round_To_Half_Grid;
exc.func_round := @Round_To_Half_Grid;
exc.func_round := Round_To_Half_Grid;
end;
procedure Ins_RTG( args : PStorage );
begin
exc.GS.round_state := TT_Round_To_Grid;
exc.func_round := @Round_To_Grid;
exc.func_round := Round_To_Grid;
end;
procedure Ins_RTDG( args : PStorage );
begin
exc.GS.round_state := TT_Round_To_Double_Grid;
exc.func_round := @Round_To_Double_Grid;
exc.func_round := Round_To_Double_Grid;
end;
procedure Ins_RUTG( args : PStorage );
begin
exc.GS.round_state := TT_Round_Up_To_Grid;
exc.func_round := @Round_Up_To_Grid;
exc.func_round := Round_Up_To_Grid;
end;
procedure Ins_RDTG( args : PStorage );
begin
exc.GS.round_state := TT_Round_Down_To_Grid;
exc.func_round := @Round_Down_To_Grid;
exc.func_round := Round_Down_To_Grid;
end;
procedure Ins_ROFF( args : PStorage );
begin
exc.GS.round_state := TT_Round_Off;
exc.func_round := @Round_None;
exc.func_round := Round_None;
end;
procedure Ins_SROUND( args : PStorage );
begin
SetSuperRound( $4000, args^[0] );
exc.GS.round_state := TT_Round_Super;
exc.func_round := @Round_Super;
exc.func_round := Round_Super;
end;
procedure Ins_S45ROUND( args : PStorage );
begin
SetSuperRound( $2D41, args^[0] );
exc.GS.round_state := TT_Round_Super_45;
exc.func_round := @Round_Super_45;
exc.func_round := Round_Super_45;
end;
procedure Ins_SLOOP( args : PStorage );
begin
exc.GS.Loop := args^[0];
end;
procedure Ins_SMD( args : PStorage );
begin
exc.GS.minimum_distance := args^[0];
end;
procedure Ins_INSTCTRL( args : PStorage );
var
K, L : Int;
begin
K := args^[1];
L := args^[0];
if ( K < 1 ) or ( K > 2 ) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
if L <> 0 then L := K;
exc.GS.instruct_control := ( exc.GS.instruct_control and not K ) or L;
end;
procedure Ins_SCANCTRL( args : PStorage );
var
A : Int;
begin
A := args^[0] and $FF;
if A = $FF then
exc.GS.scan_Control := True
else
if A = 0 then
exc.GS.scan_Control := False
else
begin
A := A * 64;
if ( args^[0] and $100 <> 0 ) and
( exc.metrics.pointSize <= A ) then exc.GS.scan_Control := True;
if ( args^[0] and $200 <> 0 ) and
( false ) then exc.GS.scan_Control := True;
if ( args^[0] and $400 <> 0 ) and
( false ) then exc.GS.scan_Control := True;
if ( args^[0] and $800 <> 0 ) and
( exc.metrics.pointSize > A ) then exc.GS.scan_Control := False;
if ( args^[0] and $1000 <> 0 ) and
( not False ) then exc.GS.scan_Control := False;
if ( args^[0] and $2000 <> 0 ) and
( not False ) then exc.GS.scan_Control := False;
end;
end;
procedure Ins_SCANTYPE( args : PStorage );
begin
if (args^[0] >= 0 ) and (args^[0] <= 5) then
begin
if args^[0] = 3 then args^[0] := 2;
exc.GS.scan_type := args^[0];
end;
end;
procedure Ins_SCVTCI( args : PStorage );
begin
exc.GS.control_value_cutin := args^[0];
end;
procedure Ins_SSWCI( args : PStorage );
begin
exc.GS.single_width_cutin := args^[0];
end;
procedure Ins_SSW( args : PStorage );
begin
exc.GS.single_width_value := args^[0] div $400;
end;
procedure Ins_FLIPON( args : PStorage );
begin
exc.GS.auto_flip := True;
end;
procedure Ins_FLIPOFF( args : PStorage );
begin
exc.GS.auto_flip := False;
end;
procedure Ins_SANGW( args : PStorage );
begin
end;
procedure Ins_SDB( args : PStorage );
begin
exc.GS.delta_base := args^[0]
end;
procedure Ins_SDS( args : PStorage );
begin
exc.GS.delta_shift := args^[0]
end;
procedure Ins_GC( args : PStorage );
var
L : Int;
begin
L := args^[0];
if (L < 0) or (L >= exc.zp2.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
case exc.opcode and 1 of
0 : L := exc.func_project ( exc.zp2.cur^[L], Null_Vector );
1 : L := exc.func_dualProj( exc.zp2.org^[L], Null_Vector );
end;
args^[0] := L;
end;
procedure Ins_SCFS( args : PStorage );
var
K, L : Int;
begin
L := args^[0];
if (args^[0] < 0) or (args^[0] >= exc.zp2.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
K := exc.func_project( exc.zp2.cur^[L], Null_Vector );
exc.func_move( @exc.zp2, L, args^[1] - K );
if exc.GS.gep2 = 0 then
exc.zp2.org^[L] := exc.zp2.cur^[L];
end;
procedure Ins_MD( args : PStorage );
var
K, L : Int;
D : TT_F26dot6;
vec1 : TT_Vector;
vec2 : TT_Vector;
begin
K := args^[1];
L := args^[0];
if (args^[0] < 0) or (args^[0] >= exc.zp0.n_points) or
(args^[1] < 0) or (args^[1] >= exc.zp1.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
case exc.opcode and 1 of
0 : D := exc.func_dualProj( exc.zp0.org^[L], exc.zp1.org^[K] );
1 : D := exc.func_project ( exc.zp0.cur^[L], exc.zp1.cur^[K] );
end;
args^[0] := D;
end;
procedure Ins_MPPEM( args : PStorage );
begin
args^[0] := Get_Ppem;
end;
procedure Ins_MPS( args : PStorage );
begin
args^[0] := exc.metrics.pointSize;
end;
procedure Ins_FLIPPT( args : PStorage );
var
point : Int;
begin
if exc.top < exc.GS.loop then
begin
exc.error := TT_Err_Too_Few_Arguments;
exit;
end;
while exc.GS.loop > 0 do
begin
dec( exc.args );
point := exc.stack^[ exc.args ];
if (point < 0) or (point >= exc.pts.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
exc.pts.flags^[point] := exc.pts.flags^[point] xor TT_Flag_On_Curve;
dec( exc.GS.loop );
end;
exc.GS.loop := 1;
exc.new_top := exc.args;
end;
procedure Ins_FLIPRGON( args : PStorage );
var
I, K, L : Int;
begin
K := args^[1];
L := args^[0];
if (K < 0) or (K >= exc.pts.n_points) or
(L < 0) or (L >= exc.pts.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
for I := L to K do
exc.pts.flags^[I] := exc.pts.flags^[I] or TT_Flag_On_Curve;
end;
procedure Ins_FLIPRGOFF( args : PStorage );
var
I, K, L : Int;
begin
K := args^[1];
L := args^[0];
if (K < 0) or (K >= exc.pts.n_points) or
(L < 0) or (L >= exc.pts.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
for I := L to K do
exc.pts.flags^[I] := exc.pts.flags^[I] and not TT_Flag_On_Curve;
end;
function Compute_Point_Displacement( var x : TT_F26dot6;
var y : TT_F26dot6;
var zone : PGlyph_Zone;
var refp : Int ) : TError;
var
zp : PGlyph_Zone;
p : Int;
d : TT_F26dot6;
vec1 : TT_Vector;
vec2 : TT_Vector;
begin
Compute_Point_Displacement := Success;
case exc.opcode and 1 of
0 : begin zp := @exc.zp1; p := exc.GS.rp2; end;
1 : begin zp := @exc.zp0; p := exc.GS.rp1; end;
end;
if (p < 0) or (p >= zp^.n_points) then
begin
exc.error := TT_Err_Invalid_Displacement;
Compute_Point_Displacement := Failure;
exit;
end;
zone := zp;
refp := p;
d := exc.func_project( zp^.cur^[p], zp^.org^[p] );
x := MulDiv_Round( d, Long(exc.GS.freeVector.x)*$10000, exc.F_dot_P );
y := MulDiv_Round( d, Long(exc.GS.freeVector.y)*$10000, exc.F_dot_P );
end;
procedure Move_Zp2_Point( point : Int;
dx : TT_F26dot6;
dy : TT_F26dot6 );
begin
if exc.GS.freeVector.x <> 0 then
begin
inc( exc.zp2.cur^[point].x, dx );
exc.zp2.flags^[point] := exc.zp2.flags^[point] or TT_Flag_Touched_X;
end;
if exc.GS.freeVector.y <> 0 then
begin
inc( exc.zp2.cur^[point].y, dy );
exc.zp2.flags^[point] := exc.zp2.flags^[point] or TT_Flag_Touched_Y;
end;
end;
procedure Ins_SHP( args : PStorage );
var
zp : PGlyph_Zone;
refp : Int;
dx : TT_F26dot6;
dy : TT_F26dot6;
point: Int;
begin
if Compute_Point_Displacement( dx, dy, zp, refp ) then
exit;
if exc.top < exc.GS.loop then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
while exc.GS.loop > 0 do
begin
dec( exc.args );
point := exc.stack^[ exc.args ];
if (point < 0) or (point >= exc.zp2.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
Move_Zp2_Point( point, dx, dy );
dec( exc.GS.loop );
end;
exc.GS.loop := 1;
exc.new_top := exc.args;
end;
procedure Ins_SHC( args : PStorage );
var
zp : PGlyph_Zone;
refp : Int;
dx : TT_F26dot6;
dy : TT_F26dot6;
contour, i : Int;
first_point, last_point : Int;
begin
contour := args^[0];
if (args^[0] < 0) or (args^[0] >= exc.pts.n_contours ) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
if Compute_Point_Displacement( dx, dy, zp, refp ) then
exit;
if contour = 0 then first_point := 0 else
first_point := exc.pts.conEnds^[contour-1]+1;
last_point := exc.pts.conEnds^[contour];
for i := first_point to last_point do
begin
if (zp^.cur <> exc.zp2.cur) or
(refp <> i ) then
Move_Zp2_Point( i, dx, dy );
end;
end;
procedure Ins_SHZ( args : PStorage );
var
zp : PGlyph_Zone;
refp : Int;
dx : TT_F26dot6;
dy : TT_F26dot6;
zone, i : Int;
last_point : Int;
begin
zone := args^[0];
if (args^[0] < 0) or (args^[0] > 1) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
if Compute_Point_Displacement( dx, dy, zp, refp ) then
exit;
last_point := zp^.n_points-1;
for i := 0 to last_point do
begin
if (zp^.cur <> exc.zp2.cur) or
(refp <> i ) then
Move_Zp2_Point( i, dx, dy );
end;
end;
procedure Ins_SHPIX( args : PStorage );
var
dx : TT_F26dot6;
dy : TT_F26dot6;
point: Int;
begin
if exc.top < exc.GS.loop then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
dx := MulDiv_Round( args^[0],
exc.GS.freeVector.x,
$4000 );
dy := MulDiv_Round( args^[0],
exc.GS.freeVector.y,
$4000 );
while exc.GS.loop > 0 do
begin
dec( exc.args );
point := exc.stack^[ exc.args ];
if (point < 0) or (point >= exc.zp2.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
Move_Zp2_Point( point, dx, dy );
dec( exc.GS.loop );
end;
exc.GS.loop := 1;
exc.new_top := exc.args;
end;
procedure Ins_MSIRP( args : PStorage );
var
point : Int;
distance : TT_F26dot6;
vec1 : TT_Vector;
vec2 : TT_Vector;
begin
point := args^[0];
if (args^[0] < 0) or (args^[0] >= exc.zp1.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
if exc.GS.gep0 = 0 then
begin
exc.zp1.org^[point] := exc.zp0.org^[exc.GS.rp0];
exc.zp1.cur^[point] := exc.zp1.org^[point];
end;
distance := exc.func_project( exc.zp1.cur^[point],
exc.zp0.cur^[exc.GS.rp0] );
exc.func_move( @exc.zp1, point, args^[1] - distance );
exc.GS.rp1 := exc.GS.rp0;
exc.GS.rp2 := point;
if exc.opcode and 1 <> 0 then exc.GS.rp0 := point;
end;
procedure Ins_MDAP( args : PStorage );
var
point : Int;
cur_dist : TT_F26dot6;
distance : TT_F26dot6;
begin
point := args^[0];
if (args^[0] < 0) or (args^[0] >= exc.zp0.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
if exc.opcode and 1 <> 0 then
begin
cur_dist := exc.func_project( exc.zp0.cur^[point], Null_Vector );
distance := exc.func_round( cur_dist,
exc.metrics.compensations[0] ) -
cur_dist;
end
else
distance := 0;
exc.func_move( @exc.zp0, point, distance );
exc.GS.rp0 := point;
exc.GS.rp1 := point;
end;
procedure Ins_MIAP( args : PStorage );
var
cvtEntry : Int;
point : Int;
distance : TT_F26dot6;
org_dist : TT_F26dot6;
begin
cvtEntry := args^[1];
point := args^[0];
if (args^[0] < 0) or (args^[0] >= exc.zp0.n_points ) or
(args^[1] < 0) or (args^[1] >= exc.cvtSize) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
distance := exc.func_read_cvt(cvtEntry);
if exc.GS.gep0 = 0 then
begin
exc.zp0.org^[point].y := MulDiv_Round( exc.GS.freeVector.x,
distance,
$4000 );
exc.zp0.org^[point].y := MulDiv_Round( exc.GS.freeVector.y,
distance,
$4000 );
exc.zp0.cur^[point] := exc.zp0.org^[point];
end;
org_dist := exc.func_project( exc.zp0.cur^[point], Null_Vector );
if exc.opcode and 1 <> 0 then
begin
if abs( distance-org_dist ) > exc.GS.control_value_cutin then
distance := org_dist;
distance := exc.func_round( distance,
exc.metrics.compensations[0] );
end;
exc.func_move( @exc.zp0, point, distance - org_dist );
exc.GS.rp0 := point;
exc.GS.rp1 := point;
end;
procedure Ins_MDRP( args : PStorage );
var
point : Int;
distance : TT_F26dot6;
org_dist : TT_F26dot6;
begin
point := args^[0];
if (args^[0] < 0) or (args^[0] >= exc.zp1.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
org_dist := exc.func_dualProj( exc.zp1.org^[point],
exc.zp0.org^[exc.GS.rp0] );
if abs(org_dist) < exc.GS.single_width_cutin then
if org_dist >= 0 then org_dist := exc.GS.single_width_value
else org_dist := -exc.GS.single_width_value;
if exc.opcode and 4 <> 0 then
distance := exc.func_round( org_dist,
exc.metrics.compensations[ exc.opcode and 3 ] )
else
distance := Round_None( org_dist,
exc.metrics.compensations[ exc.opcode and 3 ] );
if exc.opcode and 8 <> 0 then
begin
if org_dist >= 0 then
if distance < exc.GS.minimum_distance then
distance := exc.GS.minimum_distance
else
else
if distance > -exc.GS.minimum_distance then
distance := -exc.GS.minimum_distance;
end;
org_dist := exc.func_project( exc.zp1.cur^[point],
exc.zp0.cur^[exc.GS.rp0] );
exc.func_move( @exc.zp1, point, distance - org_dist );
exc.GS.rp1 := exc.GS.rp0;
exc.GS.rp2 := point;
if exc.opcode and 16 <> 0 then exc.GS.rp0 := point;
end;
procedure Ins_MIRP( args : PStorage );
var
point : Int;
cvtEntry : Int;
cvt_dist : TT_F26dot6;
distance : TT_F26dot6;
cur_dist : TT_F26dot6;
org_dist : TT_F26dot6;
begin
point := args^[0];
cvtEntry := args^[1];
if (args^[0] < 0 ) or (args^[0] >= exc.zp1.n_points) or
(args^[1] < -1) or (args^[1] >= exc.cvtSize) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
if cvtEntry < 0 then
cvt_dist := 0
else
cvt_dist := exc.func_read_cvt(cvtEntry);
if abs(cvt_dist) < exc.GS.single_width_cutin then
if cvt_dist >= 0 then cvt_dist := exc.GS.single_width_value
else cvt_dist := -exc.GS.single_width_value;
if exc.GS.gep1 = 0 then
begin
exc.zp1.org^[point].x := exc.zp0.org^[exc.GS.rp0].x +
MulDiv_Round( cvt_dist,
exc.GS.freeVector.x,
$4000 );
exc.zp1.org^[point].x := exc.zp0.org^[exc.GS.rp0].y +
MulDiv_Round( cvt_dist,
exc.GS.freeVector.y,
$4000 );
exc.zp1.cur^[point] := exc.zp1.org^[point];
end;
org_dist := exc.func_dualProj( exc.zp1.org^[point],
exc.zp0.org^[exc.GS.rp0] );
cur_dist := exc.func_Project( exc.zp1.cur^[point],
exc.zp0.cur^[exc.GS.rp0] );
if exc.GS.auto_flip then
if (org_dist xor cvt_dist < 0) then
cvt_dist := -cvt_dist;
if exc.opcode and 4 <> 0 then
begin
if exc.GS.gep0 = exc.GS.gep1 then
if abs( cvt_dist - org_dist ) >= exc.GS.control_value_cutin then
cvt_dist := org_dist;
distance := exc.func_round( cvt_dist,
exc.metrics.compensations[ exc.opcode and 3 ] );
end
else
distance := Round_None( cvt_dist,
exc.metrics.compensations[ exc.opcode and 3 ] );
if exc.opcode and 8 <> 0 then
begin
if org_dist >= 0 then
if distance < exc.GS.minimum_distance then
distance := exc.GS.minimum_distance
else
else
if distance > -exc.GS.minimum_distance then
distance := -exc.GS.minimum_distance;
end;
exc.func_move( @exc.zp1, point, distance - cur_dist );
exc.GS.rp1 := exc.GS.rp0;
if exc.opcode and 16 <> 0 then exc.GS.rp0 := point;
exc.GS.rp2 := point;
end;
procedure Ins_ALIGNRP( args : PStorage );
var
point : Int;
distance : TT_F26dot6;
begin
if exc.top < exc.GS.loop then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
while exc.GS.loop > 0 do
begin
dec( exc.args );
point := exc.stack^[ exc.args ];
if (point < 0) or (point >= exc.zp1.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
distance := exc.func_project( exc.zp1.cur^[point],
exc.zp0.cur^[exc.GS.rp0] );
exc.func_move( @exc.zp1, point, -distance );
dec( exc.GS.loop );
end;
exc.GS.loop := 1;
exc.new_top := exc.args;
end;
procedure Ins_AA( args : PStorage );
begin
end;
procedure Ins_ISECT( args : PStorage );
var
point : Int;
a0, a1 : Int;
b0, b1 : Int;
discriminant : TT_F26dot6;
dx, dy,
dax, day,
dbx, dby : TT_F26dot6;
val : TT_F26dot6;
R : TT_Vector;
U, V : TT_UnitVector;
T1, T2 : Int64;
begin
point := args^[0];
a0 := args^[1];
a1 := args^[2];
b0 := args^[3];
b1 := args^[4];
if (b0 >= exc.zp0.n_points) or (b1 >= exc.zp0.n_points) or
(a0 >= exc.zp1.n_points) or (a1 >= exc.zp1.n_points) or
(point >= exc.zp0.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
dbx := exc.zp0.cur^[b1].x - exc.zp0.cur^[b0].x;
dby := exc.zp0.cur^[b1].y - exc.zp0.cur^[b0].y;
dax := exc.zp1.cur^[a1].x - exc.zp1.cur^[a0].x;
day := exc.zp1.cur^[a1].y - exc.zp1.cur^[a0].y;
dx := exc.zp0.cur^[b0].x - exc.zp1.cur^[a0].x;
dy := exc.zp0.cur^[b0].y - exc.zp1.cur^[a0].y;
exc.zp2.flags^[point] := exc.zp2.flags^[point] or
TT_Flag_Touched_Both;
discriminant := MulDiv( dax, -dby, $40 ) +
MulDiv( day, dbx, $40 );
if abs(discriminant) >= $40 then
begin
val := MulDiv( dx, -dby, $40 ) +
MulDiv( dy, dbx, $40 );
R.x := MulDiv( val, dax, discriminant );
R.y := MulDiv( val, day, discriminant );
exc.zp2.cur^[point].x := exc.zp1.cur^[a0].x + R.x;
exc.zp2.cur^[point].y := exc.zp1.cur^[a0].y + R.y;
end
else
begin
exc.zp2.cur^[point].x := ( exc.zp1.cur^[a0].x +
exc.zp1.cur^[a1].x +
exc.zp0.cur^[b0].x +
exc.zp0.cur^[b1].x ) div 4;
exc.zp2.cur^[point].y := ( exc.zp1.cur^[a0].y +
exc.zp1.cur^[a1].y +
exc.zp0.cur^[b0].y +
exc.zp0.cur^[b1].y ) div 4;
end;
end;
procedure Ins_ALIGNPTS( args : PStorage );
var
p1, p2 : Int;
distance : TT_F26dot6;
begin
p1 := args^[0];
p2 := args^[1];
if (args^[0] < 0) or (args^[0] >= exc.zp1.n_points) or
(args^[1] < 0) or (args^[1] >= exc.zp0.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
distance := exc.func_project( exc.zp0.cur^[p2],
exc.zp1.cur^[p1] ) div 2;
exc.func_move( @exc.zp1, p1, distance );
exc.func_move( @exc.zp0, p2, -distance );
end;
procedure Ins_IP( args : PStorage );
var
org_a : TT_F26dot6;
org_b : TT_F26dot6;
org_x : TT_F26dot6;
cur_a : TT_F26dot6;
cur_b : TT_F26dot6;
cur_x : TT_F26dot6;
distance : TT_F26dot6;
point : Int;
begin
if exc.top < exc.GS.loop then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
org_a := exc.func_dualProj( exc.zp0.org^[exc.GS.rp1], Null_Vector );
org_b := exc.func_dualProj( exc.zp1.org^[exc.GS.rp2], Null_Vector );
cur_a := exc.func_project( exc.zp0.cur^[exc.GS.rp1], Null_Vector );
cur_b := exc.func_project( exc.zp1.cur^[exc.GS.rp2], Null_Vector );
while exc.GS.loop > 0 do
begin
dec( exc.args );
point := exc.stack^[ exc.args ];
org_x := exc.func_dualProj( exc.zp2.org^[point], Null_Vector );
cur_x := exc.func_project( exc.zp2.cur^[point], Null_Vector );
if (( org_a <= org_b ) and ( org_x <= org_a )) or
(( org_a > org_b ) and ( org_x >= org_a )) then
begin
distance := ( cur_a - org_a ) + ( org_x - cur_x );
end
else
if (( org_a <= org_b ) and ( org_x >= org_b )) or
(( org_a > org_b ) and ( org_x < org_b )) then
begin
distance := ( cur_b - org_b ) + ( org_x - cur_x );
end
else
begin
distance := MulDiv( cur_b - cur_a,
org_x - org_a,
org_b - org_a ) + ( cur_a - cur_x );
end;
exc.func_move( @exc.zp2, point, distance );
dec( exc.GS.loop );
end;
exc.GS.loop := 1;
exc.new_top := exc.args;
end;
procedure Ins_UTP( args : PStorage );
var
mask : Byte;
begin
if (args^[0] < 0) or (args^[0] >= exc.zp0.n_points) then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
mask := $FF;
if exc.GS.freeVector.x <> 0 then mask := mask and not TT_Flag_Touched_X;
if exc.GS.freeVector.y <> 0 then mask := mask and not TT_Flag_Touched_Y;
exc.zp0.flags^[args^[0]] := exc.zp0.flags^[args^[0]] and mask;
end;
procedure Ins_IUP( args : PStorage );
var
mask : byte;
first_point,
end_point,
first_touched,
cur_touched,
point,
contour : Int;
orgs,
curs : TT_Points;
procedure Shift_X( p1, p2, p : Int );
var
i : Int;
x : TT_F26dot6;
begin
x := curs^[p].x - orgs^[p].x;
for i := p1 to p-1 do inc( curs^[i].x, x );
for i := p+1 to p2 do inc( curs^[i].x, x );
end;
procedure Shift_Y( p1, p2, p : Int );
var
i : Int;
y : TT_F26dot6;
begin
y := curs^[p].y - orgs^[p].y;
for i := p1 to p-1 do inc( curs^[i].y, y );
for i := p+1 to p2 do inc( curs^[i].y, y );
end;
procedure Interp_X( p1, p2, ref1, ref2 : Int );
var
i : Int;
x, x1, x2, d1, d2 : TT_F26dot6;
begin
if p1 > p2 then exit;
x1 := orgs^[ref1].x; d1 := curs^[ref1].x - orgs^[ref1].x;
x2 := orgs^[ref2].x; d2 := curs^[ref2].x - orgs^[ref2].x;
if x1 = x2 then
for i := p1 to p2 do
begin
x := orgs^[i].x;
if x <= x1 then x := x + d1
else x := x + d2;
curs^[i].x := x;
end
else
if x1 < x2 then
for i := p1 to p2 do
begin
x := orgs^[i].x;
if (x <= x1) then x := x + d1
else
if (x >= x2) then x := x + d2
else
x := curs^[ref1].x +
MulDiv( x-x1, curs^[ref2].x-curs^[ref1].x, x2-x1 );
curs^[i].x := x;
end
else
for i := p1 to p2 do
begin
x := orgs^[i].x;
if ( x <= x2 ) then x := x + d2
else
if ( x >= x1 ) then x := x + d1
else
x := curs^[ref1].x +
MulDiv( x-x1, curs^[ref2].x-curs^[ref1].x, x2-x1 );
curs^[i].x := x;
end;
end;
procedure Interp_Y( p1, p2, ref1, ref2 : Int );
var
i : Int;
y, y1, y2, d1, d2 : TT_F26dot6;
begin
if p1 > p2 then exit;
y1 := orgs^[ref1].y; d1 := curs^[ref1].y - orgs^[ref1].y;
y2 := orgs^[ref2].y; d2 := curs^[ref2].y - orgs^[ref2].y;
if y1 = y2 then
for i := p1 to p2 do
begin
y := orgs^[i].y;
if y <= y1 then y := y + d1
else y := y + d2;
curs^[i].y := y;
end
else
if y1 < y2 then
for i := p1 to p2 do
begin
y := orgs^[i].y;
if (y <= y1) then y := y + d1
else
if (y >= y2) then y := y + d2
else
y := curs^[ref1].y +
MulDiv( y-y1, curs^[ref2].y-curs^[ref1].y, y2-y1 );
curs^[i].y := y;
end
else
for i := p1 to p2 do
begin
y := orgs^[i].y;
if ( y <= y2 ) then y := y + d2
else
if ( y >= y1 ) then y := y + d1
else
y := curs^[ref1].y +
MulDiv( y-y1, curs^[ref2].y-curs^[ref1].y, y2-y1 );
curs^[i].y := y;
end;
end;
begin
orgs := exc.pts.org;
curs := exc.pts.cur;
case exc.opcode and 1 of
0 : mask := TT_Flag_Touched_Y;
1 : mask := TT_Flag_Touched_X;
end;
with exc do
begin
contour := 0;
point := 0;
repeat
end_point := pts.conEnds^[contour];
first_point := point;
while ( point <= end_point ) and
( pts.flags^[point] and mask = 0 ) do inc(point);
if point <= end_point then
begin
first_touched := point;
cur_touched := point;
inc( point );
while ( point <= end_point ) do
begin
if pts.flags^[point] and mask <> 0 then
begin
if opcode and 1 <> 0 then
Interp_X( cur_touched+1, point-1, cur_touched, point )
else
Interp_Y( cur_touched+1, point-1, cur_touched, point );
cur_touched := point;
end;
inc( point );
end;
if cur_touched = first_touched then
if opcode and 1 <> 0 then
Shift_X( first_point, end_point, cur_touched )
else
Shift_Y( first_point, end_point, cur_touched )
else
begin
if opcode and 1 <> 0 then
begin
interp_x( cur_touched+1, end_point, cur_touched, first_touched );
interp_x( first_point, first_touched-1, cur_touched, first_touched );
end
else
begin
interp_y( cur_touched+1, end_point, cur_touched, first_touched );
interp_y( first_point, first_touched-1, cur_touched, first_touched );
end;
end;
end;
inc( contour );
until contour >= pts.n_contours;
end;
end;
procedure Ins_DELTAP( args : PStorage );
var
nump : Int;
k : Int;
A, B, C :Int;
begin
nump := args^[0];
for K := 1 to nump do
begin
if exc.args < 2 then
begin
exc.error := TT_Err_Too_Few_Arguments;
exit;
end;
dec( exc.args, 2 );
A := exc.stack^[exc.args+1];
B := exc.stack^[ exc.args ];
if A < exc.zp0.n_points then
begin
C := ( B and $F0 ) shr 4;
Case exc.opcode of
$5D : ;
$71 : C := C+16;
$72 : C := C+32;
end;
C := C + exc.GS.delta_Base;
if GET_Ppem = C then
begin
B := (B and $F) - 8;
if B >= 0 then B := B+1;
B := ( B*64 ) div ( 1 shl exc.GS.delta_Shift );
exc.func_move( @exc.zp0, A, B );
end;
end;
end;
exc.new_top := exc.args;
end;
procedure Ins_DELTAC( args : PStorage );
var
nump : Int;
k : Int;
A, B, C :Int;
begin
nump := args^[0];
for K := 1 to nump do
begin
if exc.args < 2 then
begin
exc.error := TT_Err_Too_Few_Arguments;
exit;
end;
dec( exc.args, 2 );
A := exc.stack^[exc.args+1];
B := exc.stack^[ exc.args ];
if A >= exc.cvtSize then
begin
exc.error := TT_Err_Invalid_Reference;
exit;
end;
C := ( B and $F0 ) shr 4;
Case exc.opcode of
$73 : ;
$74 : C := C+16;
$75 : C := C+32;
end;
C := C + exc.GS.delta_Base;
if GET_Ppem = C then
begin
B := (B and $F) - 8;
if B >= 0 then B := B+1;
B := ( B*64 ) div ( 1 shl exc.GS.delta_Shift );
exc.func_move_cvt( A, B );
end;
end;
exc.new_top := exc.args;
end;
procedure Ins_DEBUG( args : PStorage );
begin
exc.error := TT_Err_Debug_Opcode;
end;
procedure Ins_GETINFO( args : PStorage );
var
K : Int;
begin
K := 0;
if args^[0] and 1 <> 0 then K := 3;
if false then K := K or $80;
if false then K := K or $100;
args^[0] := K;
end;
procedure Ins_UNKNOWN( args : PStorage );
begin
exc.error := TT_Err_Invalid_Opcode;
end;
const
Instruct_Dispatch : array[0..255] of TInstruction_Function
= (
Ins_SVTCA,
Ins_SVTCA,
Ins_SPVTCA,
Ins_SPVTCA,
Ins_SFVTCA,
Ins_SFVTCA,
Ins_SPVTL,
Ins_SPVTL,
Ins_SFVTL,
Ins_SFVTL,
Ins_SPVFS,
Ins_SFVFS,
Ins_GPV,
Ins_GFV,
Ins_SFVTPV,
Ins_ISECT,
Ins_SRP0,
Ins_SRP1,
Ins_SRP2,
Ins_SZP0,
Ins_SZP1,
Ins_SZP2,
Ins_SZPS,
Ins_SLOOP,
Ins_RTG,
Ins_RTHG,
Ins_SMD,
Ins_ELSE,
Ins_JMPR,
Ins_SCVTCI,
Ins_SSWCI,
Ins_SSW,
Ins_DUP,
Ins_POP,
Ins_CLEAR,
Ins_SWAP,
Ins_DEPTH,
Ins_CINDEX,
Ins_MINDEX,
Ins_ALIGNPTS,
Ins_UNKNOWN,
Ins_UTP,
Ins_LOOPCALL,
Ins_CALL,
Ins_FDEF,
Ins_ENDF,
Ins_MDAP,
Ins_MDAP,
Ins_IUP,
Ins_IUP,
Ins_SHP,
Ins_SHP,
Ins_SHC,
Ins_SHC,
Ins_SHZ,
Ins_SHZ,
Ins_SHPIX,
Ins_IP,
Ins_MSIRP,
Ins_MSIRP,
Ins_ALIGNRP,
Ins_RTDG,
Ins_MIAP,
Ins_MIAP,
Ins_NPUSHB,
Ins_NPUSHW,
Ins_WS,
Ins_RS,
Ins_WCVTP,
Ins_RCVT,
Ins_GC,
Ins_GC,
Ins_SCFS,
Ins_MD,
Ins_MD,
Ins_MPPEM,
Ins_MPS,
Ins_FLIPON,
Ins_FLIPOFF,
Ins_DEBUG,
Ins_LT,
Ins_LTEQ,
Ins_GT,
Ins_GTEQ,
Ins_EQ,
Ins_NEQ,
Ins_ODD,
Ins_EVEN,
Ins_IF,
Ins_EIF,
Ins_AND,
Ins_OR,
Ins_NOT,
Ins_DELTAP,
Ins_SDB,
Ins_SDS,
Ins_ADD,
Ins_SUB,
Ins_DIV,
Ins_MUL,
Ins_ABS,
Ins_NEG,
Ins_FLOOR,
Ins_CEILING,
Ins_ROUND,
Ins_ROUND,
Ins_ROUND,
Ins_ROUND,
Ins_ROUND,
Ins_ROUND,
Ins_ROUND,
Ins_ROUND,
Ins_WCVTF,
Ins_DELTAP,
Ins_DELTAP,
Ins_DELTAC,
Ins_DELTAC,
Ins_DELTAC,
Ins_SROUND,
Ins_S45ROUND,
Ins_JROT,
Ins_JROF,
Ins_ROFF,
Ins_UNKNOWN,
Ins_RUTG,
Ins_RDTG,
Ins_SANGW,
Ins_AA,
Ins_FLIPPT,
Ins_FLIPRGON,
Ins_FLIPRGOFF,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_SCANCTRL,
Ins_SDPVTL,
Ins_SDPVTL,
Ins_GETINFO,
Ins_IDEF,
Ins_ROLL,
Ins_MAX,
Ins_MIN,
Ins_SCANTYPE,
Ins_INSTCTRL,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_UNKNOWN,
Ins_PUSHB,
Ins_PUSHB,
Ins_PUSHB,
Ins_PUSHB,
Ins_PUSHB,
Ins_PUSHB,
Ins_PUSHB,
Ins_PUSHB,
Ins_PUSHW,
Ins_PUSHW,
Ins_PUSHW,
Ins_PUSHW,
Ins_PUSHW,
Ins_PUSHW,
Ins_PUSHW,
Ins_PUSHW,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MDRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP,
Ins_MIRP
);
function Run_Ins( exec : PExec_Context ) : Boolean;
label
SuiteLabel, ErrorLabel, No_Error;
var
A : Int;
begin
exc := exec^;
exc.metrics.ratio := 0;
if exc.instance^.metrics.x_ppem <> exc.instance^.metrics.y_ppem then
begin
exc.func_read_cvt := @Read_CVT_Stretched;
exc.func_write_cvt := @Write_CVT_Stretched;
exc.func_move_cvt := @Move_CVT_Stretched;
end
else
begin
exc.func_read_cvt := @Read_CVT;
exc.func_write_cvt := @Write_CVT;
exc.func_move_cvt := @Move_CVT;
end;
begin
exc.func_read_cvt := Read_CVT_Stretched;
exc.func_write_cvt := Write_CVT_Stretched;
exc.func_move_cvt := Move_CVT_Stretched;
end
else
begin
exc.func_read_cvt := Read_CVT;
exc.func_write_cvt := Write_CVT;
exc.func_move_cvt := Move_CVT;
end;
Compute_Funcs;
Compute_Round( exc.GS.round_state );
repeat
Calc_Length;
exc.args := exc.top - Pop_Push_Count[ exc.opcode*2 ];
if exc.args < 0 then
begin
exc.error := TT_Err_Too_Few_Arguments;
goto ErrorLabel;
end;
exc.new_top := exc.args + Pop_Push_Count[ exc.opcode*2+1 ];
if exc.new_top > exc.stackSize then
begin
exc.error := TT_Err_Stack_Overflow;
goto ErrorLabel;
end;
exc.step_ins := true;
exc.error := TT_Err_Ok;
Instruct_Dispatch[ exc.opcode ]( PStorage(@exc.stack^[exc.args]) );
if exc.error <> TT_Err_Ok then
begin
case exc.error of
TT_Err_Invalid_Opcode:
begin
A := 0;
while ( A < exc.numIDefs ) do
with exc.IDefs^[A] do
if Active and ( exc.opcode = Opc ) then
begin
if exc.callTop >= exc.callSize then
begin
exc.error := TT_Err_Invalid_Reference;
goto ErrorLabel;
end;
with exc.callstack^[exc.callTop] do
begin
Caller_Range := exc.curRange;
Caller_IP := exc.IP+1;
Cur_Count := 1;
Cur_Restart := Start;
end;
if not Goto_CodeRange( Range, Start ) then
goto ErrorLabel;
goto SuiteLabel;
end
else
inc(A);
exc.error := TT_Err_Invalid_Opcode;
goto ErrorLabel;
end;
else
exc.error := exc.error;
goto ErrorLabel;
end;
end;
exc.top := exc.new_top;
if exc.step_ins then inc( exc.IP, exc.length );
SuiteLabel:
if (exc.IP >= exc.codeSize) then
if exc.callTop > 0 then
begin
exc.error := TT_Err_Code_Overflow;
goto ErrorLabel;
end
else
goto No_Error;
until exc.instruction_trap;
No_Error:
Run_Ins := Success;
exec^ := exc;
exit;
ErrorLabel:
Run_Ins := Failure;
exec^ := exc;
end;
end.