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

added/fixed some things...

Browse Source
This commit is contained in:
zueuk 2006-03-18 18:12:59 +00:00
parent e0bf42adb0
commit da3a948247
14 changed files with 397 additions and 283 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
2.10/Source/Adjust.pas
View File

@ -1,5 +1,6 @@
{ {
Apophysis Copyright (C) 2001-2004 Mark Townsend Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Boris, Peter Sdobnov
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
@ -1903,7 +1904,8 @@ begin
pnlDragPos := 0; pnlDragPos := 0;
pnlDragOld := x; pnlDragOld := x;
pnlMM := false; pnlMM := false;
SetCaptureControl(TControl(Sender)); //SetCaptureControl(TControl(Sender));
Screen.Cursor := crHSplit; Screen.Cursor := crHSplit;
GetCursorPos(mousepos); // hmmm GetCursorPos(mousepos); // hmmm
pnlDragged := false; pnlDragged := false;
@ -1982,7 +1984,8 @@ begin
if pnlDragMode then if pnlDragMode then
begin begin
SetCaptureControl(nil); //SetCaptureControl(nil);
pnlDragMode := false; pnlDragMode := false;
Screen.Cursor := crDefault; Screen.Cursor := crDefault;

2
2.10/Source/BucketFillerThread.pas
View File

@ -93,8 +93,6 @@ end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
constructor TBucketFillerThread.Create(cp: TControlPoint); constructor TBucketFillerThread.Create(cp: TControlPoint);
var
i, n: integer;
begin begin
inherited Create(True); inherited Create(True);
Self.FreeOnTerminate := True; Self.FreeOnTerminate := True;

38
2.10/Source/ControlPoint.pas
View File

@ -1,6 +1,7 @@
{ {
Flame screensaver Copyright (C) 2002 Ronald Hordijk Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Boris, Peter Sdobnov
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
@ -88,9 +89,11 @@ type
TControlPoint = class TControlPoint = class
public public
xform: array[0..NXFORMS] of TXForm; xform: array[0..NXFORMS] of TXForm;
finalXform: ^TXForm;
finalXform: TXForm;
finalXformEnabled: boolean; finalXformEnabled: boolean;
useFinalXform: boolean; useFinalXform: boolean;
variation: TVariation; variation: TVariation;
cmap: TColorMap; cmap: TColorMap;
cmapindex: integer; cmapindex: integer;
@ -121,7 +124,7 @@ type
pulse: array[0..1, 0..1] of double; // [i][0]=magnitute [i][1]=frequency */ pulse: array[0..1, 0..1] of double; // [i][0]=magnitute [i][1]=frequency */
wiggle: array[0..1, 0..1] of double; // frequency is /minute, assuming 30 frames/s */ wiggle: array[0..1, 0..1] of double; // frequency is /minute, assuming 30 frames/s */
PropTable: array of ^TXForm;//Integer; PropTable: array of TXForm;//Integer;
FAngle: Double; FAngle: Double;
FTwoColorDimensions: Boolean; FTwoColorDimensions: Boolean;
private private
@ -258,7 +261,7 @@ destructor TControlPoint.Destroy;
var var
i: Integer; i: Integer;
begin begin
for i := 0 to NXFORMS - 1 do for i := 0 to NXFORMS do
xform[i].Free; xform[i].Free;
inherited; inherited;
@ -278,7 +281,7 @@ begin
n := NumXforms; n := NumXforms;
assert(n > 0); assert(n > 0);
finalXform := @xform[n]; finalXform := xform[n];
finalXform.Prepare; finalXform.Prepare;
useFinalXform := FinalXformEnabled and HasFinalXform; useFinalXform := FinalXformEnabled and HasFinalXform;
for i := 0 to n - 1 do begin for i := 0 to n - 1 do begin
@ -294,7 +297,7 @@ begin
inc(j); inc(j);
propsum := propsum + xform[j].density; propsum := propsum + xform[j].density;
until (propsum > LoopValue) or (j = n - 1); until (propsum > LoopValue) or (j = n - 1);
PropTable[i] := @xform[j]; PropTable[i] := xform[j];
LoopValue := LoopValue + TotValue / PROP_TABLE_SIZE; LoopValue := LoopValue + TotValue / PROP_TABLE_SIZE;
end; end;
@ -543,9 +546,6 @@ begin
px := 2 * random - 1; px := 2 * random - 1;
py := 2 * random - 1; py := 2 * random - 1;
// PreparePropTable;
// for i := 0 to NXFORMS do xform[i].prepare;
try try
for i := 0 to FUSE do for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPointXY(px,py); PropTable[Random(PROP_TABLE_SIZE)].NextPointXY(px,py);
@ -556,7 +556,7 @@ if UseFinalXform then
PropTable[Random(PROP_TABLE_SIZE)].NextPointXY(px,py); PropTable[Random(PROP_TABLE_SIZE)].NextPointXY(px,py);
pPoint^.X := px; pPoint^.X := px;
pPoint^.Y := py; pPoint^.Y := py;
finalXform^.NextPointXY(pPoint^.X, pPoint^.y); finalXform.NextPointXY(pPoint^.X, pPoint^.y);
Inc(pPoint); Inc(pPoint);
end end
else else
@ -599,9 +599,6 @@ asm
end; end;
{$ifend} {$ifend}
// PreparePropTable;
// for i := 0 to NXFORMS do xform[i].prepare;
try try
for i := 0 to FUSE do for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p); PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
@ -611,7 +608,7 @@ end;
if UseFinalXform then if UseFinalXform then
for i := 0 to NrPoints - 1 do begin for i := 0 to NrPoints - 1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p); PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
finalXform^.NextPointTo(p, pPoint^); finalXform.NextPointTo(p, pPoint^);
Inc(pPoint); Inc(pPoint);
end end
else else
@ -689,9 +686,6 @@ begin
p.c1 := random; p.c1 := random;
p.c2 := random; p.c2 := random;
// PreparePropTable;
// for i := 0 to NXFORMS do xform[i].prepare;
try try
for i := 0 to FUSE do for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint2C(p);//px, py, pc1, pc2); PropTable[Random(PROP_TABLE_SIZE)].NextPoint2C(p);//px, py, pc1, pc2);
@ -704,7 +698,7 @@ if UseFinalXform then
CurrentPoint.Y := p.y; CurrentPoint.Y := p.y;
CurrentPoint.C1 := p.c1; CurrentPoint.C1 := p.c1;
CurrentPoint.C2 := p.c2; CurrentPoint.C2 := p.c2;
finalXform^.NextPoint2C(CurrentPoint^); finalXform.NextPoint2C(CurrentPoint^);
Inc(CurrentPoint); Inc(CurrentPoint);
end end
else else
@ -1158,15 +1152,6 @@ begin
IterateXY(SUB_BATCH_SIZE, points); IterateXY(SUB_BATCH_SIZE, points);
{ if finalXformEnabled and HasFinalXform then begin
try
finalXform := @xform[NumXforms];
for i := 0 to SUB_BATCH_SIZE - 1 do
finalXform.NextPoint(points[i]);
except
end
end;}
LimitOutSidePoints := Round(0.05 * SUB_BATCH_SIZE); LimitOutSidePoints := Round(0.05 * SUB_BATCH_SIZE);
minx := 1E99; minx := 1E99;
@ -1730,7 +1715,6 @@ function TControlPoint.HasFinalXForm: boolean;
var var
i: integer; i: integer;
begin begin
// if finalXformEnabled then Result := true else
with xform[NumXForms] do with xform[NumXForms] do
begin begin
Result := (c[0,0]<>1) or (c[0,1]<>0) or(c[1,0]<>0) or (c[1,1]<>1) or (c[2,0]<>0) or (c[2,1]<>0) or Result := (c[0,0]<>1) or (c[0,1]<>0) or(c[1,0]<>0) or (c[1,1]<>1) or (c[2,0]<>0) or (c[2,1]<>0) or

1
2.10/Source/Main.dfm
View File

@ -2549,7 +2549,6 @@ object MainForm: TMainForm
ImageIndex = 45 ImageIndex = 45
ShortCut = 16456 ShortCut = 16456
Visible = False Visible = False
OnClick = mnuPostSheepClick
end end
object N21: TMenuItem object N21: TMenuItem
Caption = '-' Caption = '-'

169
2.10/Source/Main.pas
View File

@ -37,7 +37,7 @@ const
RS_XO = 2; RS_XO = 2;
RS_VO = 3; RS_VO = 3;
AppVersionString = 'Apophysis 2.03d pre-release 2'; AppVersionString = 'Apophysis 2.03d pre-release 3';
type type
TMouseMoveState = (msUsual, msZoomWindow, msZoomOutWindow, msZoomWindowMove, msZoomOutWindowMove, msDrag, msDragMove, msRotate, msRotateMove); TMouseMoveState = (msUsual, msZoomWindow, msZoomOutWindow, msZoomWindowMove, msZoomOutWindowMove, msDrag, msDragMove, msRotate, msRotateMove);
@ -246,15 +246,8 @@ type
procedure ApplicationEventsActivate(Sender: TObject); procedure ApplicationEventsActivate(Sender: TObject);
procedure mnuPasteClick(Sender: TObject); procedure mnuPasteClick(Sender: TObject);
procedure mnuCopyClick(Sender: TObject); procedure mnuCopyClick(Sender: TObject);
procedure mnuExportFLameClick(Sender: TObject); procedure mnuExportFlameClick(Sender: TObject);
procedure mnuPostSheepClick(Sender: TObject);
{
procedure HTTPRedirect(Sender: TObject; var dest: string;
var NumRedirect: Integer; var Handled: Boolean;
var VMethod: TIdHTTPMethod);
procedure HTTPStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
}
procedure ListXmlScannerStartTag(Sender: TObject; TagName: string; procedure ListXmlScannerStartTag(Sender: TObject; TagName: string;
Attributes: TAttrList); Attributes: TAttrList);
procedure XMLScannerStartTag(Sender: TObject; TagName: string; procedure XMLScannerStartTag(Sender: TObject; TagName: string;
@ -312,7 +305,6 @@ type
procedure ParseXML(var cp1: TControlPoint; const params: PCHAR); procedure ParseXML(var cp1: TControlPoint; const params: PCHAR);
function SaveFlame(cp1: TControlPoint; title, filename: string): boolean; function SaveFlame(cp1: TControlPoint; title, filename: string): boolean;
function SaveXMLFlame(const cp1: TControlPoint; title, filename: string): boolean; function SaveXMLFlame(const cp1: TControlPoint; title, filename: string): boolean;
//function TrianglesFromCP(const cp1: TControlPoint; var Triangles: TTriangles): integer;
procedure DisplayHint(Sender: TObject); procedure DisplayHint(Sender: TObject);
procedure OnProgress(prog: double); procedure OnProgress(prog: double);
procedure DrawFlame; procedure DrawFlame;
@ -358,8 +350,9 @@ var
MainForm: TMainForm; MainForm: TMainForm;
pname, ptime: string; pname, ptime: string;
nxform: integer; nxform: integer;
FinalXformLoaded: boolean; FinalXformLoaded: boolean; //
ParseCp: TControlPoint; // For parsing; ParseCp: TControlPoint; // For parsing;
ActiveXformSet: integer; //
MainCp: TControlPoint; MainCp: TControlPoint;
implementation implementation
@ -540,6 +533,7 @@ procedure TMainForm.StopThread;
begin begin
RedrawTimer.Enabled := False; RedrawTimer.Enabled := False;
if Assigned(Renderer) then begin if Assigned(Renderer) then begin
assert(Renderer.Suspended = false);
Renderer.Terminate; Renderer.Terminate;
Renderer.WaitFor; Renderer.WaitFor;
end; end;
@ -1303,7 +1297,7 @@ function FlameToXML(const cp1: TControlPoint; sheep: boolean; compact: boolean =
var var
t, i{, j}: integer; t, i{, j}: integer;
FileList: TStringList; FileList: TStringList;
x, y{, a, b, cc, d, e, f}: double; x, y: double;
{varlist,} nick, url, pal, hue: string; {varlist,} nick, url, pal, hue: string;
begin begin
FileList := TStringList.create; FileList := TStringList.create;
@ -1341,8 +1335,19 @@ begin
t := cp1.NumXForms; t := cp1.NumXForms;
for i := 0 to t - 1 do for i := 0 to t - 1 do
FileList.Add(cp1.xform[i].ToXMLString); FileList.Add(cp1.xform[i].ToXMLString);
// if cp1.HasFinalXForm then FileList.Add(cp1.finalxform.FinalToXMLString(cp1.finalXformEnabled)); if cp1.HasFinalXForm then
if cp1.HasFinalXForm then FileList.Add(cp1.xform[t].FinalToXMLString(cp1.finalXformEnabled)); begin
{$if false} // new file format - how about this?
FileList.Add(Format(' <xformset enabled="%d">', [IfThen(cp1.finalXformEnabled, 1, 0)]));
FileList.Add(' ' + cp1.xform[t].ToXMLString);
Filelist.Add(' </xformset>');
{$else}
FileList.Add(cp1.xform[i].FinalToXMLString(cp1.finalXformEnabled));
{$ifend}
end;
{ Write palette data } { Write palette data }
if not sheep then begin if not sheep then begin
if compact then // say no to duplicated data! (?) if compact then // say no to duplicated data! (?)
@ -1728,13 +1733,15 @@ procedure TMainForm.DrawFlame;
begin begin
RedrawTimer.Enabled := False; RedrawTimer.Enabled := False;
if Assigned(Renderer) then begin if Assigned(Renderer) then begin
assert(Renderer.Suspended = false);
Renderer.Terminate; Renderer.Terminate;
Renderer.WaitFor; Renderer.WaitFor;
Renderer.Free; Renderer.Free;
Renderer := nil; Renderer := nil;
end; end;
assert(Renderer = nil); //... assert(Renderer = nil); //...?
if not Assigned(Renderer) then if not Assigned(Renderer) then
begin begin
@ -1769,22 +1776,6 @@ end;
{ ---Z--- moved to ControlPoint ---Z--- } { ---Z--- moved to ControlPoint ---Z--- }
{ // unused function, hmmm...
procedure CP_compute(var cp1: TControlPoint; t1, t0: TTriangle; const i: integer);
begin
solve3(t0.x[0], t0.y[0], t1.x[0],
t0.x[1], t0.y[1], t1.x[1],
t0.x[2], t0.y[2], t1.x[2],
cp1.xform[i].c[0][0], cp1.xform[i].c[1][0], cp1.xform[i].c[2][0]);
solve3(t0.x[0], t0.y[0], t1.y[0],
t0.x[1], t0.y[1], t1.y[1],
t0.x[2], t0.y[2], t1.y[2],
cp1.xform[i].c[0][1], cp1.xform[i].c[1][1], cp1.xform[i].c[2][1]);
end;
}
function FlameToString(Title: string): string; function FlameToString(Title: string): string;
{ Creates a string containing the formated flame parameter set } { Creates a string containing the formated flame parameter set }
var var
@ -3529,7 +3520,8 @@ begin
StopThread; StopThread;
nxform := 0; nxform := 0;
FinalXformLoaded := false; FinalXformLoaded := false;
Parsecp.cmapindex := -2; // generate pallet from cmapindex and hue (apo 1 and earlier) activeXformSet:=0;
Parsecp.cmapindex := -2; // generate palette from cmapindex and hue (apo 1 and earlier)
ParseCp.symmetry := 0; ParseCp.symmetry := 0;
ParseCP.finalXformEnabled := false; ParseCP.finalXformEnabled := false;
XMLScanner.LoadFromBuffer(params); XMLScanner.LoadFromBuffer(params);
@ -3726,87 +3718,6 @@ begin
end; end;
end; end;
procedure TMainForm.mnuPostSheepClick(Sender: TObject);
{
var
URL: string;
StringList: TStringList;
ResponseStream: TMemoryStream;
MultiPartFormDataStream: TmsMultiPartFormDataStream;
}
begin
// if MainCp.HasNewVariants then begin
// showMessage('The posting of sheep with new variants (exponential, power, cosine and sawtooth) is disabled in this version.');
// Exit;
// end;
// if MainCp.FAngle <> 0 then begin
// showMessage('The posting of sheep with are rotated is disabled in this version.');
// Exit;
// end;
{
if SheepDialog.ShowModal = mrOK then
begin
DeleteFile('apophysis.log');
SetCurrentDir(ExtractFilePath(Application.exename));
StringList := TStringList.Create;
MultiPartFormDataStream := TmsMultiPartFormDataStream.Create;
ResponseStream := TMemoryStream.Create;
try
LogFile.Active := True;
StringList.Text := FlameToXMLSheep(SheepDialog.cp);
if FileExists('sheep.flame') then DeleteFile('sheep.flame');
StringList.SaveToFile('sheep.flame');
HTTP.Request.ContentType := MultiPartFormDataStream.RequestContentType;
MultiPartFormDataStream.AddFormField('type', 'upload');
MultiPartFormDataStream.AddFile('file', 'sheep.flame', 'text/xml');
MultiPartFormDataStream.AddFormField('nick', SheepDialog.txtNick.text);
MultiPartFormDataStream.AddFormField('url', SheepDialog.txtURL.text);
MultiPartFormDataStream.AddFormField('pw', SheepPW); //SheepPw
// You must make sure you call this method *before* sending the stream
MultiPartFormDataStream.PrepareStreamForDispatch;
MultiPartFormDataStream.Position := 0;
URL := URLEncode(SheepServer + 'cgi/apophysis.cgi');
try
HTTP.Post(URL, MultiPartFormDataStream, ResponseStream);
except
on E: Exception do
StatusBar.SimpleText := (E.Message);
end;
ResponseStream.SaveToFile('response.log');
StringList.LoadFromFile('response.log');
if Trim(StringList.Text) = 'bad password.' then
ShowMessage('Bad Password');
finally
MultiPartFormDataStream.Free;
ResponseStream.Free;
StringList.Free;
logFile.Active := False;
end;
end;
}
end;
{
procedure TMainForm.HTTPRedirect(Sender: TObject; var dest: string;
var NumRedirect: Integer; var Handled: Boolean;
var VMethod: TIdHTTPMethod);
var
URL: string;
begin
URL := SheepServer + 'cgi/' + dest;
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(URL),
nil, nil, SW_SHOWNORMAL);
Handled := True;
end;
procedure TMainForm.HTTPStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
StatusBar.SimpleText := AStatusTExt;
end;
}
procedure TMainForm.ListXmlScannerStartTag(Sender: TObject; procedure TMainForm.ListXmlScannerStartTag(Sender: TObject;
TagName: string; Attributes: TAttrList); TagName: string; Attributes: TAttrList);
begin begin
@ -3821,7 +3732,18 @@ var
v: string; v: string;
begin begin
Tokens := TStringList.Create; Tokens := TStringList.Create;
try try
if TagName='xformset' then
begin
v := Attributes.Value('enabled');
if v <> '' then ParseCP.finalXformEnabled := (StrToInt(v) <> 0)
else ParseCP.finalXformEnabled := false;
inc(activeXformSet);
end
else if TagName='flame' then
begin
v := Attributes.value('name'); v := Attributes.value('name');
if v <> '' then Parsecp.name := v else Parsecp.name := 'untitled'; if v <> '' then Parsecp.name := v else Parsecp.name := 'untitled';
v := Attributes.Value('time'); v := Attributes.Value('time');
@ -3893,10 +3815,10 @@ begin
v := Attributes.Value('url'); v := Attributes.Value('url');
if Trim(v) = '' then v := SheepUrl; if Trim(v) = '' then v := SheepUrl;
Parsecp.URL := v; Parsecp.URL := v;
finally
Tokens.free;
end; end;
finally
Tokens.free;
end;
end; end;
procedure ParseCompactcolors(cp: TControlPoint; count: integer; in_data: string); procedure ParseCompactcolors(cp: TControlPoint; count: integer; in_data: string);
@ -3948,7 +3870,7 @@ begin
if (TagName = 'finalxform') and (FinalXformLoaded) then ShowMessage('ERROR: No xforms allowed after FinalXform!') if (TagName = 'finalxform') and (FinalXformLoaded) then ShowMessage('ERROR: No xforms allowed after FinalXform!')
else else
begin begin
if (TagName = 'finalxform') then FinalXformLoaded := true; if (TagName = 'finalxform') or (activeXformSet > 0) then FinalXformLoaded := true;
with ParseCP.xform[nXform] do begin with ParseCP.xform[nXform] do begin
Clear; Clear;
@ -3960,13 +3882,16 @@ begin
if v <> '' then ParseCP.finalXformEnabled := (StrToInt(v) <> 0) if v <> '' then ParseCP.finalXformEnabled := (StrToInt(v) <> 0)
else ParseCP.finalXformEnabled := false; else ParseCP.finalXformEnabled := false;
end; end;
if activexformset > 0 then density := 0; // tmp...
v := Attributes.Value('color'); v := Attributes.Value('color');
if v <> '' then color := StrToFloat(v); if v <> '' then color := StrToFloat(v);
v := Attributes.Value('symmetry'); v := Attributes.Value('symmetry');
if v <> '' then symmetry := StrToFloat(v); if v <> '' then symmetry := StrToFloat(v);
v := Attributes.Value('coefs'); v := Attributes.Value('coefs');
GetTokens(v, tokens); GetTokens(v, tokens);
if Tokens.Count < 6 then ShowMessage('Not enough cooeficients...crash?'); if Tokens.Count < 6 then ShowMessage('Not enough coefficients...crash?');
c[0][0] := StrToFloat(Tokens[0]); c[0][0] := StrToFloat(Tokens[0]);
c[0][1] := StrToFloat(Tokens[1]); c[0][1] := StrToFloat(Tokens[1]);
c[1][0] := StrToFloat(Tokens[2]); c[1][0] := StrToFloat(Tokens[2]);
@ -3977,7 +3902,7 @@ begin
v := Attributes.Value('post'); v := Attributes.Value('post');
if v <> '' then begin if v <> '' then begin
GetTokens(v, tokens); GetTokens(v, tokens);
if Tokens.Count < 6 then ShowMessage('Not enough post-cooeficients...crash?'); if Tokens.Count < 6 then ShowMessage('Not enough post-coefficients...crash?');
p[0][0] := StrToFloat(Tokens[0]); p[0][0] := StrToFloat(Tokens[0]);
p[0][1] := StrToFloat(Tokens[1]); p[0][1] := StrToFloat(Tokens[1]);
p[1][0] := StrToFloat(Tokens[2]); p[1][0] := StrToFloat(Tokens[2]);

1
2.10/Source/Render.pas
View File

@ -1,6 +1,7 @@
{ {
Flame screensaver Copyright (C) 2002 Ronald Hordijk Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Boris, Peter Sdobnov
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by

404
2.10/Source/Render64.pas
View File

@ -1,6 +1,7 @@
{ {
Flame screensaver Copyright (C) 2002 Ronald Hordijk Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Boris, Peter Sdobnov
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
@ -21,7 +22,7 @@ unit Render64;
interface interface
uses uses
Windows, Graphics, ImageMaker, Windows, Forms, Graphics, ImageMaker,
Render, xform, Controlpoint; Render, xform, Controlpoint;
type type
@ -54,10 +55,19 @@ type
procedure CreateColorMap; procedure CreateColorMap;
procedure CreateCamera; procedure CreateCamera;
procedure AddPointsToBuckets(const points: TPointsArray);
procedure AddPointsToBucketsAngle(const points: TPointsArray);
procedure SetPixels; procedure SetPixels;
private
PropTable: array[0..SUB_BATCH_SIZE] of TXform;
finalXform: TXform;
UseFinalXform: boolean;
procedure Prepare;
procedure IterateBatch;
procedure IterateBatchAngle;
procedure IterateBatchFX;
procedure IterateBatchAngleFX;
public public
constructor Create; override; constructor Create; override;
destructor Destroy; override; destructor Destroy; override;
@ -71,6 +81,8 @@ type
implementation implementation
{$define _ASM_}
uses uses
Math, Sysutils; Math, Sysutils;
@ -200,8 +212,12 @@ begin
Bucketwidth := oversample * fcp.Width + 2 * max_gutter_width; Bucketwidth := oversample * fcp.Width + 2 * max_gutter_width;
BucketSize := BucketWidth * BucketHeight; BucketSize := BucketWidth * BucketHeight;
if high(buckets) <> (BucketSize - 1) then begin if high(buckets) <> (BucketSize - 1) then
try
SetLength(buckets, BucketSize); SetLength(buckets, BucketSize);
except
on EOutOfMemory do
Application.MessageBox('Error: not enough memory for this render!', 'Apophysis', 48)
end; end;
// share the buffer with imagemaker // share the buffer with imagemaker
@ -215,130 +231,64 @@ begin
CreateCamera; CreateCamera;
CreateColorMap; CreateColorMap;
fcp.Prepare; fcp.Prepare;
end; end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.AddPointsToBuckets(const points: TPointsArray);
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
begin
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
// if FStop then Exit;
px := points[i].x - camX0;
if (px < 0) or (px > camW) then continue;
py := points[i].y - camY0;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
MapColor := @ColorMap[Round(points[i].c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.AddPointsToBucketsAngle(const points: TPointsArray);
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
begin
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
// if FStop then Exit;
px := points[i].x * cosa + points[i].y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := points[i].y * cosa - points[i].x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
MapColor := @ColorMap[Round(points[i].c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.SetPixels; procedure TRenderer64.SetPixels;
var var
i: integer; i: integer;
nsamples: Int64; nsamples: Int64;
nrbatches: Integer; nrbatches: Integer;
points: TPointsArray; //points: TPointsArray;
AddPointsProc: procedure (const points: TPointsArray) of object; IterateBatchProc: procedure of object;
begin begin
// if FileExists('c:\temp\flame.txt') then Prepare;
// Deletefile('c:\temp\flame.txt'); Randomize;
// AssignFile(F, 'c:\temp\flame.txt'); if FCP.FAngle = 0 then begin
// Rewrite(F); if UseFinalXform then
if FCP.FAngle = 0 then IterateBatchProc := IterateBatchFX
AddPointsProc := AddPointsToBuckets else
else IterateBatchProc := IterateBatch;
AddPointsProc := AddPointsToBucketsAngle; end
else begin
SetLength(Points, SUB_BATCH_SIZE); if UseFinalXform then
IterateBatchProc := IterateBatchAngleFX
else
IterateBatchProc := IterateBatchAngle;
end;
nsamples := Round(sample_density * bucketSize / (oversample * oversample)); nsamples := Round(sample_density * bucketSize / (oversample * oversample));
nrbatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE)); nrbatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
Randomize;
for i := 0 to nrbatches do begin for i := 0 to nrbatches do begin
if FStop then if FStop then
Exit; Exit;
if ((i and $F) = 0) then if ((i and $1F) = 0) then
if nrbatches > 0 then if nrbatches > 0 then
Progress(i / nrbatches) Progress(i / nrbatches)
else else
Progress(0); Progress(0);
// generate points IterateBatchProc;
{$IFDEF TESTVARIANT}
// if i > 10 then
// break;
fcp.Testiterate(SUB_BATCH_SIZE, points);
{$ELSE}
{
case Compatibility of
0: fcp.iterate_Old(SUB_BATCH_SIZE, points);
1: fcp.iterateXYC(SUB_BATCH_SIZE, points);
end;
}
fcp.IterateXYC(SUB_BATCH_SIZE, points);
{$ENDIF}
// for j := SUB_BATCH_SIZE - 1 downto 0 do
// Writeln(f, FloatTostr(points[j].x) + #9 + FloatTostr(points[j].y) + #9 + FloatTostr(points[j].c));
AddPointsProc(points);
end; end;
// closefile(f);
Progress(1); Progress(1);
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.Render; procedure TRenderer64.Render;
begin begin
if fcp.NumXForms <= 0 then exit;
FStop := False; FStop := False;
FImageMaker.SetCP(FCP); FImageMaker.SetCP(FCP);
FImageMaker.Init; FImageMaker.Init;
InitValues; InitValues;
ClearBuffers; ClearBuffers;
@ -373,6 +323,272 @@ begin
FImageMaker.SaveImage(FileName); FImageMaker.SaveImage(FileName);
end; end;
/////////////////////////////////////////////////////////////////////////////// //******************************************************************************
procedure TRenderer64.Prepare;
var
i, n: Integer;
propsum: double;
LoopValue: double;
j: integer;
TotValue: double;
begin
totValue := 0;
n := fcp.NumXforms;
assert(n > 0);
finalXform := fcp.xform[n];
finalXform.Prepare;
useFinalXform := fcp.FinalXformEnabled and fcp.HasFinalXform;
for i := 0 to n - 1 do begin
fcp.xform[i].Prepare;
totValue := totValue + fcp.xform[i].density;
end;
LoopValue := 0;
for i := 0 to PROP_TABLE_SIZE-1 do begin
propsum := 0;
j := -1;
repeat
inc(j);
propsum := propsum + fcp.xform[j].density;
until (propsum > LoopValue) or (j = n - 1);
PropTable[i] := fcp.xform[j];
LoopValue := LoopValue + TotValue / PROP_TABLE_SIZE;
end;
end;
procedure TRenderer64.IterateBatch;
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
p: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
px := p.x - camX0;
if (px < 0) or (px > camW) then continue;
py := p.y - camY0;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
MapColor := @ColorMap[Round(p.c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer64.IterateBatchAngle;
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
p: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
px := p.x * cosa + p.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := p.y * cosa - p.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
MapColor := @ColorMap[Round(p.c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer64.IterateBatchFX;
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
p, q: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
finalXform.NextPointTo(p, q);
px := q.x - camX0;
if (px < 0) or (px > camW) then continue;
py := q.y - camY0;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
MapColor := @ColorMap[Round(q.c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer64.IterateBatchAngleFX;
var
i: integer;
px, py: double;
Bucket: PBucket;
MapColor: PColorMapColor;
p, q: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
finalXform.NextPointTo(p, q);
px := q.x * cosa + q.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := q.y * cosa - q.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
MapColor := @ColorMap[Round(q.c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
except
on EMathError do begin
exit;
end;
end;
end;
end. end.

1
2.10/Source/Render64MT.pas
View File

@ -1,6 +1,7 @@
{ {
Flame screensaver Copyright (C) 2002 Ronald Hordijk Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Boris, Peter Sdobnov
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by

1
2.10/Source/RenderMM.pas
View File

@ -1,6 +1,7 @@
{ {
Flame screensaver Copyright (C) 2002 Ronald Hordijk Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Boris, Peter Sdobnov
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by

1
2.10/Source/RenderMM_MT.pas
View File

@ -1,6 +1,7 @@
{ {
Flame screensaver Copyright (C) 2002 Ronald Hordijk Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Boris, Peter Sdobnov
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by

1
2.10/Source/RenderThread.pas
View File

@ -1,6 +1,7 @@
{ {
Flame screensaver Copyright (C) 2002 Ronald Hordijk Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Boris, Peter Sdobnov
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by

25
2.10/Source/RndFlame.pas
View File

@ -60,21 +60,6 @@ begin
end; end;
end; end;
///////////////////////////////////////////////////////////////////////////////
function NumXForms(const cp: TControlPoint): integer;
var
i: integer;
begin
Result := NXFORMS;
for i := 0 to NXFORMS - 1 do begin
if cp.xform[i].density = 0 then
begin
Result := i;
Break;
end;
end;
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure RandomVariation(cp: TControlPoint); procedure RandomVariation(cp: TControlPoint);
{ Randomise variation parameters } { Randomise variation parameters }
@ -90,7 +75,7 @@ begin
VarPossible := VarPossible or Variations[j]; VarPossible := VarPossible or Variations[j];
end; end;
for i := 0 to NumXForms(cp) - 1 do begin for i := 0 to cp.NumXForms - 1 do begin
for j := 0 to NRVAR - 1 do for j := 0 to NRVAR - 1 do
cp.xform[i].vars[j] := 0; cp.xform[i].vars[j] := 0;
@ -125,7 +110,7 @@ begin
if Variation = vRandom then begin if Variation = vRandom then begin
RandomVariation(cp); RandomVariation(cp);
end else end else
for i := 0 to NumXForms(cp) - 1 do begin for i := 0 to cp.NumXForms - 1 do begin
for j := 0 to NRVAR - 1 do for j := 0 to NRVAR - 1 do
cp.xform[i].vars[j] := 0; cp.xform[i].vars[j] := 0;
cp.xform[i].vars[integer(Variation)] := 1; cp.xform[i].vars[integer(Variation)] := 1;
@ -222,7 +207,7 @@ procedure EqualizeWeights(var cp: TControlPoint);
var var
t, i: integer; t, i: integer;
begin begin
t := NumXForms(cp); t := cp.NumXForms;
for i := 0 to t - 1 do for i := 0 to t - 1 do
cp.xform[i].density := 1.0 / t; cp.xform[i].density := 1.0 / t;
end; end;
@ -234,12 +219,12 @@ var
td: double; td: double;
begin begin
td := 0.0; td := 0.0;
for i := 0 to NumXForms(cp) - 1 do for i := 0 to cp.NumXForms - 1 do
td := td + cp.xform[i].Density; td := td + cp.xform[i].Density;
if (td < 0.001) then if (td < 0.001) then
EqualizeWeights(cp) EqualizeWeights(cp)
else else
for i := 0 to NumXForms(cp) - 1 do for i := 0 to cp.NumXForms - 1 do
cp.xform[i].Density := cp.xform[i].Density / td; cp.xform[i].Density := cp.xform[i].Density / td;
end; end;

27
2.10/Source/XForm.pas
View File

@ -3,10 +3,7 @@ unit XForm;
interface interface
uses uses
XFormMan, baseVariation; XFormMan, BaseVariation;
type
TCalcMethod = procedure of object;
type type
TCPpoint = record TCPpoint = record
@ -47,8 +44,8 @@ type
private private
FNrFunctions: Integer; FNrFunctions: Integer;
FFunctionList: array of TCalcMethod; FFunctionList: array of TCalcFunction;
FCalcFunctionList: array[0..64] of TCalcMethod; FCalcFunctionList: array[0..64] of TCalcFunction;
FTx, FTy: double; FTx, FTy: double;
FPx, FPy: double; FPx, FPy: double;
@ -140,7 +137,7 @@ uses
SysUtils, Math; SysUtils, Math;
const const
EPS: double = 1E-6; EPS: double = 1E-300;
procedure SinCos(const Theta: double; var Sin, Cos: double); // to avoid using 'extended' type procedure SinCos(const Theta: double; var Sin, Cos: double); // to avoid using 'extended' type
asm asm
@ -215,11 +212,13 @@ begin
FRegVariations[i].FTY := @FTY; FRegVariations[i].FTY := @FTY;
FRegVariations[i].vvar := vars[i + NRLOCVAR]; FRegVariations[i].vvar := vars[i + NRLOCVAR];
FRegVariations[i].prepare; FRegVariations[i].Prepare;
FRegVariations[i].GetCalcFunction(FFunctionList[NRLOCVAR + i]);
end; end;
CalculateAngle := (vars[5] <> 0.0) or (vars[6] <> 0.0) or (vars[7] <> 0.0) or (vars[8] <> 0.0) or CalculateAngle := (vars[5] <> 0.0) or (vars[6] <> 0.0) or (vars[7] <> 0.0) or
(vars[12] <> 0.0) or (vars[13] <> 0.0) or (vars[21] <> 0.0) or (vars[22] <> 0.0); (vars[8] <> 0.0) or (vars[12] <> 0.0) or (vars[13] <> 0.0) or
(vars[21] <> 0.0) or (vars[22] <> 0.0) or (vars[27] <> 0.0);
// CalculateLength := False; // CalculateLength := False;
CalculateSinCos := (vars[9] <> 0.0) or (vars[11] <> 0.0) or (vars[19] <> 0.0) or (vars[21] <> 0.0); CalculateSinCos := (vars[9] <> 0.0) or (vars[11] <> 0.0) or (vars[19] <> 0.0) or (vars[21] <> 0.0);
@ -447,7 +446,7 @@ procedure TXForm.Spherical;
var var
r: double; r: double;
begin begin
r := vars[2] / (sqr(FTx) + sqr(FTy) + 1E-6); r := vars[2] / (sqr(FTx) + sqr(FTy) + EPS);
FPx := FPx + FTx * r; FPx := FPx + FTx * r;
FPy := FPy + FTy * r; FPy := FPy + FTy * r;
{$else} {$else}
@ -1513,9 +1512,9 @@ var
r, sinr, cosr: double; r, sinr, cosr: double;
begin begin
SinCos(random * 2*pi, sinr, cosr); SinCos(random * 2*pi, sinr, cosr);
r := vars[27]*random; r := vars[27] * random;
FPx := FPx + FTx*r*cosr; FPx := FPx + FTx * r * cosr;
FPy := FPy + FTy*r*sinr; FPy := FPy + FTy * r * sinr;
{$else} {$else}
asm asm
mov edx, [ebx + vars] mov edx, [ebx + vars]

2
2.10/Source/formPostProcess.pas
View File

@ -378,7 +378,7 @@ begin
if pnlDragged then if pnlDragged then
begin begin
UpdateFlame; //UpdateFlame;
pnlDragged := False; pnlDragged := False;
end; end;
end; end;