From 9e2f90802b6d86129fadb08c4bd41e6c90e958cb Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Tue, 12 Apr 2011 09:00:36 +0000 Subject: [PATCH] Fixes compilation of freetype git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1566 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/freetypepascal/lazfreetype.lpk | 110 ++++++++++++++++++++++ components/freetypepascal/lazfreetype.pas | 22 +++++ components/freetypepascal/ttcalc.pas | 51 ++++++---- components/freetypepascal/ttcalc4.inc | 46 ++++++--- components/freetypepascal/ttdebug.pas | 7 +- components/freetypepascal/ttinterp.pas | 35 +++---- components/freetypepascal/ttmemory.pas | 14 +-- components/freetypepascal/ttobjs.pas | 2 + components/freetypepascal/ttraster.pas | 8 +- 9 files changed, 233 insertions(+), 62 deletions(-) create mode 100644 components/freetypepascal/lazfreetype.lpk create mode 100644 components/freetypepascal/lazfreetype.pas diff --git a/components/freetypepascal/lazfreetype.lpk b/components/freetypepascal/lazfreetype.lpk new file mode 100644 index 000000000..ae57ce429 --- /dev/null +++ b/components/freetypepascal/lazfreetype.lpk @@ -0,0 +1,110 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/freetypepascal/lazfreetype.pas b/components/freetypepascal/lazfreetype.pas new file mode 100644 index 000000000..7839726c1 --- /dev/null +++ b/components/freetypepascal/lazfreetype.pas @@ -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. diff --git a/components/freetypepascal/ttcalc.pas b/components/freetypepascal/ttcalc.pas index 2d08741e3..66bc7f1ac 100644 --- a/components/freetypepascal/ttcalc.pas +++ b/components/freetypepascal/ttcalc.pas @@ -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. diff --git a/components/freetypepascal/ttcalc4.inc b/components/freetypepascal/ttcalc4.inc index 7bd08226f..a3f1b9572 100644 --- a/components/freetypepascal/ttcalc4.inc +++ b/components/freetypepascal/ttcalc4.inc @@ -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;} diff --git a/components/freetypepascal/ttdebug.pas b/components/freetypepascal/ttdebug.pas index 61e42c87c..1d86990a9 100644 --- a/components/freetypepascal/ttdebug.pas +++ b/components/freetypepascal/ttdebug.pas @@ -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; (******************************************************************* diff --git a/components/freetypepascal/ttinterp.pas b/components/freetypepascal/ttinterp.pas index 4d82e99c3..0878b6142 100644 --- a/components/freetypepascal/ttinterp.pas +++ b/components/freetypepascal/ttinterp.pas @@ -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; diff --git a/components/freetypepascal/ttmemory.pas b/components/freetypepascal/ttmemory.pas index e721f56f0..b0c0b4c51 100644 --- a/components/freetypepascal/ttmemory.pas +++ b/components/freetypepascal/ttmemory.pas @@ -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 diff --git a/components/freetypepascal/ttobjs.pas b/components/freetypepascal/ttobjs.pas index 4f3296796..753bad397 100644 --- a/components/freetypepascal/ttobjs.pas +++ b/components/freetypepascal/ttobjs.pas @@ -79,6 +79,8 @@ unit TTObjs; interface +{$mode Delphi} + {$I TTCONFIG.INC} uses FreeType, diff --git a/components/freetypepascal/ttraster.pas b/components/freetypepascal/ttraster.pas index 9f17ca265..0fd30fdfd 100644 --- a/components/freetypepascal/ttraster.pas +++ b/components/freetypepascal/ttraster.pas @@ -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;