mirror-github-bspeice/apophysis
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added several CalcFunctions for varJuliaN

Browse Source
This commit is contained in:
zueuk
2006-03-18 17:57:33 +00:00
parent 85bc00513e
commit a9aeab94ad
2 changed files with 201 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
2.10/Source/BaseVariation.pas
View File

@ -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.

194
2.10/Source/varJuliaN.pas
View File

@ -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;
///////////////////////////////////////////////////////////////////////////////