pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Fixes compilation of freetype

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1566 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-04-12 09:00:36 +00:00
parent 0ca7bd6a4a
commit 9e2f90802b
9 changed files with 233 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

110
components/freetypepascal/lazfreetype.lpk Normal file
View File

@@ -0,0 +1,110 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<Name Value="lazfreetype"/>
<CompilerOptions>
<Version Value="10"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="20">
<Item1>
<Filename Value="freetype.pas"/>
<UnitName Value="FreeType"/>
</Item1>
<Item2>
<Filename Value="ttcache.pas"/>
<UnitName Value="TTCache"/>
</Item2>
<Item3>
<Filename Value="ttcalc.pas"/>
<UnitName Value="TTCalc"/>
</Item3>
<Item4>
<Filename Value="ttcalc1.inc"/>
<Type Value="Include"/>
</Item4>
<Item5>
<Filename Value="ttcalc2.inc"/>
<Type Value="Include"/>
</Item5>
<Item6>
<Filename Value="ttcalc3.inc"/>
<Type Value="Include"/>
</Item6>
<Item7>
<Filename Value="ttcalc4.inc"/>
<Type Value="Include"/>
</Item7>
<Item8>
<Filename Value="ttcmap.pas"/>
<UnitName Value="TTCMap"/>
</Item8>
<Item9>
<Filename Value="ttconfig.inc"/>
<Type Value="Include"/>
</Item9>
<Item10>
<Filename Value="ttdebug.pas"/>
<UnitName Value="TTDebug"/>
</Item10>
<Item11>
<Filename Value="tterror.pas"/>
<UnitName Value="TTError"/>
</Item11>
<Item12>
<Filename Value="ttfile.pas"/>
<UnitName Value="TTFile"/>
</Item12>
<Item13>
<Filename Value="ttgload.pas"/>
<UnitName Value="TTGLoad"/>
</Item13>
<Item14>
<Filename Value="ttinterp.pas"/>
<UnitName Value="TTInterp"/>
</Item14>
<Item15>
<Filename Value="ttload.pas"/>
<UnitName Value="TTLoad"/>
</Item15>
<Item16>
<Filename Value="ttmemory.pas"/>
<UnitName Value="TTMemory"/>
</Item16>
<Item17>
<Filename Value="ttobjs.pas"/>
<UnitName Value="TTObjs"/>
</Item17>
<Item18>
<Filename Value="ttraster.pas"/>
<UnitName Value="TTRASTER"/>
</Item18>
<Item19>
<Filename Value="tttables.pas"/>
<UnitName Value="TTTables"/>
</Item19>
<Item20>
<Filename Value="tttypes.pas"/>
<UnitName Value="TTTypes"/>
</Item20>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="1">
<Item1>
<PackageName Value="FCL"/>
<MinVersion Major="1" Release="1" Valid="True"/>
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

22
components/freetypepascal/lazfreetype.pas Normal file
View File

@@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit lazfreetype;
interface
uses
FreeType, TTCache, TTCalc, TTCMap, TTDebug, TTError, TTFile, TTGLoad,
TTInterp, TTLoad, TTMemory, TTObjs, TTRASTER, TTTables, TTTypes,
LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('lazfreetype', @Register);
end.

51
components/freetypepascal/ttcalc.pas
View File

@@ -36,31 +36,30 @@ type
{$IFDEF BORLANDPASCAL} {$IFDEF BORLANDPASCAL}
Int16 = Integer; Int16 = Integer;
Word16 = Word; (* 16-bits unsigned *) Word16 = Word; (* 16-bits unsigned *)
{$ELSE} {$ENDIF}
{$IFDEF DELPHI16} {$IFDEF DELPHI16}
Int16 = Integer; Int16 = Integer;
Word16 = Word; (* 16-bits unsigned *) Word16 = Word; (* 16-bits unsigned *)
{$ELSE} {$ENDIF}
{$IFDEF DELPHI32} {$IFDEF DELPHI32}
Int16 = SmallInt; Int16 = SmallInt;
Word16 = Word; (* 16-bits unsigned *) Word16 = Word; (* 16-bits unsigned *)
{$ELSE} {$ENDIF}
{$IFDEF FPC}
Int16 = SmallInt; Int16 = SmallInt;
Word16 = SmallWord; (* 16-bits unsigned *) Word16 = Word; (* 16-bits unsigned *)
{$ENDIF}
{$ENDIF}
{$ENDIF} {$ENDIF}
Int32 = Integer; (* 32 bits integer *)
Int32 = LongInt; (* 32 bits integer *) Word32 = Cardinal; (* 32 bits 'unsigned'. Note that there's *)
Word32 = LongInt; (* 32 bits 'unsigned'. Note that there's *)
(* no unsigned long in Pascal.. *) (* no unsigned long in Pascal.. *)
(* As cardinals are only 31 bits !! *) (* As cardinals are only 31 bits !! *)
Int64 = record (* 64 "" *) // No need to define our own type, just use the build-in one
{ Int64 = record (* 64 "" *)
Lo, Lo,
Hi : LongInt; Hi : LongInt;
end; end;}
function MulDiv( A, B, C : Int32 ): Int32; function MulDiv( A, B, C : Int32 ): Int32;
@@ -86,6 +85,8 @@ function Sqrt64( L : Int64 ): LongInt;
implementation implementation
uses Math;
(* add support for Virtual Pascal inline assembly *) (* add support for Virtual Pascal inline assembly *)
{$IFDEF VIRTUALPASCAL} {$IFDEF VIRTUALPASCAL}
{$I TTCALC2.INC} {$I TTCALC2.INC}
@@ -107,7 +108,7 @@ implementation
{$ENDIF} {$ENDIF}
(* add support for Free Pascal inline assembly *) (* add support for Free Pascal inline assembly *)
{$IFDEF FPK} {$IFDEF FPC}
{$I TTCALC4.INC} {$I TTCALC4.INC}
{$ENDIF} {$ENDIF}
@@ -154,8 +155,9 @@ implementation
MulTo64( a, b, temp ); MulTo64( a, b, temp );
temp2.hi := 0; temp2 := c div 2;;
temp2.lo := c div 2; { temp2.hi := 0;
temp2.lo := c div 2;}
Add64( temp, temp2, temp ); Add64( temp, temp2, temp );
@@ -172,6 +174,9 @@ implementation
procedure Neg64( var x : Int64 ); procedure Neg64( var x : Int64 );
begin begin
x := -x;
end;
{ begin
(* Remember that -(0x80000000) == 0x80000000 with 2-complement! *) (* Remember that -(0x80000000) == 0x80000000 with 2-complement! *)
(* We take care of that here. *) (* We take care of that here. *)
@@ -189,16 +194,23 @@ implementation
end; end;
end; end;
end; end;
}
(**********************************************************) (**********************************************************)
(* MSB index ( return -1 for 0 ) *) (* MSB index ( return -1 for 0 ) *)
function Order64( var Z : Int64 ) : integer; function Order64( var Z : Int64 ) : integer;
var b : integer;
begin
b := 0;
while Z <> 0 do begin Z := Z shr 1; inc( b ); end;
Result := b-1;
end;
{original
begin begin
if Z.Hi <> 0 then Order64 := 32 + Order32( Z.Hi ) if Z.Hi <> 0 then Order64 := 32 + Order32( Z.Hi )
else Order64 := Order32( Z.Lo ); else Order64 := Order32( Z.Lo );
end; end;}
(**********************************************************) (**********************************************************)
@@ -258,7 +270,10 @@ end;
(* Integer Square Root *) (* Integer Square Root *)
function Sqrt64( L : Int64 ): LongInt; function Sqrt64( L : Int64 ): LongInt;
var begin
Result := Round(sqrt(L));
end;
{var
L2 : Int64; L2 : Int64;
R, S : LongInt; R, S : LongInt;
begin begin
@@ -284,6 +299,6 @@ begin
Sqrt64 := R; Sqrt64 := R;
end end
end end
end; end;}
end. end.

46
components/freetypepascal/ttcalc4.inc
View File

@@ -26,8 +26,11 @@
(**********************************************************) (**********************************************************)
(* 64 Bit Addition *) (* 64 Bit Addition *)
procedure Add64( var X, Y, Z : Int64 ); assembler; procedure Add64( var X, Y, Z : Int64 );// assembler;
asm begin
X := Y + Z;
end;
{asm
push %ebx push %ebx
push %edx push %edx
@@ -45,14 +48,17 @@ asm
pop %edx pop %edx
pop %ebx pop %ebx
end; end;}
(**********************************************************) (**********************************************************)
(* 64 Bit Substraction *) (* 64 Bit Substraction *)
procedure Sub64( var X, Y, Z : Int64 ); assembler; procedure Sub64( var X, Y, Z : Int64 );// assembler;
asm begin
X := Y - Z;
end;
{asm
push %ebx push %ebx
push %edx push %edx
@@ -70,14 +76,17 @@ asm
pop %edx pop %edx
pop %ebx pop %ebx
end; end;}
(**********************************************************) (**********************************************************)
(* Multiply two Int32 to an Int64 *) (* Multiply two Int32 to an Int64 *)
procedure MulTo64( X, Y : Int32; var Z : Int64 ); assembler; procedure MulTo64( X, Y : Int32; var Z : Int64 );// assembler;
asm begin
X := X * Y;
end;
{asm
push %ebx push %ebx
push %edx push %edx
@@ -90,14 +99,17 @@ asm
pop %edx pop %edx
pop %ebx pop %ebx
end; end;}
(**********************************************************) (**********************************************************)
(* Divide an Int64 by an Int32 *) (* Divide an Int64 by an Int32 *)
function Div64by32( var X : Int64; Y : Int32 ) : Int32; assembler; function Div64by32( var X : Int64; Y : Int32 ) : Int32;// assembler;
asm begin
Result := X div Y;
end;
{asm
push %ebx push %ebx
push %edx push %edx
@@ -108,12 +120,16 @@ asm
pop %edx pop %edx
pop %ebx pop %ebx
end; end;}
procedure DivMod64by32( var X : Int64; Y : Int32; var Q, R : Int32 ); procedure DivMod64by32( var X : Int64; Y : Int32; var Q, R : Int32 );
assembler; // assembler;
asm begin
Q := X div Y;
R := X mod Y;
end;
{asm
push %ebx push %ebx
push %edx push %edx
@@ -130,5 +146,5 @@ asm
pop %edx pop %edx
pop %ebx pop %ebx
end; end;}

7
components/freetypepascal/ttdebug.pas
View File

@@ -18,7 +18,9 @@ unit TTDebug;
interface interface
uses TTTypes, TTTables, TTObjs, TTInterp; {$mode Delphi}
uses SysUtils, TTTypes, TTTables, TTObjs, TTInterp;
type type
@@ -456,7 +458,8 @@ end;
function Hex32( L : Long ) : LongHexStr; function Hex32( L : Long ) : LongHexStr;
begin begin
Hex32 := Hex16( TStorageLong(L).W2 )+Hex16( TStorageLong(L).W1 ); Result := SysUtils.IntToHex(L, 8);
// Hex32 := Hex16( TStorageLong(L).W2 )+Hex16( TStorageLong(L).W1 );
end; end;
(******************************************************************* (*******************************************************************

35
components/freetypepascal/ttinterp.pas
View File

@@ -25,6 +25,8 @@ unit TTInterp;
interface interface
{$mode Delphi}
uses FreeType, uses FreeType,
TTTypes, TTTypes,
TTObjs; TTObjs;
@@ -364,8 +366,9 @@ const
Add64( T1, T2, T1 ); Add64( T1, T2, T1 );
if ( (T1.lo or T1.Hi) = 0 ) then Norm := 0 {$ToDo Fix me}
else Norm := Sqrt64( T1 ); // if ( (T1.lo or T1.Hi) = 0 ) then Norm := 0
// else Norm := Sqrt64( T1 );
end; end;
(******************************************************************* (*******************************************************************
@@ -925,7 +928,7 @@ const
begin begin
case Round_Mode of case Round_Mode of
{$IFDEF FPK} {$IFDEF FPC}
TT_Round_Off : exc.func_round := @Round_None; TT_Round_Off : exc.func_round := @Round_None;
TT_Round_To_Grid : exc.func_round := @Round_To_Grid; TT_Round_To_Grid : exc.func_round := @Round_To_Grid;
TT_Round_Up_To_Grid : exc.func_round := @Round_Up_To_Grid; TT_Round_Up_To_Grid : exc.func_round := @Round_Up_To_Grid;
@@ -1092,7 +1095,7 @@ const
if (freeVector.x = $4000) then if (freeVector.x = $4000) then
begin begin
{$IFDEF FPK} {$IFDEF FPC}
func_freeProj := @Project_x; func_freeProj := @Project_x;
{$ELSE} {$ELSE}
func_freeProj := Project_x; func_freeProj := Project_x;
@@ -1102,7 +1105,7 @@ const
else else
if (freeVector.y = $4000) then if (freeVector.y = $4000) then
begin begin
{$IFDEF FPK} {$IFDEF FPC}
func_freeProj := @Project_y; func_freeProj := @Project_y;
{$ELSE} {$ELSE}
func_freeProj := Project_y; func_freeProj := Project_y;
@@ -1111,7 +1114,7 @@ const
end end
else else
begin begin
{$IFDEF FPK} {$IFDEF FPC}
func_move := @Direct_Move; func_move := @Direct_Move;
func_freeProj := @Free_Project; func_freeProj := @Free_Project;
{$ELSE} {$ELSE}
@@ -1122,7 +1125,7 @@ const
Long(projVector.y) * freeVector.y * 4; Long(projVector.y) * freeVector.y * 4;
end; end;
{$IFDEF FPK} {$IFDEF FPC}
if (projVector.x = $4000) then func_Project := @Project_x if (projVector.x = $4000) then func_Project := @Project_x
else else
if (projVector.y = $4000) then func_Project := @Project_y if (projVector.y = $4000) then func_Project := @Project_y
@@ -2586,7 +2589,7 @@ end;
begin begin
exc.GS.round_state := TT_Round_To_Half_Grid; exc.GS.round_state := TT_Round_To_Half_Grid;
{$IFDEF FPK} {$IFDEF FPC}
exc.func_round := @Round_To_Half_Grid; exc.func_round := @Round_To_Half_Grid;
{$ELSE} {$ELSE}
exc.func_round := Round_To_Half_Grid; exc.func_round := Round_To_Half_Grid;
@@ -2601,7 +2604,7 @@ end;
begin begin
exc.GS.round_state := TT_Round_To_Grid; exc.GS.round_state := TT_Round_To_Grid;
{$IFDEF FPK} {$IFDEF FPC}
exc.func_round := @Round_To_Grid; exc.func_round := @Round_To_Grid;
{$ELSE} {$ELSE}
exc.func_round := Round_To_Grid; exc.func_round := Round_To_Grid;
@@ -2616,7 +2619,7 @@ end;
begin begin
exc.GS.round_state := TT_Round_To_Double_Grid; exc.GS.round_state := TT_Round_To_Double_Grid;
{$IFDEF FPK} {$IFDEF FPC}
exc.func_round := @Round_To_Double_Grid; exc.func_round := @Round_To_Double_Grid;
{$ELSE} {$ELSE}
exc.func_round := Round_To_Double_Grid; exc.func_round := Round_To_Double_Grid;
@@ -2631,7 +2634,7 @@ end;
begin begin
exc.GS.round_state := TT_Round_Up_To_Grid; exc.GS.round_state := TT_Round_Up_To_Grid;
{$IFDEF FPK} {$IFDEF FPC}
exc.func_round := @Round_Up_To_Grid; exc.func_round := @Round_Up_To_Grid;
{$ELSE} {$ELSE}
exc.func_round := Round_Up_To_Grid; exc.func_round := Round_Up_To_Grid;
@@ -2646,7 +2649,7 @@ end;
begin begin
exc.GS.round_state := TT_Round_Down_To_Grid; exc.GS.round_state := TT_Round_Down_To_Grid;
{$IFDEF FPK} {$IFDEF FPC}
exc.func_round := @Round_Down_To_Grid; exc.func_round := @Round_Down_To_Grid;
{$ELSE} {$ELSE}
exc.func_round := Round_Down_To_Grid; exc.func_round := Round_Down_To_Grid;
@@ -2661,7 +2664,7 @@ end;
begin begin
exc.GS.round_state := TT_Round_Off; exc.GS.round_state := TT_Round_Off;
{$IFDEF FPK} {$IFDEF FPC}
exc.func_round := @Round_None; exc.func_round := @Round_None;
{$ELSE} {$ELSE}
exc.func_round := Round_None; exc.func_round := Round_None;
@@ -2677,7 +2680,7 @@ end;
SetSuperRound( $4000, args^[0] ); SetSuperRound( $4000, args^[0] );
exc.GS.round_state := TT_Round_Super; exc.GS.round_state := TT_Round_Super;
{$IFDEF FPK} {$IFDEF FPC}
exc.func_round := @Round_Super; exc.func_round := @Round_Super;
{$ELSE} {$ELSE}
exc.func_round := Round_Super; exc.func_round := Round_Super;
@@ -2693,7 +2696,7 @@ end;
SetSuperRound( $2D41, args^[0] ); SetSuperRound( $2D41, args^[0] );
exc.GS.round_state := TT_Round_Super_45; exc.GS.round_state := TT_Round_Super_45;
{$IFDEF FPK} {$IFDEF FPC}
exc.func_round := @Round_Super_45; exc.func_round := @Round_Super_45;
{$ELSE} {$ELSE}
exc.func_round := Round_Super_45; exc.func_round := Round_Super_45;
@@ -4658,7 +4661,7 @@ const
exc.metrics.ratio := 0; exc.metrics.ratio := 0;
if exc.instance^.metrics.x_ppem <> exc.instance^.metrics.y_ppem then if exc.instance^.metrics.x_ppem <> exc.instance^.metrics.y_ppem then
{$IFDEF FPK} {$IFDEF FPC}
begin begin
exc.func_read_cvt := @Read_CVT_Stretched; exc.func_read_cvt := @Read_CVT_Stretched;
exc.func_write_cvt := @Write_CVT_Stretched; exc.func_write_cvt := @Write_CVT_Stretched;

14
components/freetypepascal/ttmemory.pas
View File

@@ -152,10 +152,10 @@ const
L : Longint; L : Longint;
P2 : Pointer; P2 : Pointer;
begin begin
{$IFNDEF DELPHI32} // {$IFNDEF DELPHI32}
OldHeapError := HeapError; // OldHeapError := HeapError;
HeapError := @MyHeapErr; // HeapError := @MyHeapErr;
{$ENDIF} // {$ENDIF}
L := ( size + Header_Size + 3 ) and -4; L := ( size + Header_Size + 3 ) and -4;
@@ -169,9 +169,9 @@ const
GetMem( Pointer(P), L ); GetMem( Pointer(P), L );
{$IFNDEF DELPHI32} // {$IFNDEF DELPHI32}
HeapError := OldHeapError; // HeapError := OldHeapError;
{$ENDIF} // {$ENDIF}
if Pointer(P) <> nil then if Pointer(P) <> nil then
begin begin

2
components/freetypepascal/ttobjs.pas
View File

@@ -79,6 +79,8 @@ unit TTObjs;
interface interface
{$mode Delphi}
{$I TTCONFIG.INC} {$I TTCONFIG.INC}
uses FreeType, uses FreeType,

8
components/freetypepascal/ttraster.pas
View File

@@ -3115,7 +3115,7 @@ begin
(* Vertical Sweep *) (* Vertical Sweep *)
{$IFDEF FPK} {$IFDEF FPC}
Proc_Sweep_Init := @Vertical_Sweep_Init; Proc_Sweep_Init := @Vertical_Sweep_Init;
Proc_Sweep_Span := @Vertical_Sweep_Span; Proc_Sweep_Span := @Vertical_Sweep_Span;
Proc_Sweep_Drop := @Vertical_Sweep_Drop; Proc_Sweep_Drop := @Vertical_Sweep_Drop;
@@ -3141,7 +3141,7 @@ begin
if Second_Pass then if Second_Pass then
begin begin
{$IFDEF FPK} {$IFDEF FPC}
Proc_Sweep_Init := @Horizontal_Sweep_Init; Proc_Sweep_Init := @Horizontal_Sweep_Init;
Proc_Sweep_Span := @Horizontal_Sweep_Span; Proc_Sweep_Span := @Horizontal_Sweep_Span;
Proc_Sweep_Drop := @Horizontal_Sweep_Drop; Proc_Sweep_Drop := @Horizontal_Sweep_Drop;
@@ -3214,7 +3214,7 @@ begin
BCible := PByte( Gray_Lines ); BCible := PByte( Gray_Lines );
GCible := PByte( Cible.Buffer ); GCible := PByte( Cible.Buffer );
{$IFDEF FPK} {$IFDEF FPC}
Proc_Sweep_Init := @Vertical_Gray_Sweep_Init; Proc_Sweep_Init := @Vertical_Gray_Sweep_Init;
Proc_Sweep_Span := @Vertical_Sweep_Span; Proc_Sweep_Span := @Vertical_Sweep_Span;
Proc_Sweep_Drop := @Vertical_Sweep_Drop; Proc_Sweep_Drop := @Vertical_Sweep_Drop;
@@ -3233,7 +3233,7 @@ begin
if Second_Pass then if Second_Pass then
begin begin
{$IFDEF FPK} {$IFDEF FPC}
Proc_Sweep_Init := @Horizontal_Sweep_Init; Proc_Sweep_Init := @Horizontal_Sweep_Init;
Proc_Sweep_Span := @Horizontal_Gray_Sweep_Span; Proc_Sweep_Span := @Horizontal_Gray_Sweep_Span;
Proc_Sweep_Drop := @Horizontal_Gray_Sweep_Drop; Proc_Sweep_Drop := @Horizontal_Gray_Sweep_Drop;