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

scripted test variant added

Browse Source
This commit is contained in:
ronaldhordijk
2005-08-18 18:40:36 +00:00
parent 4991d000d7
commit a21d59861c
1 changed files with 57 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
2.10/Source/XForm.pas
View File

@ -2,9 +2,13 @@ unit XForm;
interface interface
uses
atPascal;
const const
NRVISVAR = 23; NRVISVAR = 29;
NRVAR = 28; NRVAR = 29;
varnames: array[0..NRVAR - 1] of PChar = ( varnames: array[0..NRVAR - 1] of PChar = (
'linear', 'linear',
@ -34,6 +38,7 @@ const
'daisy', 'daisy',
'checkers', 'checkers',
'crot', 'crot',
'testscript',
'test' 'test'
); );
@ -96,7 +101,7 @@ type
procedure Daisy; // var[24] procedure Daisy; // var[24]
procedure Checkers; // var[25] procedure Checkers; // var[25]
procedure CRot; // var[26] procedure CRot; // var[26]
procedure TestScript; // var[27]
procedure TestVar; // var[NVARS - 1] procedure TestVar; // var[NVARS - 1]
function Mul33(const M1, M2: TMatrix): TMatrix; function Mul33(const M1, M2: TMatrix): TMatrix;
@ -113,9 +118,13 @@ type
varType: integer; varType: integer;
nx,ny,x,y: double;
script: TatPascalScripter;
Orientationtype: integer; Orientationtype: integer;
constructor Create; constructor Create;
destructor Destroy; override;
procedure Prepare; procedure Prepare;
procedure NextPoint(var px, py, pc: double); overload; procedure NextPoint(var px, py, pc: double); overload;
@ -158,6 +167,7 @@ begin
c[2, 0] := 0; c[2, 0] := 0;
c[2, 1] := 0; c[2, 1] := 0;
Symmetry := 0; Symmetry := 0;
end; end;
@ -308,6 +318,29 @@ begin
Inc(FNrFunctions); Inc(FNrFunctions);
end; end;
if (vars[27] <> 0.0) then begin
FFunctionList[FNrFunctions] := TestScript;
Inc(FNrFunctions);
Script := TatPascalScripter.Create(nil);
Script.SourceCode.Text :=
'function test(x, y; var nx, ny);' + #10#13 +
'begin' + #10#13 +
'nx := x;' + #10#13 +
'ny := y;' + #10#13 +
'end;' + #10#13 +
'function test2;' + #10#13 +
'begin' + #10#13 +
'nx := x;' + #10#13 +
'ny := y;' + #10#13 +
'end;' + #10#13;
Script.AddVariable('x',x);
Script.AddVariable('y',y);
Script.AddVariable('nx',nx);
Script.AddVariable('ny',ny);
Script.Compile;
end;
if (vars[NRVAR -1] <> 0.0) then begin if (vars[NRVAR -1] <> 0.0) then begin
FFunctionList[FNrFunctions] := TestVar; FFunctionList[FNrFunctions] := TestVar;
Inc(FNrFunctions); Inc(FNrFunctions);
@ -682,6 +715,19 @@ begin
FPy := FPy + vars[26] * r * sin(Angle); FPy := FPy + vars[26] * r * sin(Angle);
end; end;
///////////////////////////////////////////////////////////////////////////////
procedure TXForm.TestScript;
begin
// Script.ExecuteSubroutine('test', [FTX, FTY, nvx,nvy]);
x := FTX;
y := FTY;
Script.ExecuteSubroutine('test2');
FPx := FPx + vars[27] * nx;
FPy := FPy + vars[27] * ny;
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TXForm.TestVar; procedure TXForm.TestVar;
@ -1053,4 +1099,12 @@ end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
destructor TXForm.Destroy;
begin
if assigned(Script) then
Script.Free;
inherited;
end;
end. end.