From a9aeab94adb0e4541f07ef83b8230652672aaadd Mon Sep 17 00:00:00 2001 From: zueuk Date: Sat, 18 Mar 2006 17:57:33 +0000 Subject: [PATCH] added several CalcFunctions for varJuliaN --- 2.10/Source/BaseVariation.pas | 10 ++ 2.10/Source/varJuliaN.pas | 194 +++++++++++++++++++++++++++++++++- 2 files changed, 201 insertions(+), 3 deletions(-) diff --git a/2.10/Source/BaseVariation.pas b/2.10/Source/BaseVariation.pas index 0efc19a..211af5f 100644 --- a/2.10/Source/BaseVariation.pas +++ b/2.10/Source/BaseVariation.pas @@ -1,6 +1,10 @@ unit BaseVariation; interface + +type + TCalcFunction = procedure of object; + type TBaseVariation = class protected @@ -22,6 +26,7 @@ type procedure Prepare; virtual; procedure CalcFunction; virtual; abstract; + procedure GetCalcFunction(var Delphi_Suxx: TCalcFunction); virtual; end; TBaseVariationClass = class of TBaseVariation; @@ -61,4 +66,9 @@ begin end; /////////////////////////////////////////////////////////////////////////////// +procedure TBaseVariation.GetCalcFunction(var Delphi_Suxx: TCalcFunction); +begin + Delphi_Suxx := CalcFunction; +end; + end. diff --git a/2.10/Source/varJuliaN.pas b/2.10/Source/varJuliaN.pas index 1aca3a7..57d869f 100644 --- a/2.10/Source/varJuliaN.pas +++ b/2.10/Source/varJuliaN.pas @@ -7,7 +7,9 @@ uses const var_n_name='julian_power'; - var_c_name='julian_c'; + var_c_name='julian_dist'; + +{$define _ASM_} type TVariationJulian = class(TBaseVariation) @@ -17,6 +19,11 @@ type cn: double; + procedure CalcPower1; + procedure CalcPowerMinus1; + procedure CalcPower2; + procedure CalcPowerMinus2; + public constructor Create; @@ -31,6 +38,7 @@ type procedure Prepare; override; procedure CalcFunction; override; + procedure GetCalcFunction(var f: TCalcFunction); override; end; implementation @@ -52,8 +60,19 @@ begin cn := c / N / 2; end; +/////////////////////////////////////////////////////////////////////////////// +procedure TVariationJulian.GetCalcFunction(var f: TCalcFunction); +begin + if cn = 1/4 then f := CalcPower2 + else if cn = -1/4 then f := CalcPowerMinus2 + else if cn = 1/2 then f := CalcPower1 + else if cn = -1/2 then f := CalcPowerMinus1 + else f := CalcFunction; +end; + +/////////////////////////////////////////////////////////////////////////////// procedure TVariationJulian.CalcFunction; -{$if false} +{$ifndef _ASM_} var r: double; sina, cosa: extended; @@ -115,7 +134,176 @@ asm fadd qword ptr [edx] fstp qword ptr [edx] fwait -{$ifend} +{$endif} +end; + +procedure TVariationJulian.CalcPower2; +{$ifndef _ASM_} +var + r: double; + sina, cosa: extended; +begin + sincos((arctan2(FTy^, FTx^)/2 + pi*random(2)), sina, cosa); + r := vvar * sqrt(sqrt(sqr(FTx^) + sqr(FTy^))); + + FPx^ := FPx^ + r * cosa; + FPy^ := FPy^ + r * sina; +{$else} +asm + mov edx, [eax + FTy] + fld qword ptr [edx] + mov edx, [eax + FTx] + fld qword ptr [edx] + fld st(1) + fld st(1) + fpatan + fld1 + fadd st, st + fdivp st(1), st + mov ecx, eax + mov eax, 2 + call System.@RandInt + fldpi + push eax + fimul dword ptr [esp] + add esp, 4 + faddp + + fxch st(2) + fmul st, st + fxch st(1) + fmul st, st + faddp + fsqrt + fsqrt + fmul qword ptr [ecx + vvar] + fxch st(1) + + fsincos + + fmul st, st(2) + mov edx, [ecx + FPx] + fadd qword ptr [edx] + fstp qword ptr [edx] + fmulp + mov edx, [ecx + FPy] + fadd qword ptr [edx] + fstp qword ptr [edx] + fwait +{$endif} +end; + +procedure TVariationJulian.CalcPowerMinus2; +{$ifndef _ASM_} +var + r: double; + sina, cosa: extended; +begin + sincos((arctan2(FTy^, FTx^)/2 + pi*random(2)), sina, cosa); + r := vvar / sqrt(sqrt(sqr(FTx^) + sqr(FTy^))); + + FPx^ := FPx^ + r * cosa; + FPy^ := FPy^ - r * sina; +{$else} +asm + mov edx, [eax + FTy] + fld qword ptr [edx] + mov edx, [eax + FTx] + fld qword ptr [edx] + fld st(1) + fld st(1) + fpatan + fld1 + fadd st, st + fdivp st(1), st + mov ecx, eax + mov eax, 2 + call System.@RandInt + fldpi + push eax + fimul dword ptr [esp] + add esp, 4 + faddp + + fxch st(2) + fmul st, st + fxch st(1) + fmul st, st + faddp + fsqrt + fsqrt + fdivr qword ptr [ecx + vvar] + fxch st(1) + + fsincos + + fmul st, st(2) + mov edx, [ecx + FPx] + fadd qword ptr [edx] + fstp qword ptr [edx] + fmulp + mov edx, [ecx + FPy] + fsubr qword ptr [edx] + fstp qword ptr [edx] + fwait +{$endif} +end; + +procedure TVariationJulian.CalcPower1; +{$ifndef _ASM_} +begin + FPx^ := FPx^ + vvar * FTx^; + FPy^ := FPy^ + vvar * FTy^; +{$else} +asm + mov edx, [eax + FTy] + fld qword ptr [edx] + mov edx, [eax + FTx] + fld qword ptr [edx] + fld qword ptr [eax + vvar] + fmul st(2), st + fmulp + mov edx, [eax + FPx] + fadd qword ptr [edx] + fstp qword ptr [edx] + mov edx, [eax + FPy] + fadd qword ptr [edx] + fstp qword ptr [edx] + fwait +{$endif} +end; + +procedure TVariationJulian.CalcPowerMinus1; +{$ifndef _ASM_} +var + r: double; +begin + r := vvar / (sqr(FTx^) + sqr(FTy^)); + + FPx^ := FPx^ + r * FTx^; + FPy^ := FPy^ - r * FTy^; +{$else} +asm + mov edx, [eax + FTy] + fld qword ptr [edx] + mov edx, [eax + FTx] + fld qword ptr [edx] + fld st(1) + fmul st, st + fld st(1) + fmul st, st + faddp + fdivr qword ptr [eax + vvar] + fmul st(2), st + fmulp + mov edx, [eax + FPx] + fadd qword ptr [edx] + fstp qword ptr [edx] + mov edx, [eax + FPy] + fsubr qword ptr [edx] + fstp qword ptr [edx] + fwait +{$endif} end; ///////////////////////////////////////////////////////////////////////////////