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

46
components/freetypepascal/ttcalc4.inc
View File

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

7
components/freetypepascal/ttdebug.pas
View File

@ -18,7 +18,9 @@ unit TTDebug;
interface
uses TTTypes, TTTables, TTObjs, TTInterp;
{$mode Delphi}
uses SysUtils, TTTypes, TTTables, TTObjs, TTInterp;
type
@ -456,7 +458,8 @@ end;
function Hex32( L : Long ) : LongHexStr;
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;
(*******************************************************************

35
components/freetypepascal/ttinterp.pas
View File

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

14
components/freetypepascal/ttmemory.pas
View File

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

2
components/freetypepascal/ttobjs.pas
View File

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

8
components/freetypepascal/ttraster.pas
View File

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