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

version 2.05:

Browse Source 
64/48/32-bit depth support
many other changes
This commit is contained in:
zueuk 2006-08-22 13:35:52 +00:00
parent 426d98ac97
commit c3e610920f
35 changed files with 2273 additions and 3269 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
2.10/Source/Adjust.pas
View File

@ -22,8 +22,8 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, ControlPoint, Render, Buttons, Menus, cmap, StdCtrls, ExtCtrls, ComCtrls, Buttons, Menus, AppEvnts,
AppEvnts; ControlPoint, Cmap, Render;
const const
WM_UPDATE_PARAMS = WM_APP + 5439; WM_UPDATE_PARAMS = WM_APP + 5439;
@ -420,7 +420,7 @@ begin
// cp.Zoom := Zoom; // cp.Zoom := Zoom;
// cp.center[0] := Center[0]; // cp.center[0] := Center[0];
// cp.center[1] := Center[1]; // cp.center[1] := Center[1];
Render.Compatibility := compatibility; // Render.Compatibility := compatibility;
Render.SetCP(cp); Render.SetCP(cp);
Render.Render; Render.Render;
BM.Assign(Render.GetImage); BM.Assign(Render.GetImage);

18
2.10/Source/BaseVariation.pas
View File

@ -22,8 +22,8 @@ type
class function GetNrVariables: integer; virtual; class function GetNrVariables: integer; virtual;
class function GetVariableNameAt(const Index: integer): string; virtual; class function GetVariableNameAt(const Index: integer): string; virtual;
function SetVariable(const Name: string; var value: double): boolean; virtual; function GetVariable(const Name: string; var Value: double): boolean; virtual;
function GetVariable(const Name: string; var value: double): boolean; virtual; function SetVariable(const Name: string; var Value: double): boolean; virtual;
function ResetVariable(const Name: string): boolean; virtual; function ResetVariable(const Name: string): boolean; virtual;
procedure Prepare; virtual; procedure Prepare; virtual;
@ -36,6 +36,8 @@ type
implementation implementation
uses SysUtils;
{ TBaseVariation } { TBaseVariation }
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
@ -50,17 +52,11 @@ begin
Result := False; Result := False;
end; end;
///////////////////////////////////////////////////////////////////////////////
function TBaseVariation.SetVariable(const Name: string; var value: double): boolean; function TBaseVariation.SetVariable(const Name: string; var value: double): boolean;
begin begin
Result := False; Result := False;
end; end;
class function TBaseVariation.GetVariableNameAt(const Index: integer): string;
begin
Result := ''
end;
function TBaseVariation.ResetVariable(const Name: string): boolean; function TBaseVariation.ResetVariable(const Name: string): boolean;
var var
zero: double; zero: double;
@ -69,6 +65,12 @@ begin
Result := SetVariable(Name, zero); Result := SetVariable(Name, zero);
end; end;
///////////////////////////////////////////////////////////////////////////////
class function TBaseVariation.GetVariableNameAt(const Index: integer): string;
begin
Result := ''
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TBaseVariation.Prepare; procedure TBaseVariation.Prepare;
begin begin

5
2.10/Source/Browser.pas
View File

@ -21,8 +21,9 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, ControlPoint, ToolWin, ImgList, Render, StdCtrls, ExtCtrls, ComCtrls, ControlPoint, ToolWin, ImgList, StdCtrls,
Cmap, Menus, Global, Buttons; Cmap, Menus, Global, Buttons,
Render;
const const
PixelCountMax = 32768; PixelCountMax = 32768;

80
2.10/Source/BucketFillerThread.pas
View File

@ -4,93 +4,33 @@ interface
uses uses
Classes, Windows, Classes, Windows,
ControlPoint, Render, XForm; ControlPoint, Render, XForm, RenderTypes;
type type
TBucketFillerThread = class(TThread) TBucketFillerThread = class(TThread)
private private
fcp: TControlPoint; fcp: TControlPoint;
points: TPointsArray; points: TPointsArray;
public public
nrbatches: integer; nrbatches: integer;
batchcounter: Pinteger; batchcounter: Pinteger;
BucketWidth, BucketHeight: integer;
camX0, camY0, camW, camH,
bws, bhs, cosa, sina, rcX, rcY: double;
Buckets: PBucketArray;
ColorMap: TColorMapArray; ColorMap: TColorMapArray;
CriticalSection: TRTLCriticalSection; CriticalSection: TRTLCriticalSection;
AddPointsProc: procedure (const points: TPointsArray) of object;
constructor Create(cp: TControlPoint); constructor Create(cp: TControlPoint);
destructor Destroy; override; destructor Destroy; override;
procedure Execute; override; procedure Execute; override;
procedure AddPointsToBuckets(const points: TPointsArray);
procedure AddPointsToBucketsAngle(const points: TPointsArray);
end; end;
implementation implementation
{ PixelRenderThread }
///////////////////////////////////////////////////////////////////////////////
procedure TBucketFillerThread.AddPointsToBuckets(const points: TPointsArray);
var
i: integer;
px, py: double;
// R: double;
// V1, v2, v3: integer;
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 := @TBucketArray(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 TBucketFillerThread.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 := @TBucketArray(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;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
constructor TBucketFillerThread.Create(cp: TControlPoint); constructor TBucketFillerThread.Create(cp: TControlPoint);
begin begin
@ -116,18 +56,13 @@ end;
procedure TBucketFillerThread.Execute; procedure TBucketFillerThread.Execute;
var var
bc: integer; bc: integer;
AddPointsProc: procedure (const points: TPointsArray) of object;
begin begin
inherited; inherited;
if FCP.FAngle = 0 then
AddPointsProc := AddPointsToBuckets
else
AddPointsProc := AddPointsToBucketsAngle;
bc := 0; bc := 0;
while (not Terminated) and (bc < Nrbatches) do begin while (not Terminated) and (bc < Nrbatches) do begin
fcp.iterateXYC(SUB_BATCH_SIZE, points); fcp.iterateXYC(SUB_BATCH_SIZE, points);
try try
EnterCriticalSection(CriticalSection); EnterCriticalSection(CriticalSection);
@ -142,4 +77,7 @@ begin
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
{ -- RENDER THREAD MUST *NOT* KNOW ANYTHING ABOUT BUCKETS!!! -- }
end. end.

14
2.10/Source/ControlPoint.pas
View File

@ -87,12 +87,14 @@ type
T2CPointsArray = array of T2Cpoint; T2CPointsArray = array of T2Cpoint;
TControlPoint = class TControlPoint = class
public
xform: array[0..NXFORMS] of TXForm;
public
finalXform: TXForm; finalXform: TXForm;
finalXformEnabled: boolean; finalXformEnabled: boolean;
useFinalXform: boolean; useFinalXform: boolean;
Transparency: boolean;
xform: array[0..NXFORMS] of TXForm;
variation: TVariation; variation: TVariation;
cmap: TColorMap; cmap: TColorMap;
@ -116,6 +118,7 @@ type
(* in order to motion blur more accurately we compute the logs of the (* in order to motion blur more accurately we compute the logs of the
sample density many times and average the results. we interplate sample density many times and average the results. we interplate
only this many times. *) only this many times. *)
actual_density: extended; // for incomplete renders
nbatches: integer; // this much color resolution. but making it too high induces clipping nbatches: integer; // this much color resolution. but making it too high induces clipping
white_level: integer; white_level: integer;
cmap_inter: integer; // if this is true, then color map interpolates one entry cmap_inter: integer; // if this is true, then color map interpolates one entry
@ -131,6 +134,7 @@ type
PropTable: array of TXForm;//Integer; PropTable: array of TXForm;//Integer;
FAngle: Double; FAngle: Double;
FTwoColorDimensions: Boolean; FTwoColorDimensions: Boolean;
private private
function getppux: double; function getppux: double;
function getppuy: double; function getppuy: double;
@ -265,6 +269,7 @@ begin
FTwoColorDimensions := False; FTwoColorDimensions := False;
finalXformEnabled := false; finalXformEnabled := false;
Transparency := false;
end; end;
destructor TControlPoint.Destroy; destructor TControlPoint.Destroy;
@ -1114,7 +1119,7 @@ begin
cp.center[0] := 0; cp.center[0] := 0;
cp.center[1] := 0; cp.center[1] := 0;
cp.pixels_per_unit := 10; cp.pixels_per_unit := 10;
raise Exception.Create('CalcUPRMagn: ' +e.Message); raise Exception.Create('CalcUPRMagn: ' + e.Message);
end; end;
end; end;
end; end;
@ -1430,7 +1435,7 @@ begin
[Width, Height, center[0], center[1], pixels_per_unit])); [Width, Height, center[0], center[1], pixels_per_unit]));
sl.add(format('spatial_oversample %d spatial_filter_radius %f', sl.add(format('spatial_oversample %d spatial_filter_radius %f',
[spatial_oversample, spatial_filter_radius])); [spatial_oversample, spatial_filter_radius]));
sl.add(format('sample_density %f', [sample_density])); sl.add(format('sample_density %g', [sample_density]));
// sl.add(format('nbatches %d white_level %d background %f %f %f', - changed to integers - mt // sl.add(format('nbatches %d white_level %d background %f %f %f', - changed to integers - mt
sl.add(format('nbatches %d white_level %d background %d %d %d', sl.add(format('nbatches %d white_level %d background %d %d %d',
[nbatches, white_level, background[0], background[1], background[2]])); [nbatches, white_level, background[0], background[1], background[2]]));
@ -1477,6 +1482,7 @@ begin
Result.name := name; Result.name := name;
Result.nick := nick; Result.nick := nick;
Result.url := url; Result.url := url;
Result.Transparency := Transparency;
for i := 0 to NXFORMS - 1 do for i := 0 to NXFORMS - 1 do
Result.xform[i].assign(xform[i]); Result.xform[i].assign(xform[i]);

26
2.10/Source/Editor.dfm
View File

@ -1,6 +1,6 @@
object EditForm: TEditForm object EditForm: TEditForm
Left = 303 Left = 379
Top = 227 Top = 303
Width = 584 Width = 584
Height = 573 Height = 573
Caption = 'Transform Editor' Caption = 'Transform Editor'
@ -1156,10 +1156,8 @@ object EditForm: TEditForm
Height = 21 Height = 21
Hint = 'Reset vector X' Hint = 'Reset vector X'
Caption = 'X' Caption = 'X'
Enabled = False
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
Visible = False
OnClick = btnXpostClick OnClick = btnXpostClick
end end
object btnYpost: TSpeedButton object btnYpost: TSpeedButton
@ -1169,10 +1167,8 @@ object EditForm: TEditForm
Height = 21 Height = 21
Hint = 'Reset vector Y' Hint = 'Reset vector Y'
Caption = 'Y' Caption = 'Y'
Enabled = False
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
Visible = False
OnClick = btnYpostClick OnClick = btnYpostClick
end end
object btnOpost: TSpeedButton object btnOpost: TSpeedButton
@ -1182,10 +1178,8 @@ object EditForm: TEditForm
Height = 21 Height = 21
Hint = 'Reset vector O' Hint = 'Reset vector O'
Caption = 'O' Caption = 'O'
Enabled = False
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
Visible = False
OnClick = btnOpostClick OnClick = btnOpostClick
end end
object btnResetPostXForm: TSpeedButton object btnResetPostXForm: TSpeedButton
@ -1195,10 +1189,8 @@ object EditForm: TEditForm
Height = 22 Height = 22
Hint = 'Reset post-transform vectors to defaults' Hint = 'Reset post-transform vectors to defaults'
Caption = 'Reset post-transform' Caption = 'Reset post-transform'
Enabled = False
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
Visible = False
OnClick = btnResetPostXFormClick OnClick = btnResetPostXFormClick
end end
object btnSwapXforms: TSpeedButton object btnSwapXforms: TSpeedButton
@ -1208,7 +1200,6 @@ object EditForm: TEditForm
Height = 22 Height = 22
Hint = 'Swap Xform with PostXform' Hint = 'Swap Xform with PostXform'
Caption = '[ Xform <-> PostXform ]' Caption = '[ Xform <-> PostXform ]'
Enabled = False
Flat = True Flat = True
Font.Charset = ANSI_CHARSET Font.Charset = ANSI_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@ -1218,7 +1209,6 @@ object EditForm: TEditForm
ParentFont = False ParentFont = False
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
Visible = False
OnClick = btnSwapXformsClick OnClick = btnSwapXformsClick
end end
object pnlWeight: TPanel object pnlWeight: TPanel
@ -1331,10 +1321,8 @@ object EditForm: TEditForm
Top = 188 Top = 188
Width = 57 Width = 57
Height = 21 Height = 21
Enabled = False
TabOrder = 8 TabOrder = 8
Text = '0' Text = '0'
Visible = False
OnExit = PostCoefValidate OnExit = PostCoefValidate
OnKeyPress = PostCoefKeypress OnKeyPress = PostCoefKeypress
end end
@ -1343,10 +1331,8 @@ object EditForm: TEditForm
Top = 188 Top = 188
Width = 57 Width = 57
Height = 21 Height = 21
Enabled = False
TabOrder = 9 TabOrder = 9
Text = '0' Text = '0'
Visible = False
OnExit = PostCoefValidate OnExit = PostCoefValidate
OnKeyPress = PostCoefKeypress OnKeyPress = PostCoefKeypress
end end
@ -1355,10 +1341,8 @@ object EditForm: TEditForm
Top = 212 Top = 212
Width = 57 Width = 57
Height = 21 Height = 21
Enabled = False
TabOrder = 10 TabOrder = 10
Text = '0' Text = '0'
Visible = False
OnExit = PostCoefValidate OnExit = PostCoefValidate
OnKeyPress = PostCoefKeypress OnKeyPress = PostCoefKeypress
end end
@ -1367,10 +1351,8 @@ object EditForm: TEditForm
Top = 212 Top = 212
Width = 57 Width = 57
Height = 21 Height = 21
Enabled = False
TabOrder = 11 TabOrder = 11
Text = '0' Text = '0'
Visible = False
OnExit = PostCoefValidate OnExit = PostCoefValidate
OnKeyPress = PostCoefKeypress OnKeyPress = PostCoefKeypress
end end
@ -1379,10 +1361,8 @@ object EditForm: TEditForm
Top = 236 Top = 236
Width = 57 Width = 57
Height = 21 Height = 21
Enabled = False
TabOrder = 12 TabOrder = 12
Text = '0' Text = '0'
Visible = False
OnExit = PostCoefValidate OnExit = PostCoefValidate
OnKeyPress = PostCoefKeypress OnKeyPress = PostCoefKeypress
end end
@ -1391,10 +1371,8 @@ object EditForm: TEditForm
Top = 236 Top = 236
Width = 57 Width = 57
Height = 21 Height = 21
Enabled = False
TabOrder = 13 TabOrder = 13
Text = '0' Text = '0'
Visible = False
OnExit = PostCoefValidate OnExit = PostCoefValidate
OnKeyPress = PostCoefKeypress OnKeyPress = PostCoefKeypress
end end

78
2.10/Source/Editor.pas
View File

@ -24,8 +24,9 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, Math, Menus, ToolWin, Registry, ExtCtrls, StdCtrls, ComCtrls, Math, Menus, ToolWin, Registry,
ControlPoint, Render, cmap, Grids, ValEdit, Buttons, ImgList, CustomDrawControl, Grids, ValEdit, Buttons, ImgList, Types,
Types, XForm; ControlPoint, XForm, cmap, CustomDrawControl,
Render;
const const
crEditArrow = 20; crEditArrow = 20;
@ -273,6 +274,9 @@ type
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
procedure VEVarsDblClick(Sender: TObject); procedure VEVarsDblClick(Sender: TObject);
// procedure vleVariablesGetPickList(Sender: TObject; const KeyName: String; Values: TStrings);
// procedure vleVariablesStringsChange(Sender: TObject);
procedure cbTransformsDrawItem(Control: TWinControl; Index: Integer; procedure cbTransformsDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState); Rect: TRect; State: TOwnerDrawState);
@ -613,13 +617,7 @@ var
begin begin
// currently EditForm does not really know if we select another // currently EditForm does not really know if we select another
// flame in the Main Window - which is not good... // flame in the Main Window - which is not good...
{
if NumXForms(cp) <> NumXForms(MainCp) then
begin
SelectedTriangle := 0;
mouseOverTriangle := -1;
end;
}
cp.copy(MainCp); cp.copy(MainCp);
if SelectedTriangle > LastTriangle{???} then if SelectedTriangle > LastTriangle{???} then
@ -675,7 +673,7 @@ begin
cp.center[1] := MainCp.Center[1]; cp.center[1] := MainCp.Center[1];
end; end;
cp.cmap := MainCp.cmap; cp.cmap := MainCp.cmap;
Render.Compatibility := compatibility; // Render.Compatibility := compatibility;
Render.SetCP(cp); Render.SetCP(cp);
Render.Render; Render.Render;
PreviewImage.Picture.Bitmap.Assign(Render.GetImage); PreviewImage.Picture.Bitmap.Assign(Render.GetImage);
@ -765,6 +763,7 @@ begin
for i:= 0 to GetNrVariableNames - 1 do begin for i:= 0 to GetNrVariableNames - 1 do begin
GetVariable(GetVariableNameAt(i), v); GetVariable(GetVariableNameAt(i), v);
strval := Format('%.6g', [v]); strval := Format('%.6g', [v]);
//strval := GetVariableStr(GetVariableNameAt(i));
// kinda funny, but it really helped... // kinda funny, but it really helped...
if vleVariables.Values[GetVariableNameAt(i)] <> strval then if vleVariables.Values[GetVariableNameAt(i)] <> strval then
vleVariables.Values[GetVariableNameAt(i)] := strval; vleVariables.Values[GetVariableNameAt(i)] := strval;
@ -1505,6 +1504,16 @@ begin
vleVariables.InsertRow(GetVariableNameAt(i), '0', True); vleVariables.InsertRow(GetVariableNameAt(i), '0', True);
end; end;
{
with vleVariables.ItemProps['blur2_type'] do begin // temporary hack?
ReadOnly := true;
PickList.Add('gaussian');
PickList.Add('zoom');
PickList.Add('radial');
PickList.Add('defocus');
end;
}
GraphZoom := 1; GraphZoom := 1;
case EditPrevQual of case EditPrevQual of
@ -1546,6 +1555,14 @@ begin
VarsCache[i] := MinDouble; VarsCache[i] := MinDouble;
end; end;
procedure TEditForm.FormDestroy(Sender: TObject);
begin
cp.free;
Render.free;
// vleVariables.ItemProps['blur2_type'].Destroy; // :-/
end;
procedure TEditForm.TriangleViewMouseMove(Sender: TObject; Shift: TShiftState; procedure TEditForm.TriangleViewMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: integer); X, Y: integer);
var var
@ -2553,12 +2570,6 @@ begin
MainForm.Redo; MainForm.Redo;
end; end;
procedure TEditForm.FormDestroy(Sender: TObject);
begin
cp.free;
Render.free;
end;
procedure TEditForm.mnuLowQualityClick(Sender: TObject); procedure TEditForm.mnuLowQualityClick(Sender: TObject);
begin begin
mnuLowQuality.Checked := True; mnuLowQuality.Checked := True;
@ -3032,6 +3043,8 @@ begin
TValueListEditor(Sender).Row := cell.Y; TValueListEditor(Sender).Row := cell.Y;
// if ((Sender = vleVariables) and vleVariables.ItemProps[varDragIndex].ReadOnly) then exit;
Screen.Cursor := crHSplit; Screen.Cursor := crHSplit;
GetCursorPos(mousepos); // hmmm GetCursorPos(mousepos); // hmmm
@ -3089,7 +3102,8 @@ begin
end end
else begin else begin
cp.xform[SelectedTriangle].SetVariable(vleVariables.Keys[varDragIndex+1], v); cp.xform[SelectedTriangle].SetVariable(vleVariables.Keys[varDragIndex+1], v);
vleVariables.Values[vleVariables.Keys[varDragIndex+1]] := FloatToStr(v); //Format('%.6g', [v]); vleVariables.Values[vleVariables.Keys[varDragIndex+1]] := FloatToStr(v);
// cp.xform[SelectedTriangle].GetVariableStr(vleVariables.Keys[varDragIndex+1]);
end; end;
HasChanged := True; HasChanged := True;
@ -3623,9 +3637,15 @@ procedure TEditForm.ValidateVariable;
var var
i: integer; i: integer;
NewVal, OldVal: double; NewVal, OldVal: double;
str, oldstr: string;
begin begin
i := vleVariables.Row; i := vleVariables.Row;
{ oldstr := cp.xform[SelectedTriangle].GetVariableStr(vleVariables.Keys[i]);
str := vleVariables.Values[vleVariables.Keys[i]];
cp.xform[SelectedTriangle].SetVariableStr(vleVariables.Keys[i], str);
}
cp.xform[SelectedTriangle].GetVariable(vleVariables.Keys[i], OldVal); cp.xform[SelectedTriangle].GetVariable(vleVariables.Keys[i], OldVal);
{ Test that it's a valid floating point number } { Test that it's a valid floating point number }
try try
@ -3633,14 +3653,17 @@ begin
except except
{ It's not, so we restore the old value } { It's not, so we restore the old value }
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [OldVal]); vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [OldVal]);
// cp.xform[SelectedTriangle].GetVariableStr(vleVariables.Keys[i]);
exit; exit;
end; end;
{ If it's not the same as the old value and it was valid } { If it's not the same as the old value and it was valid }
if (NewVal <> OldVal) then if (NewVal <> OldVal) then
// if str <> oldstr then
begin begin
MainForm.UpdateUndo; MainForm.UpdateUndo;
cp.xform[SelectedTriangle].SetVariable(vleVariables.Keys[i], NewVal); cp.xform[SelectedTriangle].SetVariable(vleVariables.Keys[i], NewVal);
vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [NewVal]); vleVariables.Values[vleVariables.Keys[i]] := Format('%.6g', [NewVal]);
//vleVariables.Values[vleVariables.Keys[i]] := str; //Format('%.6g', [NewVal]);
ShowSelectedInfo; ShowSelectedInfo;
UpdateFlame(True); UpdateFlame(True);
end; end;
@ -3664,6 +3687,27 @@ begin
ValidateVariable; ValidateVariable;
end; end;
(*
procedure TEditForm.vleVariablesGetPickList(Sender: TObject;
const KeyName: String; Values: TStrings);
begin
if KeyName ='blur2_type' then
begin
Values.Add('gaussian');
Values.Add('zoom');
Values.Add('radial');
Values.Add('defocus');
end;
end;
procedure TEditForm.vleVariablesStringsChange(Sender: TObject);
begin
if (vleVariables.ItemProps[vleVariables.Row - 1].ReadOnly) then ValidateVariable;
end;
*)
// -----------------------------------------------------------------------------
procedure TEditForm.txtValidateValue(Sender: TObject); procedure TEditForm.txtValidateValue(Sender: TObject);
var var
t: double; t: double;

829
2.10/Source/FormRender.dfm
View File

@ -1,11 +1,11 @@
object RenderForm: TRenderForm object RenderForm: TRenderForm
Left = 287 Left = 431
Top = 252 Top = 336
BorderIcons = [biSystemMenu, biMinimize] BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'RenderForm' Caption = 'RenderForm'
ClientHeight = 414 ClientHeight = 449
ClientWidth = 422 ClientWidth = 434
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@ -51,395 +51,54 @@ object RenderForm: TRenderForm
TextHeight = 13 TextHeight = 13
object ProgressBar: TProgressBar object ProgressBar: TProgressBar
Left = 0 Left = 0
Top = 382 Top = 417
Width = 422 Width = 434
Height = 13 Height = 13
Align = alBottom Align = alBottom
TabOrder = 0 TabOrder = 0
end end
object btnRender: TButton object btnRender: TButton
Left = 256 Left = 264
Top = 356 Top = 388
Width = 75 Width = 75
Height = 23 Height = 23
Caption = 'Render' Caption = 'Render'
Default = True Default = True
TabOrder = 5 TabOrder = 1
OnClick = btnRenderClick OnClick = btnRenderClick
end end
object btnCancel: TButton object btnCancel: TButton
Left = 344 Left = 352
Top = 354 Top = 386
Width = 75 Width = 75
Height = 25 Height = 25
Caption = 'Close' Caption = 'Close'
TabOrder = 6 TabOrder = 2
OnClick = btnCancelClick OnClick = btnCancelClick
end end
object GroupBox1: TGroupBox
Left = 8
Top = 69
Width = 408
Height = 57
Caption = 'Destination'
TabOrder = 1
object btnBrowse: TSpeedButton
Left = 368
Top = 16
Width = 24
Height = 24
Hint = 'Browse...'
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FF00000000000000000000000000000000000000000000
0000000000000000000000FF00FFFF00FFFF00FFFF00FFFF00FF000000000000
9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF000000FF00
FFFF00FFFF00FFFF00FF0000009FFFFF0000009FCFFF9FCFFF9FCFFF9FCFFF9F
CFFF9FCFFF9FCFFF9FCFFF9FCFFF000000FF00FFFF00FFFF00FF0000009FFFFF
9FFFFF0000009FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCF
FF000000FF00FFFF00FF0000009FFFFF9FFFFF9FFFFF0000009FCFFF9FCFFF9F
CFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF000000FF00FF0000009FFFFF
9FFFFF9FFFFF9FFFFF0000000000000000000000000000000000000000000000
00000000000000FF00FF0000009FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9F
FFFF9FFFFF9FFFFF000000FF00FFFF00FFFF00FFFF00FFFF00FF0000009FFFFF
9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF000000FF00FFFF00
FFFF00FFFF00FFFF00FF0000009FFFFF9FFFFF9FFFFF00000000000000000000
0000000000000000000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF000000
000000000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF0000
00000000000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FF000000000000FF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF0C0C0CFF00FFFF00FFFF00FF0000
00FF00FF000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FF0B0B0B020202000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnBrowseClick
end
object Label10: TLabel
Left = 10
Top = 23
Width = 48
Height = 13
Caption = 'File name:'
end
object txtFilename: TEdit
Left = 72
Top = 20
Width = 281
Height = 21
TabOrder = 0
OnChange = txtFilenameChange
end
end
object GroupBox2: TGroupBox
Left = 8
Top = 130
Width = 200
Height = 105
Caption = 'Size'
TabOrder = 2
object Label1: TLabel
Left = 10
Top = 23
Width = 28
Height = 13
Caption = 'Width'
end
object Label2: TLabel
Left = 10
Top = 47
Width = 34
Height = 13
Caption = 'Height:'
end
object chkMaintain: TCheckBox
Left = 8
Top = 76
Width = 161
Height = 17
Caption = 'Maintain aspect ratio'
Checked = True
State = cbChecked
TabOrder = 0
OnClick = chkMaintainClick
end
object cbWidth: TComboBox
Left = 112
Top = 20
Width = 73
Height = 21
BiDiMode = bdRightToLeftNoAlign
Enabled = False
ItemHeight = 13
ParentBiDiMode = False
TabOrder = 1
OnChange = txtWidthChange
Items.Strings = (
'320'
'640'
'800'
'1024'
'1280'
'1600'
'1920'
'2048'
'2560'
'3200')
end
object cbHeight: TComboBox
Left = 112
Top = 44
Width = 73
Height = 21
BiDiMode = bdRightToLeftNoAlign
Enabled = False
ItemHeight = 13
ParentBiDiMode = False
TabOrder = 2
OnChange = txtHeightChange
Items.Strings = (
'200'
'240'
'480'
'600'
'768'
'1024'
'1200'
'1920'
'2048'
'2400')
end
end
object GroupBox3: TGroupBox
Left = 216
Top = 130
Width = 200
Height = 105
Caption = 'Rendering'
TabOrder = 3
object Label3: TLabel
Left = 10
Top = 71
Width = 59
Height = 13
Caption = 'Oversample:'
end
object Label5: TLabel
Left = 10
Top = 47
Width = 61
Height = 13
Caption = 'Filter Radius:'
end
object Label4: TLabel
Left = 10
Top = 23
Width = 35
Height = 13
Caption = 'Quality:'
end
object txtOversample: TEdit
Left = 112
Top = 68
Width = 57
Height = 21
BiDiMode = bdRightToLeft
Enabled = False
ParentBiDiMode = False
ReadOnly = True
TabOrder = 1
Text = '2'
OnChange = txtOversampleChange
end
object txtFilterRadius: TEdit
Left = 112
Top = 44
Width = 57
Height = 21
BiDiMode = bdRightToLeft
ParentBiDiMode = False
TabOrder = 0
OnChange = txtFilterRadiusChange
end
object udOversample: TUpDown
Left = 169
Top = 68
Width = 12
Height = 21
Associate = txtOversample
Min = 1
Max = 4
Position = 2
TabOrder = 2
end
object txtDensity: TComboBox
Left = 112
Top = 20
Width = 57
Height = 21
AutoComplete = False
ItemHeight = 13
TabOrder = 3
OnChange = txtDensityChange
OnCloseUp = txtDensityChange
Items.Strings = (
'200'
'500'
'1000'
'2000'
'4000')
end
end
object GroupBox4: TGroupBox
Left = 8
Top = 238
Width = 409
Height = 81
Caption = 'Memory usage'
TabOrder = 4
object lblApproxMem: TLabel
Left = 202
Top = 46
Width = 119
Height = 13
Caption = 'Approx. memory required:'
end
object lblPhysical: TLabel
Left = 202
Top = 20
Width = 126
Height = 13
Caption = 'Available physical memory:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label9: TLabel
Left = 8
Top = 46
Width = 86
Height = 13
Caption = 'Maximum memory:'
end
object cbMaxMemory: TComboBox
Left = 112
Top = 44
Width = 57
Height = 21
BiDiMode = bdRightToLeftNoAlign
Enabled = False
ItemHeight = 13
ParentBiDiMode = False
TabOrder = 1
Items.Strings = (
'32'
'64'
'128'
'256'
'512'
'1024'
'1536')
end
object chkLimitMem: TCheckBox
Left = 8
Top = 20
Width = 145
Height = 17
Caption = 'Limit memory usage'
TabOrder = 0
OnClick = chkLimitMemClick
end
end
object btnPause: TButton object btnPause: TButton
Left = 168 Left = 176
Top = 354 Top = 386
Width = 75 Width = 75
Height = 25 Height = 25
Caption = 'Pause' Caption = 'Pause'
TabOrder = 7 TabOrder = 3
OnClick = btnPauseClick OnClick = btnPauseClick
end end
object chkSave: TCheckBox object chkSave: TCheckBox
Left = 8 Left = 8
Top = 322 Top = 358
Width = 113 Width = 113
Height = 17 Height = 17
Caption = 'Save parameters' Caption = 'Save parameters'
Checked = True Checked = True
State = cbChecked State = cbChecked
TabOrder = 8 TabOrder = 4
end
object GroupBox5: TGroupBox
Left = 8
Top = 8
Width = 408
Height = 57
Caption = 'Preset'
TabOrder = 11
object btnSavePreset: TSpeedButton
Left = 344
Top = 18
Width = 24
Height = 24
Hint = 'Save Preset'
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnSavePresetClick
end
object btnDeletePreset: TSpeedButton
Left = 368
Top = 18
Width = 24
Height = 24
Hint = 'Delete Preset'
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnDeletePresetClick
end
object cmbPreset: TComboBox
Left = 10
Top = 20
Width = 327
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 0
OnChange = cmbPresetChange
end
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Top = 395 Top = 430
Width = 422 Width = 434
Height = 19 Height = 19
Panels = < Panels = <
item item
@ -454,33 +113,455 @@ object RenderForm: TRenderForm
end end
object chkShutdown: TCheckBox object chkShutdown: TCheckBox
Left = 8 Left = 8
Top = 360 Top = 396
Width = 137 Width = 137
Height = 17 Height = 17
Caption = 'Shutdown on complete' Caption = 'Shutdown on complete'
TabOrder = 10 TabOrder = 6
end end
object cbPostProcess: TCheckBox object cbPostProcess: TCheckBox
Left = 8 Left = 8
Top = 340 Top = 377
Width = 97 Width = 121
Height = 17 Height = 17
Caption = 'Post render' Caption = 'Postprocess render'
TabOrder = 9 TabOrder = 5
end end
object chkSaveIncompleteRenders: TCheckBox object chkSaveIncompleteRenders: TCheckBox
Left = 272 Left = 288
Top = 328 Top = 358
Width = 145 Width = 137
Height = 17 Height = 17
Alignment = taLeftJustify Alignment = taLeftJustify
Caption = 'Save incomplete renders' Caption = 'Save incomplete render'
TabOrder = 13 TabOrder = 8
Visible = False
OnClick = chkSaveIncompleteRendersClick OnClick = chkSaveIncompleteRendersClick
end end
object PageCtrl: TPageControl
Left = 0
Top = 0
Width = 433
Height = 353
ActivePage = TabSettings
TabOrder = 9
object TabSettings: TTabSheet
Caption = 'Settings'
object GroupBox5: TGroupBox
Left = 8
Top = 8
Width = 408
Height = 57
Caption = 'Preset'
TabOrder = 0
object btnSavePreset: TSpeedButton
Left = 344
Top = 18
Width = 24
Height = 24
Hint = 'Save Preset'
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnSavePresetClick
end
object btnDeletePreset: TSpeedButton
Left = 368
Top = 18
Width = 24
Height = 24
Hint = 'Delete Preset'
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnDeletePresetClick
end
object cmbPreset: TComboBox
Left = 10
Top = 20
Width = 327
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 0
OnChange = cmbPresetChange
end
end
object GroupBox1: TGroupBox
Left = 8
Top = 69
Width = 408
Height = 57
Caption = 'Destination'
TabOrder = 1
object btnBrowse: TSpeedButton
Left = 368
Top = 16
Width = 24
Height = 24
Hint = 'Browse...'
Flat = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
18000000000000030000120B0000120B00000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FF00000000000000000000000000000000000000000000
0000000000000000000000FF00FFFF00FFFF00FFFF00FFFF00FF000000000000
9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF000000FF00
FFFF00FFFF00FFFF00FF0000009FFFFF0000009FCFFF9FCFFF9FCFFF9FCFFF9F
CFFF9FCFFF9FCFFF9FCFFF9FCFFF000000FF00FFFF00FFFF00FF0000009FFFFF
9FFFFF0000009FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCF
FF000000FF00FFFF00FF0000009FFFFF9FFFFF9FFFFF0000009FCFFF9FCFFF9F
CFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF9FCFFF000000FF00FF0000009FFFFF
9FFFFF9FFFFF9FFFFF0000000000000000000000000000000000000000000000
00000000000000FF00FF0000009FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9F
FFFF9FFFFF9FFFFF000000FF00FFFF00FFFF00FFFF00FFFF00FF0000009FFFFF
9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF9FFFFF000000FF00FFFF00
FFFF00FFFF00FFFF00FF0000009FFFFF9FFFFF9FFFFF00000000000000000000
0000000000000000000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF000000
000000000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF0000
00000000000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FF000000000000FF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF0C0C0CFF00FFFF00FFFF00FF0000
00FF00FF000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FF0B0B0B020202000000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
ParentFont = False
ParentShowHint = False
ShowHint = True
OnClick = btnBrowseClick
end
object Label10: TLabel
Left = 10
Top = 23
Width = 48
Height = 13
Caption = 'File name:'
end
object txtFilename: TEdit
Left = 72
Top = 20
Width = 281
Height = 21
TabOrder = 0
OnChange = txtFilenameChange
end
end
object GroupBox2: TGroupBox
Left = 8
Top = 130
Width = 200
Height = 105
Caption = 'Size'
TabOrder = 2
object Label1: TLabel
Left = 10
Top = 23
Width = 28
Height = 13
Caption = 'Width'
end
object Label2: TLabel
Left = 10
Top = 47
Width = 34
Height = 13
Caption = 'Height:'
end
object chkMaintain: TCheckBox
Left = 8
Top = 76
Width = 161
Height = 17
Caption = 'Maintain aspect ratio'
Checked = True
State = cbChecked
TabOrder = 0
OnClick = chkMaintainClick
end
object cbWidth: TComboBox
Left = 112
Top = 20
Width = 73
Height = 21
BiDiMode = bdRightToLeftNoAlign
Enabled = False
ItemHeight = 13
ParentBiDiMode = False
TabOrder = 1
OnChange = txtWidthChange
Items.Strings = (
'320'
'640'
'800'
'1024'
'1280'
'1600'
'1920'
'2048'
'2560'
'3200')
end
object cbHeight: TComboBox
Left = 112
Top = 44
Width = 73
Height = 21
BiDiMode = bdRightToLeftNoAlign
Enabled = False
ItemHeight = 13
ParentBiDiMode = False
TabOrder = 2
OnChange = txtHeightChange
Items.Strings = (
'200'
'240'
'480'
'600'
'768'
'1024'
'1200'
'1920'
'2048'
'2400')
end
end
object GroupBox3: TGroupBox
Left = 216
Top = 130
Width = 200
Height = 105
Caption = 'Rendering'
TabOrder = 3
object Label3: TLabel
Left = 10
Top = 71
Width = 59
Height = 13
Caption = 'Oversample:'
end
object Label5: TLabel
Left = 10
Top = 47
Width = 61
Height = 13
Caption = 'Filter Radius:'
end
object Label4: TLabel
Left = 10
Top = 23
Width = 35
Height = 13
Caption = 'Quality:'
end
object txtOversample: TEdit
Left = 112
Top = 68
Width = 57
Height = 21
BiDiMode = bdRightToLeft
Enabled = False
ParentBiDiMode = False
ReadOnly = True
TabOrder = 2
Text = '2'
OnChange = txtOversampleChange
end
object txtFilterRadius: TEdit
Left = 112
Top = 44
Width = 57
Height = 21
BiDiMode = bdRightToLeft
ParentBiDiMode = False
TabOrder = 1
OnChange = txtFilterRadiusChange
end
object udOversample: TUpDown
Left = 169
Top = 68
Width = 13
Height = 21
Associate = txtOversample
Min = 1
Max = 16
Position = 2
TabOrder = 3
end
object txtDensity: TComboBox
Left = 112
Top = 20
Width = 57
Height = 21
AutoComplete = False
ItemHeight = 13
TabOrder = 0
OnChange = txtDensityChange
OnCloseUp = txtDensityChange
Items.Strings = (
'200'
'500'
'1000'
'2000'
'4000')
end
end
object GroupBox4: TGroupBox
Left = 8
Top = 238
Width = 409
Height = 81
Caption = 'Memory usage'
TabOrder = 4
object lblApproxMem: TLabel
Left = 359
Top = 52
Width = 42
Height = 13
Alignment = taRightJustify
Caption = '0000 Mb'
end
object lblPhysical: TLabel
Left = 359
Top = 32
Width = 42
Height = 13
Alignment = taRightJustify
Caption = '0000 Mb'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label6: TLabel
Left = 216
Top = 32
Width = 126
Height = 13
Caption = 'Available physical memory:'
end
object Label7: TLabel
Left = 216
Top = 52
Width = 119
Height = 13
Caption = 'Approx. memory required:'
end
object Label8: TLabel
Left = 12
Top = 24
Width = 61
Height = 13
Caption = 'Buffer depth:'
end
object lblMaxbits: TLabel
Left = 368
Top = 12
Width = 33
Height = 13
Hint = '- No render stats -'
Alignment = taRightJustify
Caption = '99.999'
ParentShowHint = False
ShowHint = True
end
object Label9: TLabel
Left = 216
Top = 12
Width = 96
Height = 13
Hint = '- No render stats -'
Caption = 'Max bits per sample:'
ParentShowHint = False
ShowHint = True
end
object cbMaxMemory: TComboBox
Left = 144
Top = 48
Width = 57
Height = 21
BiDiMode = bdRightToLeftNoAlign
Enabled = False
ItemHeight = 13
ParentBiDiMode = False
TabOrder = 1
Items.Strings = (
'32'
'64'
'128'
'256'
'512'
'1024'
'1536')
end
object chkLimitMem: TCheckBox
Left = 12
Top = 52
Width = 125
Height = 17
Caption = 'Limit memory usage to:'
TabOrder = 0
OnClick = chkLimitMemClick
end
object cbBitsPerSample: TComboBox
Left = 88
Top = 20
Width = 113
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 2
OnSelect = cbBitsPerSampleSelect
Items.Strings = (
'32-bit integer'
'32-bit floating-point'
'48-bit integer'
'64-bit integer')
end
end
end
object TabOutput: TTabSheet
Caption = 'Output'
ImageIndex = 1
object Output: TMemo
Left = 8
Top = 8
Width = 409
Height = 309
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
end
end
end
object SaveDialog: TSaveDialog object SaveDialog: TSaveDialog
Left = 376 Left = 136
Top = 304 Top = 360
end end
end end

217
2.10/Source/FormRender.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
@ -21,15 +22,28 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ControlPoint, RenderThread, ComCtrls, Math, Buttons, Registry, cmap, StdCtrls, ComCtrls, Math, Buttons, Registry, ExtCtrls, MMSystem,
ExtCtrls, MMSystem, ControlPoint, RenderThread, cmap, RenderTypes;
Render; // 'use'd only for SizeOf()
type type
TRenderForm = class(TForm) TRenderForm = class(TForm)
ProgressBar: TProgressBar; ProgressBar: TProgressBar;
btnRender: TButton; btnRender: TButton;
btnCancel: TButton; btnCancel: TButton;
SaveDialog: TSaveDialog;
btnPause: TButton;
chkSave: TCheckBox;
StatusBar: TStatusBar;
chkShutdown: TCheckBox;
cbPostProcess: TCheckBox;
chkSaveIncompleteRenders: TCheckBox;
PageCtrl: TPageControl;
TabSettings: TTabSheet;
TabOutput: TTabSheet;
GroupBox5: TGroupBox;
btnSavePreset: TSpeedButton;
btnDeletePreset: TSpeedButton;
cmbPreset: TComboBox;
GroupBox1: TGroupBox; GroupBox1: TGroupBox;
btnBrowse: TSpeedButton; btnBrowse: TSpeedButton;
Label10: TLabel; Label10: TLabel;
@ -37,34 +51,29 @@ type
GroupBox2: TGroupBox; GroupBox2: TGroupBox;
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
chkMaintain: TCheckBox;
cbWidth: TComboBox;
cbHeight: TComboBox;
GroupBox3: TGroupBox; GroupBox3: TGroupBox;
Label3: TLabel; Label3: TLabel;
Label5: TLabel; Label5: TLabel;
Label4: TLabel; Label4: TLabel;
txtOversample: TEdit; txtOversample: TEdit;
txtFilterRadius: TEdit; txtFilterRadius: TEdit;
udOversample: TUpDown;
txtDensity: TComboBox;
GroupBox4: TGroupBox; GroupBox4: TGroupBox;
lblApproxMem: TLabel; lblApproxMem: TLabel;
lblPhysical: TLabel; lblPhysical: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
lblMaxbits: TLabel;
Label9: TLabel; Label9: TLabel;
cbMaxMemory: TComboBox; cbMaxMemory: TComboBox;
chkLimitMem: TCheckBox; chkLimitMem: TCheckBox;
SaveDialog: TSaveDialog; cbBitsPerSample: TComboBox;
btnPause: TButton; Output: TMemo;
chkSave: TCheckBox;
GroupBox5: TGroupBox;
btnSavePreset: TSpeedButton;
cmbPreset: TComboBox;
btnDeletePreset: TSpeedButton;
udOversample: TUpDown;
chkMaintain: TCheckBox;
cbWidth: TComboBox;
cbHeight: TComboBox;
StatusBar: TStatusBar;
chkShutdown: TCheckBox;
cbPostProcess: TCheckBox;
txtDensity: TComboBox;
chkSaveIncompleteRenders: TCheckBox;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure btnRenderClick(Sender: TObject); procedure btnRenderClick(Sender: TObject);
@ -86,9 +95,12 @@ type
procedure cmbPresetChange(Sender: TObject); procedure cmbPresetChange(Sender: TObject);
procedure chkMaintainClick(Sender: TObject); procedure chkMaintainClick(Sender: TObject);
procedure chkSaveIncompleteRendersClick(Sender: TObject); procedure chkSaveIncompleteRendersClick(Sender: TObject);
procedure cbBitsPerSampleSelect(Sender: TObject);
private private
StartTime, oldElapsed, edt: TDateTime; StartTime, EndTime, oldElapsed, edt: TDateTime;
oldProg: double; oldProg: double;
ApproxSamples: int64;
SaveIncompleteRenders: boolean; SaveIncompleteRenders: boolean;
procedure DoPostProcess; procedure DoPostProcess;
@ -99,6 +111,7 @@ type
message WM_THREAD_TERMINATE; message WM_THREAD_TERMINATE;
procedure ListPresets; procedure ListPresets;
function WindowsExit(RebootParam: Longword = EWX_POWEROFF or EWX_FORCE): Boolean; function WindowsExit(RebootParam: Longword = EWX_POWEROFF or EWX_FORCE): Boolean;
public public
Renderer: TRenderThread; Renderer: TRenderThread;
PhysicalMemory, ApproxMemory: int64; PhysicalMemory, ApproxMemory: int64;
@ -106,14 +119,19 @@ type
cp: TControlPoint; cp: TControlPoint;
Filename: string; Filename: string;
ImageWidth, ImageHeight, Oversample: Integer; ImageWidth, ImageHeight, Oversample: Integer;
BitsPerSample: integer;
zoom, Sample_Density, Brightness, Gamma, Vibrancy, Filter_Radius: double; zoom, Sample_Density, Brightness, Gamma, Vibrancy, Filter_Radius: double;
center: array[0..1] of double; center: array[0..1] of double;
MaxMemory: integer;
procedure OnProgress(prog: double); procedure OnProgress(prog: double);
procedure ShowMemoryStatus; procedure ShowMemoryStatus;
procedure ResetControls; procedure ResetControls;
end; end;
const
ShowRenderStats = true;
var var
RenderForm: TRenderForm; RenderForm: TRenderForm;
Ratio: double; Ratio: double;
@ -136,6 +154,7 @@ begin
txtOversample.Enabled := true; txtOversample.Enabled := true;
chkLimitMem.Enabled := true; chkLimitMem.Enabled := true;
cbMaxMemory.enabled := chkLimitMem.Checked; cbMaxMemory.enabled := chkLimitMem.Checked;
cbBitsPerSample.Enabled := true;
cbPostProcess.Enabled := not chkLimitMem.Checked; cbPostProcess.Enabled := not chkLimitMem.Checked;
btnRender.Enabled := true; btnRender.Enabled := true;
cmbPreset.enabled := true; cmbPreset.enabled := true;
@ -157,22 +176,59 @@ begin
GlobalMemoryInfo.dwLength := SizeOf(GlobalMemoryInfo); GlobalMemoryInfo.dwLength := SizeOf(GlobalMemoryInfo);
GlobalMemoryStatus(GlobalMemoryInfo); GlobalMemoryStatus(GlobalMemoryInfo);
PhysicalMemory := GlobalMemoryInfo.dwAvailPhys div 1048576; PhysicalMemory := GlobalMemoryInfo.dwAvailPhys div 1048576;
ApproxMemory := int64(ImageHeight) * int64(ImageWidth) * int64(Oversample * Oversample ApproxMemory := int64(ImageHeight) * int64(ImageWidth) * sqr(Oversample) * SizeOfBucket[BitsPerSample] div 1048576;
* SizeOf(TBucket)) div 1048576;
lblPhysical.Caption := 'Physical memory available: ' + Format('%u', [PhysicalMemory]) + ' Mb'; lblPhysical.Caption := Format('%u', [PhysicalMemory]) + ' Mb';
lblApproxMem.Caption := 'Approximate memory required: ' + Format('%u', [ApproxMemory]) + ' Mb'; lblApproxMem.Caption := Format('%u', [ApproxMemory]) + ' Mb';
if ApproxMemory > PhysicalMemory then lblPhysical.Font.Color := clRed if ApproxMemory > PhysicalMemory then lblPhysical.Font.Color := clRed
else lblPhysical.Font.Color := clWindowText; else lblPhysical.Font.Color := clWindowText;
if ApproxMemory > 0 then
lblMaxbits.caption := format('%2.3f', [8 + log2(
sample_density * sqr(power(2, cp.zoom)) * int64(ImageHeight) * int64(ImageWidth) / sqr(oversample)
)]);
end;
function TimeToString(t: TDateTime): string;
var
n: integer;
begin
n := Trunc(t);
Result := '';
if n>0 then begin
Result := Result + Format(' %d day', [n]);
if (n mod 10) <> 1 then Result := Result + 's';
end;
t := t * 24;
n := Trunc(t) mod 24;
if n>0 then begin
Result := Result + Format(' %d hour', [n]);
if (n mod 10) <> 1 then Result := Result + 's';
end;
t := t * 60;
n := Trunc(t) mod 60;
if n>0 then begin
Result := Result + Format(' %d minute', [n]);
if (n mod 10) <> 1 then Result := Result + 's';
end;
t := t * 60;
t := t - (Trunc(t) div 60) * 60;
Result := Result + Format(' %.2f seconds', [t]);
end; end;
procedure TRenderForm.HandleThreadCompletion(var Message: TMessage); procedure TRenderForm.HandleThreadCompletion(var Message: TMessage);
var
Stats: TBucketStats;
begin begin
if not chkLimitMem.Checked and cbPostProcess.checked then EndTime := Now;
DoPostProcess; // Output.Lines.Add(TimeToStr(EndTime) + ' : Saving image');
try
Renderer.SaveImage(FileName); Renderer.SaveImage(FileName);
except
Output.Lines.Add(TimeToStr(Now) + ' : Error saving image!');
end;
if PlaySoundOnRenderComplete then if PlaySoundOnRenderComplete then
if RenderCompleteSoundFile <> '' then if RenderCompleteSoundFile <> '' then
@ -180,6 +236,30 @@ begin
else else
sndPlaySound(pchar(SND_ALIAS_SYSTEMASTERISK), SND_ALIAS_ID or SND_NOSTOP or SND_ASYNC); sndPlaySound(pchar(SND_ALIAS_SYSTEMASTERISK), SND_ALIAS_ID or SND_NOSTOP or SND_ASYNC);
if ShowRenderStats then with Stats do
with Output.Lines do
begin
Add('');
Add('Render Statistics:');
Add(Format(' Max possible bits: %2.3f', [8 + log2(ApproxSamples)]));
Renderer.GetBucketStats(Stats);
Add(Format(' Max Red: %2.3f bits (%u)', [log2(MaxR), MaxR]));
Add(Format(' Max Green: %2.3f bits (%u)', [log2(MaxG), MaxG]));
Add(Format(' Max Blue: %2.3f bits (%u)', [log2(MaxB), MaxB]));
Add(Format(' Max Count: %2.3f bits (%u)', [log2(MaxA), MaxA]));
Add(Format(' Point hit ratio: %2.2f%%', [100.0*(TotalA/TotalSamples)]));
if RenderTime > 0 then // hmm
Add(Format(' Average speed: %n points per second', [TotalSamples / (RenderTime * 24 * 60 * 60)]));
Add(' Rendering time:' + TimeToString(RenderTime));
Add(' Total time:' + TimeToString(EndTime - StartTime));
end;
Output.Lines.Add('');
PageCtrl.TabIndex := 1;
if not chkLimitMem.Checked and cbPostProcess.checked then
DoPostProcess;
Renderer.Free; Renderer.Free;
Renderer := nil; Renderer := nil;
ResetControls; ResetControls;
@ -191,8 +271,15 @@ procedure TRenderForm.HandleThreadTermination(var Message: TMessage);
begin begin
if Assigned(Renderer) then if Assigned(Renderer) then
begin begin
if SaveIncompleteRenders then Renderer.SaveImage(FileName); Output.Lines.Add(TimeToStr(Now) + ' : Rendering terminated!');
sndPlaySound(pchar(SND_ALIAS_SYSTEMEXCLAMATION), SND_ALIAS_ID or SND_NOSTOP or SND_ASYNC);
(*
if SaveIncompleteRenders and not chkLimitMem.Checked then begin
Output.Lines.Add('Saving incomplete image...');
Renderer.SaveImage(FileName);
end;
Output.Lines.Add('');
*)
Renderer.Free; Renderer.Free;
Renderer := nil; Renderer := nil;
ResetControls; ResetControls;
@ -251,6 +338,8 @@ procedure TRenderForm.FormCreate(Sender: TObject);
begin begin
cp := TControlPoint.Create; cp := TControlPoint.Create;
cbMaxMemory.ItemIndex := 1; cbMaxMemory.ItemIndex := 1;
cbBitsPerSample.ItemIndex := 0;
BitsPerSample := 0;
MainForm.Buttons.GetBitmap(2, btnSavePreset.Glyph); MainForm.Buttons.GetBitmap(2, btnSavePreset.Glyph);
MainForm.Buttons.GetBitmap(9, btnDeletePreset.Glyph); MainForm.Buttons.GetBitmap(9, btnDeletePreset.Glyph);
ListPresets; ListPresets;
@ -323,6 +412,16 @@ begin
Application.MessageBox('Invalid image height', 'Apophysis', 16); Application.MessageBox('Invalid image height', 'Apophysis', 16);
exit; exit;
end; end;
if chkLimitMem.checked then
begin
try
MaxMemory := StrToInt(cbMaxMemory.text);
if MaxMemory <= 0 then raise Exception.Create('');
except
Application.MessageBox('Invalid maximum memory value', 'Apophysis', 16);
exit;
end;
end;
txtFilename.Enabled := false; txtFilename.Enabled := false;
btnBrowse.Enabled := false; btnBrowse.Enabled := false;
cbWidth.Enabled := False; cbWidth.Enabled := False;
@ -332,6 +431,7 @@ begin
txtOversample.Enabled := false; txtOversample.Enabled := false;
chkLimitMem.Enabled := false; chkLimitMem.Enabled := false;
cbMaxMemory.Enabled := false; cbMaxMemory.Enabled := false;
cbBitsPerSample.Enabled := false;
cmbPreset.enabled := false; cmbPreset.enabled := false;
chkSave.enabled := false; chkSave.enabled := false;
// cbPostProcess.enabled := false; // cbPostProcess.enabled := false;
@ -343,7 +443,26 @@ begin
btnCancel.Caption := 'Stop'; btnCancel.Caption := 'Stop';
StartTime := Now; StartTime := Now;
// Remaining := 365; // Remaining := 365;
PageCtrl.TabIndex := 1;
Output.Lines.Add('--- Rendering "' + ExtractFileName(FileName) + '" ---');
Output.Lines.Add(Format(' Size: %dx%d', [ImageWidth, ImageHeight]));
Output.Lines.Add(Format(' Quality: %g', [sample_density]));
Output.Lines.Add(Format(' Oversample: %d, Filter: %g', [oversample, filter_radius]));
Output.Lines.Add(Format(' Buffer depth: %s', [cbBitsPerSample.Items[BitsPerSample]]));
if chkLimitMem.checked then
Output.Lines.Add(Format(' Memory limit: %d Mb', [MaxMemory]))
else
if (UpperCase(ExtractFileExt(FileName)) = '.PNG') and
(ImageWidth * ImageHeight >= 20000000) then
begin
Output.Lines.Add('*** WARNING *** Using PNG format with extreme high-resolution images is not recommended!');
Output.Lines.Add('To avoid slowdown (and possible memory problems) use BMP file format instead.');
end;
if Assigned(Renderer) then begin if Assigned(Renderer) then begin
Output.Lines.Add(TimeToStr(Now) + 'Shutting down previous render...'); // hmm
Renderer.Terminate; Renderer.Terminate;
Renderer.WaitFor; Renderer.WaitFor;
Renderer.Free; Renderer.Free;
@ -357,6 +476,7 @@ begin
cp.spatial_oversample := Oversample; cp.spatial_oversample := Oversample;
cp.spatial_filter_radius := Filter_Radius; cp.spatial_filter_radius := Filter_Radius;
cp.AdjustScale(ImageWidth, ImageHeight); cp.AdjustScale(ImageWidth, ImageHeight);
cp.Transparency := (PNGTransparency <> 0) and (UpperCase(ExtractFileExt(FileName)) = '.PNG');
renderPath := ExtractFilePath(Filename); renderPath := ExtractFilePath(Filename);
if chkSave.checked then if chkSave.checked then
MainForm.SaveXMLFlame(cp, ExtractFileName(FileName), renderPath + 'renders.flame'); MainForm.SaveXMLFlame(cp, ExtractFileName(FileName), renderPath + 'renders.flame');
@ -364,23 +484,28 @@ begin
oldProg:=0; oldProg:=0;
oldElapsed:=0; oldElapsed:=0;
edt:=0; edt:=0;
ApproxSamples := Round(sample_density * sqr(power(2, cp.zoom)) * int64(ImageHeight) * int64(ImageWidth) / sqr(oversample) );
try try
Renderer := TRenderThread.Create; Renderer := TRenderThread.Create;
assert(Renderer <> nil); assert(Renderer <> nil);
Renderer.BitsPerSample := BitsPerSample;
if chkLimitMem.checked then if chkLimitMem.checked then
Renderer.MaxMem := StrToInt(cbMaxMemory.text); Renderer.MaxMem := MaxMemory;//StrToInt(cbMaxMemory.text);
Renderer.OnProgress := OnProgress; Renderer.OnProgress := OnProgress;
Renderer.TargetHandle := self.Handle; Renderer.TargetHandle := self.Handle;
Renderer.Compatibility := compatibility; // Renderer.Output := Output.Lines;
// Renderer.Compatibility := compatibility;
Renderer.SetCP(cp); Renderer.SetCP(cp);
Renderer.Priority := tpLower; Renderer.Priority := tpLower;
Renderer.NrThreads := NrTreads; Renderer.NrThreads := NrTreads;
Renderer.Resume;
Renderer.Output := Output.Lines;
Renderer.Resume;
except except
Application.MessageBox('Error while rendering!', 'Apophysis', 48) Output.Lines.Add(TimeToStr(Now) + ' : Rendering failed!');
Application.MessageBox('Error while rendering!', 'Apophysis', 48)
end; end;
// enable screensaver // enable screensaver
@ -421,6 +546,8 @@ begin
ImageHeight := StrToInt(cbHeight.Text); ImageHeight := StrToInt(cbHeight.Text);
sample_density := renderDensity; sample_density := renderDensity;
txtDensity.Text := FloatToStr(sample_density); txtDensity.Text := FloatToStr(sample_density);
BitsPerSample := renderBitsPerSample;
cbBitsPerSample.ItemIndex := BitsPerSample;
ShowMemoryStatus; ShowMemoryStatus;
Ratio := ImageWidth / ImageHeight; Ratio := ImageWidth / ImageHeight;
end; end;
@ -496,8 +623,17 @@ begin
Renderer.Resume; Renderer.Resume;
btnPause.caption := 'Pause'; btnPause.caption := 'Pause';
end; end;
Renderer.Terminate;
Renderer.WaitFor; // --?-- if SaveIncompleteRenders and not ChkLimitMem.Checked then begin
Renderer.Break;
Renderer.WaitFor; //?
end
else begin
Renderer.Terminate;
Renderer.WaitFor; //?
PageCtrl.TabIndex := 0;
end;
end end
else close; else close;
end; end;
@ -508,6 +644,7 @@ begin
Sample_Density := StrToFloat(txtDensity.Text); Sample_Density := StrToFloat(txtDensity.Text);
except except
end; end;
ShowMemoryStatus;
end; end;
procedure TRenderForm.txtFilterRadiusChange(Sender: TObject); procedure TRenderForm.txtFilterRadiusChange(Sender: TObject);
@ -532,6 +669,7 @@ begin
renderHeight := ImageHeight; renderHeight := ImageHeight;
renderDensity := Sample_density; renderDensity := Sample_density;
renderOversample := Oversample; renderOversample := Oversample;
renderBitsPerSample := BitsPerSample;
{ Write position to registry } { Write position to registry }
Registry := TRegistry.Create; Registry := TRegistry.Create;
try try
@ -791,5 +929,12 @@ begin
SaveIncompleteRenders := chkSaveIncompleteRenders.Checked; SaveIncompleteRenders := chkSaveIncompleteRenders.Checked;
end; end;
procedure TRenderForm.cbBitsPerSampleSelect(Sender: TObject);
begin
BitsPerSample := cbBitsPerSample.ItemIndex;
ShowMemoryStatus;
end;
end. end.

30
2.10/Source/Fullscreen.dfm
View File

@ -12,8 +12,10 @@ object FullscreenForm: TFullscreenForm
Font.Name = 'MS Sans Serif' Font.Name = 'MS Sans Serif'
Font.Style = [] Font.Style = []
OldCreateOrder = False OldCreateOrder = False
PopupMenu = FullscreenPopup
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnDblClick = ImageDblClick
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnKeyPress = FormKeyPress OnKeyPress = FormKeyPress
OnShow = FormShow OnShow = FormShow
@ -24,6 +26,34 @@ object FullscreenForm: TFullscreenForm
Top = 0 Top = 0
Width = 186 Width = 186
Height = 131 Height = 131
PopupMenu = FullscreenPopup
OnDblClick = ImageDblClick OnDblClick = ImageDblClick
end end
object Timelimiter: TTimer
Enabled = False
Interval = 2000
OnTimer = TimelimiterOnTimer
Left = 8
Top = 8
end
object FullscreenPopup: TPopupMenu
Left = 40
Top = 8
object RenderStop: TMenuItem
Caption = '&Stop Render'
OnClick = RenderStopClick
end
object RenderMore: TMenuItem
Caption = 'Render &More'
ShortCut = 114
OnClick = RenderMoreClick
end
object N1: TMenuItem
Caption = '-'
end
object Exit1: TMenuItem
Caption = '&Close'
OnClick = ImageDblClick
end
end
end end

129
2.10/Source/Fullscreen.pas
View File

@ -21,21 +21,31 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ControlPoint, RenderThread, ExtCtrls; Menus, ExtCtrls, ControlPoint, RenderThread;
type type
TFullscreenForm = class(TForm) TFullscreenForm = class(TForm)
Image: TImage; Image: TImage;
Timelimiter: TTimer;
FullscreenPopup: TPopupMenu;
RenderStop: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
RenderMore: TMenuItem;
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char); procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure ImageDblClick(Sender: TObject); procedure ImageDblClick(Sender: TObject);
procedure TimelimiterOnTimer(Sender: TObject);
procedure RenderStopClick(Sender: TObject);
procedure RenderMoreClick(Sender: TObject);
private private
Remainder, StartTime, t: double; Remainder, StartTime, t: double;
imgLeft, imgTop, imgLeft, imgTop,
imgWidth, imgHeight: integer; imgWidth, imgHeight: integer;
Closing: boolean;
Renderer: TRenderThread; Renderer: TRenderThread;
@ -93,24 +103,34 @@ begin
t := now; t := now;
Remainder := 1; Remainder := 1;
if Assigned(Renderer) then begin if Assigned(Renderer) then begin // hmm...
// Hmm... but how can it be assigned & running here, anyway? :-\
Renderer.Terminate; Renderer.Terminate;
Renderer.WaitFor; Renderer.WaitFor;
Application.ProcessMessages; // HandleThreadTermination kinda should be called here...(?) while Renderer <> nil do
Application.ProcessMessages; // HandleThreadTermination kinda should be called here...(?)
Renderer.Free; // Renderer.Free;
Renderer := nil; // Renderer := nil;
end; end;
assert(not assigned(renderer), 'Render thread is still running!?'); assert(not assigned(renderer), 'Render thread is still running!?');
Renderer := TRenderThread.Create; Renderer := TRenderThread.Create; // Hmm... Why do we use RenderThread here, anyway? :-\
Renderer.TargetHandle := Handle; Renderer.TargetHandle := Handle;
Renderer.OnProgress := OnProgress; Renderer.OnProgress := OnProgress;
Renderer.Compatibility := Compatibility; Renderer.NrThreads := NrTreads;
Renderer.SetCP(cp); Renderer.SetCP(cp);
if FullscreenTimeLimit > 0 then begin
TimeLimiter.Interval := FullscreenTimeLimit;
TimeLimiter.Enabled := FALSE;//true;
end;
Renderer.WaitForMore := true;
RenderStop.Enabled := true;
RenderMore.Enabled := false;
Renderer.Resume; Renderer.Resume;
end; end;
@ -126,26 +146,37 @@ begin
Image.Picture.Graphic := bm; Image.Picture.Graphic := bm;
// Canvas.StretchDraw(Rect(0, 0, ClientWidth, ClientHeight), bm); // Canvas.StretchDraw(Rect(0, 0, ClientWidth, ClientHeight), bm);
Renderer.Free; //Renderer.Free;
Renderer := nil; //Renderer := nil;
bm.Free; bm.Free;
end; end;
RenderStop.Enabled := false;
RenderMore.Enabled := true;
TimeLimiter.Enabled := false;
end; end;
procedure TFullscreenForm.HandleThreadTermination(var Message: TMessage); procedure TFullscreenForm.HandleThreadTermination(var Message: TMessage);
//var var
// bm: TBitmap; bm: TBitmap;
begin begin
if Assigned(Renderer) then if Assigned(Renderer) then begin
begin (*
// bm := TBitmap.Create; if not Closing then begin
// bm.assign(Renderer.GetImage); bm := TBitmap.Create;
// Image.Picture.Graphic := bm; bm.assign(Renderer.GetImage);
Image.SetBounds(imgLeft, imgTop, imgWidth, imgHeight);
Renderer.Free; Image.Picture.Graphic := bm;
Renderer := nil; bm.Free;
// bm.Free; end;
*)
//Renderer.Free;
//Renderer := nil;
end; end;
RenderStop.Enabled := false;
RenderMore.Enabled := false;
TimeLimiter.Enabled := false;
end; end;
procedure TFullscreenForm.OnProgress(prog: double); procedure TFullscreenForm.OnProgress(prog: double);
@ -192,8 +223,15 @@ begin
if Image.Height < ClientHeight then if Image.Height < ClientHeight then
Image.Top := (ClientHeight - Image.Height) div 2; Image.Top := (ClientHeight - Image.Height) div 2;
Closing := false;
TimeLimiter.Enabled := false;
RenderStop.Enabled := false;
RenderMore.Enabled := false;
MainForm.mnuFullScreen.enabled := true; MainForm.mnuFullScreen.enabled := true;
HideTaskbar; HideTaskbar;
if calculate then if calculate then
DrawFlame; DrawFlame;
end; end;
@ -201,7 +239,18 @@ end;
procedure TFullscreenForm.FormClose(Sender: TObject; procedure TFullscreenForm.FormClose(Sender: TObject;
var Action: TCloseAction); var Action: TCloseAction);
begin begin
if Assigned(Renderer) then Renderer.Terminate; Closing := true;
if Assigned(Renderer) then begin
if Renderer.Suspended then begin
Renderer.WaitForMore := false;
Renderer.Resume;
end;
Renderer.Terminate;
Renderer.WaitFor;
Renderer.Free;
Renderer := nil;
end;
ShowTaskbar; ShowTaskbar;
end; end;
@ -212,20 +261,46 @@ end;
procedure TFullscreenForm.FormDestroy(Sender: TObject); procedure TFullscreenForm.FormDestroy(Sender: TObject);
begin begin
if assigned(Renderer) then Renderer.Terminate; if assigned(Renderer) then begin
if assigned(Renderer) then Renderer.WaitFor; Renderer.Terminate;
if assigned(Renderer) then Renderer.Free; Renderer.WaitFor;
Renderer.Free;
end;
cp.Free; cp.Free;
end; end;
procedure TFullscreenForm.FormKeyPress(Sender: TObject; var Key: Char); procedure TFullscreenForm.FormKeyPress(Sender: TObject; var Key: Char);
begin begin
close; if key = ' ' then begin
if RenderStop.Enabled then RenderStop.Click
else if RenderMore.Enabled then RenderMore.Click;
end
else Close;
end; end;
procedure TFullscreenForm.ImageDblClick(Sender: TObject); procedure TFullscreenForm.ImageDblClick(Sender: TObject);
begin begin
close; Close;
end;
procedure TFullscreenForm.TimelimiterOnTimer(Sender: TObject);
begin
//if assigned(Renderer) then Renderer.Break;
TimeLimiter.Enabled := false;
end;
procedure TFullscreenForm.RenderStopClick(Sender: TObject);
begin
if assigned(Renderer) then Renderer.Break;
end;
procedure TFullscreenForm.RenderMoreClick(Sender: TObject);
begin
if assigned(Renderer) and Renderer.Suspended then begin
Renderer.Resume;
RenderStop.Enabled := true;
RenderMore.Enabled := false;
end;
end; end;
end. end.

7
2.10/Source/Global.pas
View File

@ -93,9 +93,11 @@ var
{ Render } { Render }
renderDensity, renderFilterRadius: double; renderDensity, renderFilterRadius: double;
renderOversample, renderWidth, renderHeight: integer; renderOversample, renderWidth, renderHeight: integer;
renderBitsPerSample: integer;
renderPath: string; renderPath: string;
JPEGQuality: integer; JPEGQuality: integer;
renderFileFormat: integer; renderFileFormat: integer;
InternalBitsPerSample: integer;
{ Defaults } { Defaults }
SavePath, SmoothPalettePath: string; SavePath, SmoothPalettePath: string;
RandomPrefix, RandomDate: string; RandomPrefix, RandomDate: string;
@ -129,7 +131,7 @@ var
Favorites: TStringList; Favorites: TStringList;
Script: string; Script: string;
ScriptPath: string; ScriptPath: string;
SheepServer, SheepNick, SheepURL, SheepPW, HqiPath: string; SheepServer, SheepNick, SheepURL, SheepPW, flam3Path: string;
ExportBatches, ExportOversample, ExportWidth, ExportHeight, ExportFileFormat: Integer; ExportBatches, ExportOversample, ExportWidth, ExportHeight, ExportFileFormat: Integer;
ExportFilter, ExportDensity: Double; ExportFilter, ExportDensity: Double;
ExportEstimator, ExportEstimatorMin, ExportEstimatorCurve: double; ExportEstimator, ExportEstimatorMin, ExportEstimatorCurve: double;
@ -146,6 +148,9 @@ var
NrTreads: Integer; NrTreads: Integer;
UseNrThreads: integer; UseNrThreads: integer;
PreviewTimeLimit, FullscreenTimeLimit: integer;
PreviewMinDensity: double;
function Round6(x: double): double; function Round6(x: double): double;
implementation implementation

634
2.10/Source/ImageMaker.pas
View File

@ -3,7 +3,12 @@ unit ImageMaker;
interface interface
uses uses
Windows, Graphics, ControlPoint, Render; Windows, Graphics, ControlPoint, RenderTypes;
type TPalette = record
logpal : TLogPalette;
colors: array[0..255] of TPaletteEntry;
end;
type type
TImageMaker = class TImageMaker = class
@ -14,14 +19,27 @@ type
FBitmap: TBitmap; FBitmap: TBitmap;
FAlphaBitmap: TBitmap; FAlphaBitmap: TBitmap;
AlphaPalette: TPalette;
FTransparentImage: TBitmap; FTransparentImage: TBitmap;
Fcp: Tcontrolpoint;
FCP: TControlPoint;
FBucketHeight: integer;
FBucketWidth: integer; FBucketWidth: integer;
FBuckets: TBucketArray;
FBuckets64: TBucket64Array;
FBuckets48: TBucket48Array;
FBuckets32: TBucket32Array;
FBuckets32f: TBucket32fArray;
FOnProgress: TOnProgress; FOnProgress: TOnProgress;
MaxA: int64; // for reuse in following slices FGetBucket: function(x, y: integer): TBucket64 of object;
function GetBucket64(x, y: integer): TBucket64;
function GetBucket48(x, y: integer): TBucket64;
function GetBucket32(x, y: integer): TBucket64;
function GetBucket32f(x, y: integer): TBucket64;
function SafeGetBucket(x, y: integer): TBucket64;
procedure CreateFilter; procedure CreateFilter;
procedure NormalizeFilter; procedure NormalizeFilter;
@ -31,27 +49,26 @@ type
function GetTransparentImage: TBitmap; function GetTransparentImage: TBitmap;
procedure CreateImage_MB(YOffset: integer = 0);
procedure CreateImage_Flame3(YOffset: integer = 0);
public public
constructor Create;
destructor Destroy; override; destructor Destroy; override;
function GetImage: TBitmap; function GetImage: TBitmap;
procedure SetCP(CP: TControlPoint); procedure SetCP(CP: TControlPoint);
procedure Init; procedure Init;
procedure SetBucketData(const Buckets: TBucketArray; const BucketWidth: integer); procedure SetBucketData(const Buckets: pointer; BucketWidth, BucketHeight: integer; bits: integer);
function GetFilterSize: Integer; function GetFilterSize: Integer;
procedure CreateImage(YOffset: integer = 0); procedure CreateImage(YOffset: integer = 0);
procedure SaveImage(const FileName: String); procedure SaveImage(FileName: String);
procedure GetBucketStats(var Stats: TBucketStats);
property OnProgress: TOnProgress property OnProgress: TOnProgress
read FOnProgress read FOnProgress
write SetOnProgress; write SetOnProgress;
property MaxCount: int64 read MaxA;
end; end;
implementation implementation
@ -75,6 +92,21 @@ type
PRGBArray = ^TRGBArray; PRGBArray = ^TRGBArray;
TRGBArray = array[0..0] of TRGB; TRGBArray = array[0..0] of TRGB;
///////////////////////////////////////////////////////////////////////////////
constructor TImageMaker.Create;
var
i: integer;
begin
AlphaPalette.logpal.palVersion := $300;
AlphaPalette.logpal.palNumEntries := 256;
for i := 0 to 255 do
with AlphaPalette.logpal.palPalEntry[i] do begin
peRed := i;
peGreen := i;
peBlue := i;
end;
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
destructor TImageMaker.Destroy; destructor TImageMaker.Destroy;
begin begin
@ -177,10 +209,23 @@ begin
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.SetBucketData(const Buckets: TBucketArray; const BucketWidth: integer); procedure TImageMaker.SetBucketData(const Buckets: pointer; BucketWidth, BucketHeight: integer; bits: integer);
begin begin
FBuckets := Buckets; FBuckets64 := TBucket64Array(Buckets);
FBuckets48 := TBucket48Array(Buckets);
FBuckets32f := TBucket32fArray(Buckets);
FBuckets32 := TBucket32Array(Buckets);
FBucketWidth := BucketWidth; FBucketWidth := BucketWidth;
FBucketHeight := BucketHeight;
case bits of
BITS_32: FGetBucket := GetBucket32;
BITS_32f: FGetBucket := GetBucket32f;
BITS_48: FGetBucket := GetBucket48;
BITS_64: FGetBucket := GetBucket64;
else assert(false);
end;
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
@ -197,25 +242,13 @@ end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.CreateImage(YOffset: integer); procedure TImageMaker.CreateImage(YOffset: integer);
begin
Case PNGTransparency of
0,1:
CreateImage_Flame3(YOffset);
2:
CreateImage_MB(YOffset);
else
Exception.CreateFmt('Unexpected value of PNGTransparency [%d]', [PNGTransparency]);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.CreateImage_Flame3(YOffset: integer);
var var
gamma: double; gamma: double;
i, j: integer; i, j: integer;
alpha: double; alpha: double;
ai, ri, gi, bi: Integer; ri, gi, bi: Integer;
bgtot: TRGB; ai, ia: integer;
bgtot, zero_BG: TRGB;
ls: double; ls: double;
ii, jj: integer; ii, jj: integer;
fp: array[0..3] of double; fp: array[0..3] of double;
@ -223,14 +256,19 @@ var
AlphaRow: PbyteArray; AlphaRow: PbyteArray;
vib, notvib: Integer; vib, notvib: Integer;
bgi: array[0..2] of Integer; bgi: array[0..2] of Integer;
bucketpos: Integer; // bucketpos: Integer;
filterValue: double; filterValue: double;
filterpos: Integer; // filterpos: Integer;
lsa: array[0..1024] of double; lsa: array[0..1024] of double;
sample_density: double; sample_density: extended;
gutter_width: integer; gutter_width: integer;
k1, k2: double; k1, k2: double;
area: double; area: double;
GetBucket: function(x, y: integer): TBucket64 of object;
bucket: TBucket64;
bx, by: integer;
label zero_alpha;
begin begin
if fcp.gamma = 0 then if fcp.gamma = 0 then
gamma := fcp.gamma gamma := fcp.gamma
@ -245,181 +283,21 @@ begin
bgtot.red := bgi[0]; bgtot.red := bgi[0];
bgtot.green := bgi[1]; bgtot.green := bgi[1];
bgtot.blue := bgi[2]; bgtot.blue := bgi[2];
zero_BG.red := 0;
zero_BG.green := 0;
zero_BG.blue := 0;
gutter_width := FBucketwidth - FOversample * fcp.Width; gutter_width := FBucketwidth - FOversample * fcp.Width;
// gutter_width := 2 * ((25 - Foversample) div 2); // gutter_width := 2 * ((25 - Foversample) div 2);
if(FFilterSize <= gutter_width div 2) then // filter too big when 'post-processing' ?
FBitmap.PixelFormat := pf24bit; GetBucket := FGetBucket
sample_density := fcp.sample_density * power(2, fcp.zoom) * power(2, fcp.zoom);
k1 := (fcp.Contrast * BRIGHT_ADJUST * fcp.brightness * 268 * PREFILTER_WHITE) / 256.0;
area := FBitmap.Width * FBitmap.Height / (fcp.ppux * fcp.ppuy);
k2 := (FOversample * FOversample) / (fcp.Contrast * area * fcp.White_level * sample_density);
lsa[0] := 0;
for i := 1 to 1024 do begin
lsa[i] := (k1 * log10(1 + fcp.White_level * i * k2)) / (fcp.White_level * i);
end;
ls := 0;
ai := 0;
bucketpos := 0;
for i := 0 to fcp.Height - 1 do begin
// if FStop then
// Break;
Progress(i / fcp.Height);
AlphaRow := PByteArray(FAlphaBitmap.scanline[YOffset + i]);
Row := PRGBArray(FBitmap.scanline[YOffset + i]);
for j := 0 to fcp.Width - 1 do begin
if FFilterSize > 1 then begin
fp[0] := 0;
fp[1] := 0;
fp[2] := 0;
fp[3] := 0;
for ii := 0 to FFilterSize - 1 do begin
for jj := 0 to FFilterSize - 1 do begin
filterValue := FFilter[ii, jj];
filterpos := bucketpos + ii * FBucketWidth + jj;
ls := lsa[Min(1023, FBuckets[filterpos].Count)];
fp[0] := fp[0] + filterValue * ls * FBuckets[filterpos].Red;
fp[1] := fp[1] + filterValue * ls * FBuckets[filterpos].Green;
fp[2] := fp[2] + filterValue * ls * FBuckets[filterpos].Blue;
fp[3] := fp[3] + filterValue * ls * FBuckets[filterpos].Count;
end;
end;
fp[0] := fp[0] / PREFILTER_WHITE;
fp[1] := fp[1] / PREFILTER_WHITE;
fp[2] := fp[2] / PREFILTER_WHITE;
fp[3] := fcp.white_level * fp[3] / PREFILTER_WHITE;
end else begin
ls := lsa[Min(1023, FBuckets[bucketpos].count)] / PREFILTER_WHITE;
fp[0] := ls * FBuckets[bucketpos].Red;
fp[1] := ls * FBuckets[bucketpos].Green;
fp[2] := ls * FBuckets[bucketpos].Blue;
fp[3] := ls * FBuckets[bucketpos].Count * fcp.white_level;
end;
Inc(bucketpos, FOversample);
if (fp[3] > 0.0) then begin
alpha := power(fp[3], gamma);
ls := vib * alpha / fp[3];
ai := round(alpha * 256);
if (ai < 0) then
ai := 0
else if (ai > 255) then
ai := 255;
ai := 255 - ai;
end else begin
// no intensity so simply set the BG;
Row[j] := bgtot;
AlphaRow[j] := 0;
continue;
end;
if (notvib > 0) then
ri := Round(ls * fp[0] + notvib * power(fp[0], gamma))
else
ri := Round(ls * fp[0]);
ri := ri + (ai * bgi[0]) shr 8;
if (ri < 0) then
ri := 0
else if (ri > 255) then
ri := 255;
if (notvib > 0) then
gi := Round(ls * fp[1] + notvib * power(fp[1], gamma))
else
gi := Round(ls * fp[1]);
gi := gi + (ai * bgi[1]) shr 8;
if (gi < 0) then
gi := 0
else if (gi > 255) then
gi := 255;
if (notvib > 0) then
bi := Round(ls * fp[2] + notvib * power(fp[2], gamma))
else
bi := Round(ls * fp[2]);
bi := bi + (ai * bgi[2]) shr 8;
if (bi < 0) then
bi := 0
else if (bi > 255) then
bi := 255;
Row[j].red := ri;
Row[j].green := gi;
Row[j].blue := bi;
AlphaRow[j] := 255 - ai;
end;
Inc(bucketpos, gutter_width);
Inc(bucketpos, (FOversample - 1) * FBucketWidth);
end;
FBitmap.PixelFormat := pf24bit;
Progress(1);
end;
///////////////////////////////////////////////////////////////////////////////
// michael baranov transparancy code from flamesong
procedure TImageMaker.CreateImage_MB(YOffset: integer);
var
gamma: double;
i, j: integer;
alpha: double;
ai, ri, gi, bi: Integer;
bgtot: TRGB;
ls: double;
ii, jj: integer;
fp: array[0..3] of double;
Row: PRGBArray;
AlphaRow: PbyteArray;
vib, notvib: Integer;
bgi: array[0..2] of Integer;
bucketpos: Integer;
filterValue: double;
filterpos: Integer;
lsa: array[0..1024] of double;
sample_density: double;
gutter_width: integer;
k1, k2: double;
area: double;
ACount: double;
RCount: double;
GCount: double;
BCount: double;
offsetLow: double;
offsetHigh: double;
densLow: double;
densHigh: double;
divisor: double;
begin
if fcp.gamma = 0 then
gamma := fcp.gamma
else else
gamma := 1 / (2* fcp.gamma); GetBucket := SafeGetBucket;
vib := round(fcp.vibrancy * 256.0);
notvib := 256 - vib;
bgi[0] := round(fcp.background[0]); FBitmap.PixelFormat := pf24bit;
bgi[1] := round(fcp.background[1]);
bgi[2] := round(fcp.background[2]);
bgtot.red := bgi[0];
bgtot.green := bgi[1];
bgtot.blue := bgi[2];
gutter_width := FBucketwidth - FOversample * fcp.Width; sample_density := fcp.actual_density * sqr( power(2, fcp.zoom) );
if sample_density = 0 then sample_density := 0.001;
sample_density := fcp.sample_density * power(2, fcp.zoom) * power(2, fcp.zoom);
k1 := (fcp.Contrast * BRIGHT_ADJUST * fcp.brightness * 268 * PREFILTER_WHITE) / 256.0; k1 := (fcp.Contrast * BRIGHT_ADJUST * fcp.brightness * 268 * PREFILTER_WHITE) / 256.0;
area := FBitmap.Width * FBitmap.Height / (fcp.ppux * fcp.ppuy); area := FBitmap.Width * FBitmap.Height / (fcp.ppux * fcp.ppuy);
k2 := (FOversample * FOversample) / (fcp.Contrast * area * fcp.White_level * sample_density); k2 := (FOversample * FOversample) / (fcp.Contrast * area * fcp.White_level * sample_density);
@ -429,34 +307,14 @@ begin
lsa[i] := (k1 * log10(1 + fcp.White_level * i * k2)) / (fcp.White_level * i); lsa[i] := (k1 * log10(1 + fcp.White_level * i * k2)) / (fcp.White_level * i);
end; end;
// only do this for the first slice
// TODO: should be nicer always using a image wide value
if YOffset = 0 then begin
MaxA := 0;
bucketpos := 0;
for i := 0 to fcp.Height - 1 do begin
for j := 0 to fcp.Width - 1 do begin
MaxA := Max(MaxA, FBuckets[bucketpos].Count);
Inc(bucketpos, FOversample);
end;
Inc(bucketpos, gutter_width);
Inc(bucketpos, (FOversample - 1) * FBucketWidth);
end;
end;
offsetLow := 0;
offsetHigh := 0.02;
densLow := MaxA * offsetLow;
densHigh := MaxA * offsetHigh;
divisor := power(MaxA * (1 - offsethigh), Gamma);
ls := 0; ls := 0;
ai := 0; ai := 0;
bucketpos := 0; //bucketpos := 0;
by := 0;
for i := 0 to fcp.Height - 1 do begin for i := 0 to fcp.Height - 1 do begin
// if FStop then // if FStop then
// Break; // Break;
bx := 0;
Progress(i / fcp.Height); Progress(i / fcp.Height);
AlphaRow := PByteArray(FAlphaBitmap.scanline[YOffset + i]); AlphaRow := PByteArray(FAlphaBitmap.scanline[YOffset + i]);
Row := PRGBArray(FBitmap.scanline[YOffset + i]); Row := PRGBArray(FBitmap.scanline[YOffset + i]);
@ -466,23 +324,18 @@ begin
fp[1] := 0; fp[1] := 0;
fp[2] := 0; fp[2] := 0;
fp[3] := 0; fp[3] := 0;
ACount := 0;
for ii := 0 to FFilterSize - 1 do begin for ii := 0 to FFilterSize - 1 do begin
for jj := 0 to FFilterSize - 1 do begin for jj := 0 to FFilterSize - 1 do begin
filterValue := FFilter[ii, jj]; filterValue := FFilter[ii, jj];
filterpos := bucketpos + ii * FBucketWidth + jj;
ls := lsa[Min(1023, FBuckets[filterpos].Count)]; bucket := GetBucket(bx + jj, by + ii);
ls := lsa[Min(1023, bucket.Count)];
fp[0] := fp[0] + filterValue * ls * FBuckets[filterpos].Red; fp[0] := fp[0] + filterValue * ls * bucket.Red;
fp[1] := fp[1] + filterValue * ls * FBuckets[filterpos].Green; fp[1] := fp[1] + filterValue * ls * bucket.Green;
fp[2] := fp[2] + filterValue * ls * FBuckets[filterpos].Blue; fp[2] := fp[2] + filterValue * ls * bucket.Blue;
fp[3] := fp[3] + filterValue * ls * FBuckets[filterpos].Count; fp[3] := fp[3] + filterValue * ls * bucket.Count;
ACount := ACount + filterValue * FBuckets[filterpos].Count;
// RCount := RCount + filterValue * FBuckets[bucketpos].Red;
// GCount := GCount + filterValue * FBuckets[bucketpos].Green;
// BCount := BCount + filterValue * FBuckets[bucketpos].Blue;
end; end;
end; end;
@ -491,119 +344,136 @@ begin
fp[2] := fp[2] / PREFILTER_WHITE; fp[2] := fp[2] / PREFILTER_WHITE;
fp[3] := fcp.white_level * fp[3] / PREFILTER_WHITE; fp[3] := fcp.white_level * fp[3] / PREFILTER_WHITE;
end else begin end else begin
ls := lsa[Min(1023, FBuckets[bucketpos].count)] / PREFILTER_WHITE; bucket := GetBucket(bx, by);
ls := lsa[Min(1023, bucket.count)] / PREFILTER_WHITE;
fp[0] := ls * FBuckets[bucketpos].Red; fp[0] := ls * bucket.Red;
fp[1] := ls * FBuckets[bucketpos].Green; fp[1] := ls * bucket.Green;
fp[2] := ls * FBuckets[bucketpos].Blue; fp[2] := ls * bucket.Blue;
fp[3] := ls * FBuckets[bucketpos].Count * fcp.white_level; fp[3] := ls * bucket.Count * fcp.white_level;
ACount := FBuckets[bucketpos].Count;
RCount := FBuckets[bucketpos].Red;
GCount := FBuckets[bucketpos].Green;
BCount := FBuckets[bucketpos].Blue;
end; end;
Inc(bucketpos, FOversample); Inc(bx, FOversample);
if (fp[3] > 0.0) then begin if fcp.Transparency then begin // -------------------------- Transparency
if(divisor > 1E-12) then if (fp[3] > 0.0) then begin
alpha := power(ACount - densLow, Gamma) / divisor alpha := power(fp[3], gamma);
else ls := vib * alpha / fp[3];
alpha := 1; ai := round(alpha * 256);
if (ai <= 0) then goto zero_alpha // ignore all if alpha = 0
else if (ai > 255) then ai := 255;
//ia := 255 - ai;
end
else begin
zero_alpha:
Row[j] := zero_BG;
AlphaRow[j] := 0;
continue;
end;
// ls := vib * alpha; if (notvib > 0) then begin
ls := vib * power(fp[3], gamma) / fp[3]; ri := Round(ls * fp[0] + notvib * power(fp[0], gamma));
ai := round(alpha * 256); gi := Round(ls * fp[1] + notvib * power(fp[1], gamma));
if (ai < 0) then bi := Round(ls * fp[2] + notvib * power(fp[2], gamma));
ai := 0 end
else if (ai > 255) then else begin
ai := 255; ri := Round(ls * fp[0]);
ai := 255 - ai; gi := Round(ls * fp[1]);
end else begin bi := Round(ls * fp[2]);
// no intensity so simply set the BG; end;
Row[j] := bgtot;
AlphaRow[j] := 0;
continue;
end;
if (notvib > 0) then // ignoring BG color in transparent renders...
ri := Round(ls * fp[0] + notvib * power(fp[0], gamma))
else
ri := Round(ls * fp[0]);
ri := ri + (ai * bgi[0]) shr 8;
if (ri < 0) then
ri := 0
else if (ri > 255) then
ri := 255;
if (notvib > 0) then ri := (ri * 255) div ai; // ai > 0 !
gi := Round(ls * fp[1] + notvib * power(fp[1], gamma)) if (ri < 0) then ri := 0
else else if (ri > 255) then ri := 255;
gi := Round(ls * fp[1]);
gi := gi + (ai * bgi[1]) shr 8;
if (gi < 0) then
gi := 0
else if (gi > 255) then
gi := 255;
if (notvib > 0) then gi := (gi * 255) div ai;
bi := Round(ls * fp[2] + notvib * power(fp[2], gamma)) if (gi < 0) then gi := 0
else else if (gi > 255) then gi := 255;
bi := Round(ls * fp[2]);
bi := bi + (ai * bgi[2]) shr 8;
if (bi < 0) then
bi := 0
else if (bi > 255) then
bi := 255;
(*
ri := Round(RCount/ACount) + (ai * bgi[0]) shr 8; bi := (bi * 255) div ai;
if (ri < 0) then if (bi < 0) then bi := 0
ri := 0 else if (bi > 255) then bi := 255;
else if (ri > 255) then
ri := 255;
gi := Round(GCount/ACount) + (ai * bgi[1]) shr 8; Row[j].red := ri;
if (gi < 0) then Row[j].green := gi;
gi := 0 Row[j].blue := bi;
else if (gi > 255) then AlphaRow[j] := ai;
gi := 255; end
else begin // ------------------------------------------- No transparency
if (fp[3] > 0.0) then begin
alpha := power(fp[3], gamma);
ls := vib * alpha / fp[3];
ai := round(alpha * 256);
if (ai < 0) then ai := 0
else if (ai > 255) then ai := 255;
ia := 255 - ai;
end
else begin
// no intensity so simply set the BG;
Row[j] := bgtot;
continue;
end;
bi := Round(BCount/ACount) + (ai * bgi[2]) shr 8; if (notvib > 0) then begin
if (bi < 0) then ri := Round(ls * fp[0] + notvib * power(fp[0], gamma));
bi := 0 gi := Round(ls * fp[1] + notvib * power(fp[1], gamma));
else if (bi > 255) then bi := Round(ls * fp[2] + notvib * power(fp[2], gamma));
bi := 255; end
*) else begin
Row[j].red := ri; ri := Round(ls * fp[0]);
Row[j].green := gi; gi := Round(ls * fp[1]);
Row[j].blue := bi; bi := Round(ls * fp[2]);
end;
AlphaRow[j] := 255 - ai; ri := ri + (ia * bgi[0]) shr 8;
if (ri < 0) then ri := 0
else if (ri > 255) then ri := 255;
gi := gi + (ia * bgi[1]) shr 8;
if (gi < 0) then gi := 0
else if (gi > 255) then gi := 255;
bi := bi + (ia * bgi[2]) shr 8;
if (bi < 0) then bi := 0
else if (bi > 255) then bi := 255;
Row[j].red := ri;
Row[j].green := gi;
Row[j].blue := bi;
AlphaRow[j] := ai; //?
end
end; end;
Inc(bucketpos, gutter_width); //Inc(bucketpos, gutter_width);
Inc(bucketpos, (FOversample - 1) * FBucketWidth); //Inc(bucketpos, (FOversample - 1) * FBucketWidth);
Inc(by, FOversample);
end; end;
FBitmap.PixelFormat := pf24bit;
Progress(1); Progress(1);
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.SaveImage(const FileName: String); procedure TImageMaker.SaveImage(FileName: String);
var var
i,row: integer; i,row: integer;
PngObject: TPngObject; PngObject: TPngObject;
rowbm, rowpng: PByteArray; rowbm, rowpng: PByteArray;
JPEGImage: TJPEGImage; JPEGImage: TJPEGImage;
PNGerror: boolean;
label BMPhack;
begin begin
if UpperCase(ExtractFileExt(FileName)) = '.PNG' then begin if UpperCase(ExtractFileExt(FileName)) = '.PNG' then begin
pngError := false;
PngObject := TPngObject.Create; PngObject := TPngObject.Create;
PngObject.Assign(FBitmap); try
Case PNGTransparency of PngObject.Assign(FBitmap);
0: if fcp.Transparency then // PNGTransparency <> 0
; // do nothing
1,2:
begin begin
PngObject.CreateAlpha; PngObject.CreateAlpha;
for i:= 0 to FAlphaBitmap.Height - 1 do begin for i:= 0 to FAlphaBitmap.Height - 1 do begin
@ -614,12 +484,19 @@ begin
end; end;
end; end;
end; end;
else //else Exception.CreateFmt('Unexpected value of PNGTransparency [%d]', [PNGTransparency]);
Exception.CreateFmt('Unexpected value of PNGTransparency [%d]', [PNGTransparency]);
PngObject.SaveToFile(FileName);
except
pngError := true;
end;
PngObject.Free;
if pngError then begin
FileName := ChangeFileExt(FileName, '.bmp');
goto BMPHack;
end; end;
PngObject.SaveToFile(FileName);
PngObject.Free;
end else if UpperCase(ExtractFileExt(FileName)) = '.JPG' then begin end else if UpperCase(ExtractFileExt(FileName)) = '.JPG' then begin
JPEGImage := TJPEGImage.Create; JPEGImage := TJPEGImage.Create;
JPEGImage.Assign(FBitmap); JPEGImage.Assign(FBitmap);
@ -636,9 +513,14 @@ begin
// Free; // Free;
// end; // end;
end else begin // bitmap end else begin // bitmap
BMPHack:
FBitmap.SaveToFile(FileName); FBitmap.SaveToFile(FileName);
if fcp.Transparency then begin
FAlphaBitmap.Palette := CreatePalette(AlphaPalette.logpal);
FileName := ChangeFileExt(FileName, '_alpha.bmp');
FAlphaBitmap.SaveToFile(FileName);
end;
end; end;
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
@ -656,41 +538,115 @@ var
PngObject: TPngObject; PngObject: TPngObject;
rowbm, rowpng: PByteArray; rowbm, rowpng: PByteArray;
begin begin
if assigned(FTransparentImage) then if assigned(FTransparentImage) then FTransparentImage.Free;
FTransparentImage.Free;
FTransparentImage := TBitmap.Create; FTransparentImage := TBitmap.Create;
FTransparentImage.Width := Fcp.Width; FTransparentImage.Width := Fcp.Width;
FTransparentImage.Height := Fcp.Height; FTransparentImage.Height := Fcp.Height;
FTransparentImage.Canvas.Brush.Color := ClSilver; FTransparentImage.Canvas.Brush.Color := $CCCCCC;
FTransparentImage.Canvas.FillRect(Rect(0,0,Fcp.Width, Fcp.Height)); FTransparentImage.Canvas.FillRect(Rect(0, 0, Fcp.Width, Fcp.Height));
FTransparentImage.Canvas.Brush.Color := ClWhite; FTransparentImage.Canvas.Brush.Color := $FFFFFF;
for x := 0 to ((Fcp.Width - 1) div 20) do begin for x := 0 to ((Fcp.Width - 1) div 8) do begin
for y := 0 to ((Fcp.Height - 1) div 20) do begin for y := 0 to ((Fcp.Height - 1) div 8) do begin
if odd(x + y) then if odd(x + y) then
FTransparentImage.Canvas.FillRect(Rect(x * 20, y * 20, x * 20 + 20, y * 20 + 20)); FTransparentImage.Canvas.FillRect(Rect(x * 8, y * 8, x * 8 + 8, y * 8 + 8));
end; end;
end; end;
PngObject := TPngObject.Create; PngObject := TPngObject.Create;
PngObject.Assign(FBitmap); PngObject.Assign(FBitmap);
PngObject.CreateAlpha;
for i:= 0 to FAlphaBitmap.Height - 1 do begin if fcp.Transparency then begin
rowbm := PByteArray(FAlphaBitmap.scanline[i]); PngObject.CreateAlpha;
rowpng := PByteArray(PngObject.AlphaScanline[i]); for i:= 0 to FAlphaBitmap.Height - 1 do begin
for row := 0 to FAlphaBitmap.Width -1 do begin rowbm := PByteArray(FAlphaBitmap.scanline[i]);
rowpng[row] := rowbm[row]; rowpng := PByteArray(PngObject.AlphaScanline[i]);
for row := 0 to FAlphaBitmap.Width - 1 do begin
rowpng[row] := rowbm[row];
end;
end; end;
end; end;
PngObject.Draw(FTransparentImage.Canvas, Rect(0,0,Fcp.Width, Fcp.Height)); PngObject.Draw(FTransparentImage.Canvas, FTransparentImage.Canvas.ClipRect);
PngObject.Free; PngObject.Free;
Result := FTransparentImage; Result := FTransparentImage;
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
function TImageMaker.GetBucket64(x, y: integer): TBucket64;
begin
Result := FBuckets64[y][x];
end;
function TImageMaker.GetBucket32(x, y: integer): TBucket64;
begin
with FBuckets32[y][x] do begin
Result.Red := Red;
Result.Green := Green;
Result.Blue := Blue;
Result.Count := Count;
end;
end;
function TImageMaker.GetBucket32f(x, y: integer): TBucket64;
begin
with FBuckets32f[y][x] do begin
Result.Red := round(Red);
Result.Green := round(Green);
Result.Blue := round(Blue);
Result.Count := round(Count);
end;
end;
function TImageMaker.GetBucket48(x, y: integer): TBucket64;
begin
with FBuckets48[y][x] do begin
Result.Red := int64(rl) or ( int64(rh) shl 32 );
Result.Green := int64(gl) or ( int64(gh) shl 32 );
Result.Blue := int64(bl) or ( int64(bh) shl 32 );
Result.Count := int64(cl) or ( int64(ch) shl 32 );
end;
end;
function TImageMaker.SafeGetBucket(x, y: integer): TBucket64;
begin
if x < 0 then x := 0
else if x >= FBucketWidth then x := FBucketWidth-1;
if y < 0 then y := 0
else if y >= FBucketHeight then y := FBucketHeight-1;
Result := FGetBucket(x, y);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.GetBucketStats(var Stats: TBucketStats);
var
bucketpos: integer;
x, y: integer;
b: TBucket64;
begin
with Stats do begin
MaxR := 0;
MaxG := 0;
MaxB := 0;
MaxA := 0;
TotalA := 0;
for y := 0 to FBucketHeight - 1 do
for x := 0 to FBucketWidth - 1 do begin
b := FGetBucket(x, y);
MaxR := max(MaxR, b.Red);
MaxG := max(MaxG, b.Green);
MaxB := max(MaxB, b.Blue);
MaxA := max(MaxA, b.Count);
Inc(TotalA, b.Count);
end;
end;
end;
end. end.

4
2.10/Source/Main.dfm
View File

@ -1,6 +1,6 @@
object MainForm: TMainForm object MainForm: TMainForm
Left = 401 Left = 501
Top = 158 Top = 211
Width = 729 Width = 729
Height = 530 Height = 530
Caption = 'Apophysis' Caption = 'Apophysis'

62
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.04 beta 1.5'; AppVersionString = 'Apophysis 2.05 pre-release 11';
type type
TMouseMoveState = (msUsual, msZoomWindow, msZoomOutWindow, msZoomWindowMove, msZoomOutWindowMove, msDrag, msDragMove, msRotate, msRotateMove); TMouseMoveState = (msUsual, msZoomWindow, msZoomOutWindow, msZoomWindowMove, msZoomOutWindowMove, msDrag, msDragMove, msRotate, msRotateMove);
@ -1729,13 +1729,16 @@ begin
MainCp.sample_density := defSampleDensity; MainCp.sample_density := defSampleDensity;
Maincp.spatial_oversample := defOversample; Maincp.spatial_oversample := defOversample;
Maincp.spatial_filter_radius := defFilterRadius; Maincp.spatial_filter_radius := defFilterRadius;
MainCP.Transparency := (PNGTransparency <> 0) and ShowTransparency;
StartTime := Now; StartTime := Now;
Remainder := 1; Remainder := 1;
try try
Renderer := TRenderThread.Create; Renderer := TRenderThread.Create;
Renderer.TargetHandle := MainForm.Handle; Renderer.TargetHandle := MainForm.Handle;
Renderer.OnProgress := OnProgress; Renderer.OnProgress := OnProgress;
Renderer.Compatibility := Compatibility; // Renderer.Compatibility := Compatibility;
Renderer.SetCP(Maincp); Renderer.SetCP(Maincp);
Renderer.Resume; Renderer.Resume;
except except
@ -1745,8 +1748,6 @@ end;
{ ************************** IFS and triangle stuff ************************* } { ************************** IFS and triangle stuff ************************* }
{ ---Z--- moved to ControlPoint ---Z--- }
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
@ -2032,7 +2033,9 @@ var
rept, cby, smap, sol: string; rept, cby, smap, sol: string;
uprcenter: array[0..1] of double; // camera center uprcenter: array[0..1] of double; // camera center
Backcolor: longint; Backcolor: longint;
xf_str: string;
begin begin
cp1.Prepare;
uprcenter[0] := cp1.Center[0]; uprcenter[0] := cp1.Center[0];
uprcenter[1] := cp1.Center[1]; uprcenter[1] := cp1.Center[1];
cp1.Width := UPRWidth; cp1.Width := UPRWidth;
@ -2057,7 +2060,7 @@ begin
Strings.Add(' center=' + floatToStr(cp1.center[0]) + '/' + floatToStr(-cp1.center[1]) + Strings.Add(' center=' + floatToStr(cp1.center[0]) + '/' + floatToStr(-cp1.center[1]) +
' magn=' + FloatToStr(scale)); ' magn=' + FloatToStr(scale));
Strings.Add('formula:'); Strings.Add('formula:');
Strings.Add(' maxiter=100 filename="' + UPRFormulaFile + '" entry="' + UPRFormulaIdent + '"'); Strings.Add(' maxiter=1 filename="' + UPRFormulaFile + '" entry="' + UPRFormulaIdent + '"');
Strings.Add('inside:'); Strings.Add('inside:');
Strings.Add(' transfer=none'); Strings.Add(' transfer=none');
Strings.Add('outside:'); Strings.Add('outside:');
@ -2073,7 +2076,7 @@ begin
Strings.Add(' p_bk_color=' + IntToStr(Backcolor) + ' p_contrast=1' + Strings.Add(' p_bk_color=' + IntToStr(Backcolor) + ' p_contrast=1' +
' p_brightness=' + FloatToStr(cp1.Brightness) + ' p_gamma=' + FloatToStr(cp1.Gamma)); ' p_brightness=' + FloatToStr(cp1.Brightness) + ' p_gamma=' + FloatToStr(cp1.Gamma));
Strings.Add(' p_white_level=200 p_xforms=' + inttostr(Transforms)); Strings.Add(' p_white_level=200 p_xforms=' + inttostr(Transforms));
for m := 0 to Transforms - 1 do for m := 0 to Transforms do
begin begin
a := cp1.xform[m].c[0][0]; a := cp1.xform[m].c[0][0];
c := cp1.xform[m].c[0][1]; c := cp1.xform[m].c[0][1];
@ -2082,21 +2085,28 @@ begin
e := cp1.xform[m].c[2][0]; e := cp1.xform[m].c[2][0];
f := cp1.xform[m].c[2][1]; f := cp1.xform[m].c[2][1];
p := cp1.xform[m].Density; p := cp1.xform[m].Density;
Strings.Add(' p_xf' + inttostr(m) + '_p=' + Format('%.6g ', [p])); if m < Transforms then xf_str := 'p_xf' + inttostr(m)
Strings.Add(' p_xf' + inttostr(m) + '_c=' + floatTostr(cp1.xform[m].color)); else begin
Strings.Add(' p_xf' + inttostr(m) + '_sym=' + floatTostr(cp1.xform[m].symmetry)); if cp1.HasFinalXForm = false then break;
Strings.Add(' p_xf' + inttostr(m) + '_cfa=' + Format('%.6g ', [a]) + xf_str := 'p_finalxf';
'p_xf' + inttostr(m) + '_cfb=' + Format('%.6g ', [b]) + end;
'p_xf' + inttostr(m) + '_cfc=' + Format('%.6g ', [c]) + Strings.Add(' ' + xf_str + '_p=' + Format('%.6g ', [p]));
'p_xf' + inttostr(m) + '_cfd=' + Format('%.6g ', [d])); Strings.Add(' ' + xf_str + '_c=' + floatTostr(cp1.xform[m].color));
Strings.Add(' p_xf' + inttostr(m) + '_cfe=' + Format('%.6g ', [e]) + Strings.Add(' ' + xf_str + '_sym=' + floatTostr(cp1.xform[m].symmetry));
' p_xf' + inttostr(m) + '_cff=' + Format('%.6g ', [f])); Strings.Add(' ' + xf_str + '_cfa=' + Format('%.6g ', [a]) +
xf_str + '_cfb=' + Format('%.6g ', [b]) +
xf_str + '_cfc=' + Format('%.6g ', [c]) +
xf_str + '_cfd=' + Format('%.6g ', [d]));
Strings.Add(' ' + xf_str + '_cfe=' + Format('%.6g ', [e]) +
' ' + xf_str + '_cff=' + Format('%.6g ', [f]));
for i := 0 to NRVAR-1 do for i := 0 to NRVAR-1 do
Strings.Add(' p_xf' + inttostr(m) + '_var_' + VarNames(i) + '=' + if cp1.xform[m].vars[i] <> 0 then begin
floatToStr(cp1.xform[m].vars[i])); Strings.Add(' ' + xf_str + '_var_' + VarNames(i) + '=' +
for j:= 0 to GetNrVariableNames - 1 do begin floatToStr(cp1.xform[m].vars[i]));
cp1.xform[m].GetVariable(GetVariableNameAt(j), v); for j:= 0 to GetNrVariableNames - 1 do begin
Strings.Add(' p_xf' + inttostr(m) + '_par_' + GetVariableNameAt(j) + '=' + floatToStr(v)); cp1.xform[m].GetVariable(GetVariableNameAt(j), v);
Strings.Add(' ' + xf_str + '_par_' + GetVariableNameAt(j) + '=' + floatToStr(v));
end;
end; end;
end; end;
Strings.Add('gradient:'); Strings.Add('gradient:');
@ -3208,8 +3218,9 @@ begin
begin begin
if Assigned(RenderForm.Renderer) then RenderForm.Renderer.Terminate; if Assigned(RenderForm.Renderer) then RenderForm.Renderer.Terminate;
if Assigned(RenderForm.Renderer) then RenderForm.Renderer.WaitFor; ; if Assigned(RenderForm.Renderer) then RenderForm.Renderer.WaitFor; // hmm #1
RenderForm.ResetControls; RenderForm.ResetControls;
RenderForm.PageCtrl.TabIndex := 0;
case renderFileFormat of case renderFileFormat of
1: Ext := '.bmp'; 1: Ext := '.bmp';
@ -3227,7 +3238,7 @@ begin
RenderForm.zoom := maincp.zoom; RenderForm.zoom := maincp.zoom;
RenderForm.Center[0] := center[0]; RenderForm.Center[0] := center[0];
RenderForm.Center[1] := center[1]; RenderForm.Center[1] := center[1];
if Assigned(RenderForm.Renderer) then RenderForm.Renderer.WaitFor; if Assigned(RenderForm.Renderer) then RenderForm.Renderer.WaitFor; // hmm #2
end; end;
RenderForm.Show; RenderForm.Show;
end; end;
@ -3608,7 +3619,7 @@ begin
'or use the internal renderer.'); 'or use the internal renderer.');
end; end;
} }
if not FileExists(HqiPath) then if not FileExists(flam3Path) then
begin begin
Application.MessageBox('Renderer does not exist.', 'Apophysis', 16); Application.MessageBox('Renderer does not exist.', 'Apophysis', 16);
exit exit
@ -3686,10 +3697,7 @@ begin
FileList.Add(ExtractShortPathName(hqiPath) + ' < ' + ExtractShortPathName(ChangeFileExt(ExportDialog.Filename, '.flame'))); FileList.Add(ExtractShortPathName(hqiPath) + ' < ' + ExtractShortPathName(ChangeFileExt(ExportDialog.Filename, '.flame')));
Path := ExtractShortPathName(ExtractFileDir(ExportDialog.Filename) + '\'); Path := ExtractShortPathName(ExtractFileDir(ExportDialog.Filename) + '\');
} }
// short path names are confusing (for both user AND system) FileList.Add('"' + flam3Path + '" < "' + ChangeFileExt(ExportDialog.Filename, '.flame') + '"');
// (and they're quite ugly after all! :)
FileList.Add('"' + hqiPath + '" < "' + ChangeFileExt(ExportDialog.Filename, '.flame') + '"');
Path := ExtractFilePath(ExtractFileDir(ExportDialog.Filename) + '\'); Path := ExtractFilePath(ExtractFileDir(ExportDialog.Filename) + '\');
FileList.SaveToFile(Path + 'render.bat'); FileList.SaveToFile(Path + 'render.bat');

7
2.10/Source/Mutate.pas
View File

@ -21,7 +21,8 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ControlPoint, Render, ComCtrls, Menus, Buttons, Cmap; ExtCtrls, StdCtrls, ControlPoint, ComCtrls, Menus, Buttons, Cmap,
Render;
type type
TMutateForm = class(TForm) TMutateForm = class(TForm)
@ -178,7 +179,7 @@ begin
cps[0].zoom := zoom; cps[0].zoom := zoom;
cps[0].center[0] := center[0]; cps[0].center[0] := center[0];
cps[0].center[1] := center[1]; cps[0].center[1] := center[1];
Render.Compatibility := compatibility; // Render.Compatibility := compatibility;
Render.SetCP(cps[0]); Render.SetCP(cps[0]);
Render.Render; Render.Render;
BM.Assign(Render.GetImage); BM.Assign(Render.GetImage);
@ -230,7 +231,7 @@ begin
mutants[i].center[1] := center[1]; mutants[i].center[1] := center[1];
end; end;
Render.Compatibility := compatibility; // Render.Compatibility := compatibility;
Render.SetCP(mutants[i]); Render.SetCP(mutants[i]);
Render.Render; Render.Render;
BM.Assign(Render.GetImage); BM.Assign(Render.GetImage);

131
2.10/Source/Options.dfm
View File

@ -1,6 +1,6 @@
object OptionsForm: TOptionsForm object OptionsForm: TOptionsForm
Left = 540 Left = 675
Top = 274 Top = 365
BorderIcons = [biSystemMenu, biMinimize, biMaximize, biHelp] BorderIcons = [biSystemMenu, biMinimize, biMaximize, biHelp]
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'Options' Caption = 'Options'
@ -126,7 +126,7 @@ object OptionsForm: TOptionsForm
end end
object GroupBox15: TGroupBox object GroupBox15: TGroupBox
Left = 136 Left = 136
Top = 96 Top = 158
Width = 297 Width = 297
Height = 75 Height = 75
Caption = 'When render is finished' Caption = 'When render is finished'
@ -230,6 +230,102 @@ object OptionsForm: TOptionsForm
TabOrder = 1 TabOrder = 1
end end
end end
object GroupBox18: TGroupBox
Left = 8
Top = 176
Width = 121
Height = 57
Caption = 'Internal buffer depth'
TabOrder = 6
object cbInternalBitsPerSample: TComboBox
Left = 16
Top = 20
Width = 89
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 0
Items.Strings = (
'32-bit integer'
'32-bit float'
'48-bit integer'
'64-bit integer')
end
end
object GroupBox19: TGroupBox
Left = 136
Top = 56
Width = 201
Height = 97
Caption = 'Time limited previews'
TabOrder = 7
Visible = False
object Label45: TLabel
Left = 8
Top = 19
Width = 116
Height = 13
Caption = 'Fullscreen time limit (ms)'
end
object Label46: TLabel
Left = 8
Top = 43
Width = 106
Height = 13
Caption = 'Preview time limit (ms)'
end
object Label47: TLabel
Left = 8
Top = 67
Width = 116
Height = 13
Caption = 'Preview minimum quality'
end
object txtPreviewMinQ: TEdit
Left = 128
Top = 64
Width = 65
Height = 21
TabOrder = 0
Text = '0.2'
end
object cbPreviewTime: TComboBox
Left = 128
Top = 40
Width = 65
Height = 21
ItemHeight = 13
ItemIndex = 0
TabOrder = 1
Text = 'off'
Items.Strings = (
'off'
'25'
'50'
'100'
'200'
'500'
'1000')
end
object cbFullscrTime: TComboBox
Left = 128
Top = 16
Width = 65
Height = 21
ItemHeight = 13
TabOrder = 2
Text = 'off'
Items.Strings = (
'off'
'100'
'250'
'500'
'1000'
'2000'
'3000'
'5000')
end
end
end end
object EditorPage: TTabSheet object EditorPage: TTabSheet
Caption = 'Editor' Caption = 'Editor'
@ -532,7 +628,7 @@ object OptionsForm: TOptionsForm
end end
object chkShowTransparency: TCheckBox object chkShowTransparency: TCheckBox
Left = 192 Left = 192
Top = 179 Top = 155
Width = 129 Width = 129
Height = 17 Height = 17
Caption = 'Show Transparency' Caption = 'Show Transparency'
@ -542,13 +638,12 @@ object OptionsForm: TOptionsForm
Left = 184 Left = 184
Top = 104 Top = 104
Width = 193 Width = 193
Height = 69 Height = 49
Caption = 'PNG Transparency' Caption = 'PNG Transparency'
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
'No transparency' 'Disabled'
'Flam3-style' 'Enabled')
'Flamesong-style')
TabOrder = 3 TabOrder = 3
end end
end end
@ -618,11 +713,20 @@ object OptionsForm: TOptionsForm
TabOrder = 3 TabOrder = 3
end end
end end
object chkKeepBackground: TCheckBox
Left = 208
Top = 170
Width = 161
Height = 17
HelpContext = 1023
Caption = 'Keep background color'
TabOrder = 4
end
object gpFlameTitlePrefix: TGroupBox object gpFlameTitlePrefix: TGroupBox
Left = 208 Left = 208
Top = 88 Top = 88
Width = 193 Width = 193
Height = 97 Height = 81
Caption = 'Random batch' Caption = 'Random batch'
TabOrder = 1 TabOrder = 1
object Label38: TLabel object Label38: TLabel
@ -825,15 +929,6 @@ object OptionsForm: TOptionsForm
Thousands = False Thousands = False
end end
end end
object chkKeepBackground: TCheckBox
Left = 216
Top = 160
Width = 137
Height = 22
HelpContext = 1023
Caption = 'Keep background color'
TabOrder = 4
end
end end
object VariationsPage: TTabSheet object VariationsPage: TTabSheet
Caption = 'Variations' Caption = 'Variations'

31
2.10/Source/Options.pas
View File

@ -202,10 +202,19 @@ type
pnlHelpersColor: TPanel; pnlHelpersColor: TPanel;
rgReferenceMode: TRadioGroup; rgReferenceMode: TRadioGroup;
chkExtendedEdit: TCheckBox; chkExtendedEdit: TCheckBox;
chkAxisLock: TCheckBox;
chkPlaysound: TCheckBox; chkPlaysound: TCheckBox;
btnPlay: TSpeedButton; btnPlay: TSpeedButton;
Label44: TLabel; Label44: TLabel;
chkAxisLock: TCheckBox; GroupBox18: TGroupBox;
cbInternalBitsPerSample: TComboBox;
GroupBox19: TGroupBox;
Label45: TLabel;
Label46: TLabel;
txtPreviewMinQ: TEdit;
Label47: TLabel;
cbPreviewTime: TComboBox;
cbFullscrTime: TComboBox;
procedure btnCancelClick(Sender: TObject); procedure btnCancelClick(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject); procedure btnOKClick(Sender: TObject);
@ -302,6 +311,14 @@ begin
chkPlaySound.Checked := PlaySoundOnRenderComplete; chkPlaySound.Checked := PlaySoundOnRenderComplete;
txtSoundFile.Text := RenderCompleteSoundFile; txtSoundFile.Text := RenderCompleteSoundFile;
cbInternalBitsPerSample.ItemIndex := InternalBitsPerSample;
if PreviewTimeLimit = 0 then cbPreviewTime.ItemIndex := 0
else cbPreviewTime.Text := IntToStr(PreviewTimeLimit);
if FullscreenTimeLimit = 0 then cbFullscrTime.ItemIndex := 0
else cbFullscrTime.Text := IntToStr(FullscreenTimeLimit);
txtPreviewMinQ.Text := FloatToStr(PreviewMinDensity);
{ Display tab } { Display tab }
txtSampleDensity.Text := FloatToStr(defSampleDensity); txtSampleDensity.Text := FloatToStr(defSampleDensity);
txtGamma.Text := FloatToStr(defGamma); txtGamma.Text := FloatToStr(defGamma);
@ -366,7 +383,7 @@ begin
txtNick.Text := SheepNick; txtNick.Text := SheepNick;
txtURL.Text := SheepURL; txtURL.Text := SheepURL;
txtPassword.Text := SheepPW; txtPassword.Text := SheepPW;
txtRenderer.Text := HqiPath; txtRenderer.Text := flam3Path;
txtServer.Text := SheepServer; txtServer.Text := SheepServer;
txtLibrary.text := defLibrary; txtLibrary.text := defLibrary;
@ -413,6 +430,12 @@ begin
MainForm_RotationMode := rgRotationMode.ItemIndex; MainForm_RotationMode := rgRotationMode.ItemIndex;
ResizeOnLoad := chkResize.checked; ResizeOnLoad := chkResize.checked;
InternalBitsPerSample := cbInternalBitsPerSample.ItemIndex;
PreviewTimeLimit := StrToIntDef(cbPreviewTime.Text, 0);
FullscreenTimeLimit := StrToIntDef(cbFullscrTime.Text, 0);
PreviewMinDensity := StrToFloatDef(txtPreviewMinQ.Text, 0.2);
// Editor // Editor
ReferenceMode := rgReferenceMode.ItemIndex; ReferenceMode := rgReferenceMode.ItemIndex;
ExtEditEnabled := chkExtendedEdit.Checked; ExtEditEnabled := chkExtendedEdit.Checked;
@ -481,7 +504,7 @@ begin
SheepNick := txtNick.Text; SheepNick := txtNick.Text;
SheepURL := txtURL.Text; SheepURL := txtURL.Text;
SheepPW := txtPassword.text; SheepPW := txtPassword.text;
HqiPath := txtRenderer.text; flam3Path := txtRenderer.text;
SheepServer := txtServer.text; SheepServer := txtServer.text;
{Paths} {Paths}
@ -639,7 +662,7 @@ end;
procedure TOptionsForm.btnRendererClick(Sender: TObject); procedure TOptionsForm.btnRendererClick(Sender: TObject);
begin begin
OpenDialog.Filter := 'Executables (*.exe)|*.exe'; OpenDialog.Filter := 'Executables (*.exe)|*.exe';
OpenDialog.InitialDir := ExtractFilePath(HqiPath); OpenDialog.InitialDir := ExtractFilePath(flam3Path);
OpenDialog.FileName := ''; OpenDialog.FileName := '';
if OpenDialog.Execute then if OpenDialog.Execute then
begin begin

2
2.10/Source/Preview.pas
View File

@ -53,7 +53,7 @@ begin
// ScriptEditor.GetCpFromFlame(cp); // ScriptEditor.GetCpFromFlame(cp);
cp.width := Image.width; cp.width := Image.width;
cp.Height := Image.Height; cp.Height := Image.Height;
Render.Compatibility := Compatibility; // Render.Compatibility := Compatibility;
Render.SetCP(cp); Render.SetCP(cp);
Render.Render; Render.Render;
Image.Picture.Bitmap.Assign(Render.GetImage); Image.Picture.Bitmap.Assign(Render.GetImage);

53
2.10/Source/Regstry.pas
View File

@ -476,11 +476,11 @@ begin
end; end;
if Registry.ValueExists('Renderer') then if Registry.ValueExists('Renderer') then
begin begin
HQIPath := Registry.ReadString('Renderer'); flam3Path := Registry.ReadString('Renderer');
end end
else else
begin begin
HQIPath := DefaultPath + 'flam3.exe'; flam3Path := DefaultPath + 'flam3.exe';
end; end;
if Registry.ValueExists('Server') then if Registry.ValueExists('Server') then
begin begin
@ -506,6 +506,9 @@ begin
end; end;
if Registry.ValueExists('PNGTransparency') then begin if Registry.ValueExists('PNGTransparency') then begin
PNGTransparency := Registry.ReadInteger('PNGTransparency'); PNGTransparency := Registry.ReadInteger('PNGTransparency');
if PNGTransparency > 1 then PNGTransparency := 1;
end else begin end else begin
PNGTransparency := 1 PNGTransparency := 1
end; end;
@ -524,6 +527,25 @@ begin
end else begin end else begin
UseNrThreads := 1; UseNrThreads := 1;
end; end;
if Registry.ValueExists('InternalBitsPerSample') then begin
InternalBitsPerSample := Registry.ReadInteger('InternalBitsPerSample');
end else begin
InternalBitsPerSample := 0;
end;
// if Registry.ValueExists('PreviewTimeLimit') then
// PreviewTimeLimit := Registry.ReadInteger('PreviewTimeLimit')
// else
PreviewTimeLimit := 0;
// if Registry.ValueExists('FullscreenTimeLimit') then
// FullscreenTimeLimit := Registry.ReadInteger('FullscreenTimeLimit')
// else
FullscreenTimeLimit := 0;
// if Registry.ValueExists('PreviewMinDensity') then
// PreviewMinDensity := Registry.ReadFloat('PreviewMinDensity')
// else
PreviewMinDensity := 0.0;
end end
else else
begin begin
@ -579,14 +601,18 @@ begin
SheepNick := ''; SheepNick := '';
SheepURL := ''; SheepURL := '';
SheepPW := ''; SheepPW := '';
HQIPath := DefaultPath + 'flam3.exe'; flam3Path := DefaultPath + 'flam3.exe';
SheepServer := 'http://v2d5.sheepserver.net/'; SheepServer := 'http://v2d5.sheepserver.net/';
ResizeOnLoad := False; ResizeOnLoad := False;
ShowProgress := true; ShowProgress := true;
PNGTransparency := 2; PNGTransparency := 1;
ShowTransparency := False; ShowTransparency := False;
NrTreads := 1; NrTreads := 1;
UseNrThreads := 1; UseNrThreads := 1;
InternalBitsPerSample := 0;
PreviewTimeLimit := 0;
FullscreenTimeLimit := 0;
PreviewMinDensity := 0.2;
end; end;
Registry.CloseKey; Registry.CloseKey;
@ -643,6 +669,8 @@ begin
GridColor2 := $333333; GridColor2 := $333333;
HelpersColor := $808080; HelpersColor := $808080;
ReferenceTriangleColor := integer(clGray); ReferenceTriangleColor := integer(clGray);
ExtEditEnabled := true;
TransformAxisLock := true;
end; end;
Registry.CloseKey; Registry.CloseKey;
@ -713,6 +741,14 @@ begin
begin begin
renderFileFormat := 3; renderFileFormat := 3;
end; end;
if Registry.ValueExists('BitsPerSample') then
begin
renderBitsPerSample := Registry.ReadInteger('BitsPerSample');
end
else
begin
renderBitsPerSample := 0;
end;
end end
else else
begin begin
@ -724,6 +760,7 @@ begin
renderFilterRadius := 0.4; renderFilterRadius := 0.4;
renderWidth := 1024; renderWidth := 1024;
renderHeight := 768; renderHeight := 768;
renderBitsPerSample := 0;
end; end;
Registry.CloseKey; Registry.CloseKey;
@ -979,7 +1016,7 @@ begin
Registry.WriteInteger('ExportBatches', ExportBatches); Registry.WriteInteger('ExportBatches', ExportBatches);
Registry.WriteString('Nick', SheepNick); Registry.WriteString('Nick', SheepNick);
Registry.WriteString('URL', SheepURL); Registry.WriteString('URL', SheepURL);
Registry.WriteString('Renderer', HqiPath); Registry.WriteString('Renderer', flam3Path);
Registry.WriteString('Server', SheepServer); Registry.WriteString('Server', SheepServer);
Registry.WriteString('Pass', SheepPW); Registry.WriteString('Pass', SheepPW);
Registry.WriteBool('ResizeOnLoad', ResizeOnLoad); Registry.WriteBool('ResizeOnLoad', ResizeOnLoad);
@ -991,6 +1028,11 @@ begin
Registry.WriteInteger('PNGTransparency', PNGTransparency); Registry.WriteInteger('PNGTransparency', PNGTransparency);
Registry.WriteInteger('NrTreads', NrTreads); Registry.WriteInteger('NrTreads', NrTreads);
Registry.WriteInteger('UseNrThreads', UseNrThreads); Registry.WriteInteger('UseNrThreads', UseNrThreads);
Registry.WriteInteger('InternalBitsPerSample', InternalBitsPerSample);
Registry.WriteInteger('PreviewTimeLimit', PreviewTimeLimit);
Registry.WriteInteger('FullscreenTimeLimit', FullscreenTimeLimit);
Registry.WriteFloat('PreviewMinDensity', PreviewMinDensity);
end; end;
{ Editor } { Editor }
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Editor', True) then if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Editor', True) then
@ -1040,6 +1082,7 @@ begin
Registry.WriteInteger('Height', renderHeight); Registry.WriteInteger('Height', renderHeight);
Registry.WriteInteger('JPEGQuality', JPEGQuality); Registry.WriteInteger('JPEGQuality', JPEGQuality);
Registry.WriteInteger('FileFormat', renderFileFormat); Registry.WriteInteger('FileFormat', renderFileFormat);
Registry.WriteInteger('BitsPerSample', renderBitsPerSample);
end; end;
finally finally
Registry.Free; Registry.Free;

705
2.10/Source/Render.pas
View File

@ -1,7 +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 Borys, Peter Sdobnov Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, 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
@ -22,78 +22,124 @@ unit Render;
interface interface
uses uses
Windows, Graphics, Windows, Graphics, Classes,
Controlpoint; Controlpoint, RenderTypes, ImageMaker;
type ///////////////////////////////////////////////////////////////////////////////
TOnProgress = procedure(prog: double) of object; //
// { TBaseRenderer }
type //
TColorMapColor = Record ///////////////////////////////////////////////////////////////////////////////
Red,
Green,
Blue: integer; //Int64;
// Count: Int64;
end;
PColorMapColor = ^TColorMapColor;
TColorMapArray = array[0..255] of TColorMapColor;
TBucket = Record
Red,
Green,
Blue,
Count: Int64;
end;
PBucket = ^TBucket;
TBucketArray = array of TBucket;
PBucketArray = ^PBucketArray;
type type
TBaseRenderer = class TBaseRenderer = class
private private
FOnProgress: TOnProgress; FOnProgress: TOnProgress;
procedure SetOnProgress(const Value: TOnProgress);
protected protected
FMaxMem: integer; camX0, camX1, camY0, camY1, // camera bounds
FCompatibility: integer; camW, camH, // camera sizes
FStop: boolean; bws, bhs, cosa, sina, rcX, rcY: double;
ppux, ppuy: extended;
BucketWidth, BucketHeight: int64;
BucketSize: int64;
sample_density: extended;
oversample: integer;
gutter_width: Integer;
max_gutter_width: Integer;
FCP: TControlPoint; FCP: TControlPoint;
FStop: integer;//boolean;
FImageMaker: TImageMaker;
strOutput: TStrings;
ColorMap: TColorMapArray;
FMaxMem: integer;
FSlice, FNumSlices: integer;
image_Width, image_Height: Int64;
image_Center_X, image_Center_Y: double;
FCompatibility: integer;
FNumThreads: integer;
FNumBatches: integer;//int64;
FMinDensity: double;
FMinBatches: integer;
FRenderOver: boolean;
RenderTime: TDateTime;
procedure Progress(value: double); procedure Progress(value: double);
function GetSlice: integer; virtual; procedure SetNumThreads(const n: integer);
function GetNrSlices: integer; virtual; procedure SetMinDensity(const q: double);
procedure CreateColorMap; virtual;
procedure CreateCamera;
procedure CreateCameraMM;
procedure Prepare; virtual; abstract;
procedure SetPixels; virtual; abstract;
procedure CalcBufferSize; virtual;
procedure CalcBufferSizeMM;
function GetBits: integer; virtual; abstract;
function GetBucketsPtr: pointer; virtual; abstract;
procedure InitBuffers;
procedure AllocateBuckets; virtual; abstract;
procedure ClearBuckets; virtual; abstract;
procedure RenderMM;
public public
constructor Create; virtual; constructor Create; virtual;
destructor Destroy; override; destructor Destroy; override;
procedure SetCP(CP: TControlPoint); procedure SetCP(CP: TControlPoint);
procedure Render; virtual; abstract; procedure Render; virtual;
function GetImage: TBitmap; virtual; abstract; function GetImage: TBitmap; virtual;
procedure UpdateImage(CP: TControlPoint); virtual; procedure UpdateImage(CP: TControlPoint);
procedure SaveImage(const FileName: String); virtual; procedure SaveImage(const FileName: String);
procedure Stop; virtual; procedure Stop; virtual;
procedure Pause(paused: boolean); virtual; procedure Break; virtual;
procedure Pause; virtual; abstract;
procedure UnPause; virtual; abstract;
procedure GetBucketStats(var Stats: TBucketStats);
property OnProgress: TOnProgress property OnProgress: TOnProgress
read FOnProgress read FOnProgress
write SetOnProgress; write FOnProgress;
property compatibility : integer
read Fcompatibility
write Fcompatibility;
property MaxMem : integer property MaxMem : integer
read FMaxMem read FMaxMem
write FMaxMem; write FMaxMem;
property NrSlices: integer property NrSlices: integer
read GetNrSlices; read FNumSlices;
property Slice: integer property Slice: integer
read GetSlice; read FSlice;
property Failed: boolean // hmm... property NumThreads: integer
read FStop; read FNumThreads
write SetNumThreads;
property Output: TStrings
write strOutput;
property MinDensity: double
write SetMinDensity;
property RenderMore: boolean
write FRenderOver;
end; end;
///////////////////////////////////////////////////////////////////////////////
{ TRenderer }
///////////////////////////////////////////////////////////////////////////////
type type
TRenderer = class TRenderer = class
private private
@ -101,52 +147,438 @@ type
FOnProgress: TOnProgress; FOnProgress: TOnProgress;
FCP: TControlPoint; FCP: TControlPoint;
Fcompatibility: Integer;
FMaxMem: int64; FMaxMem: int64;
function GetNrSlices: integer;
function GetSlice: integer;
procedure Setcompatibility(const Value: Integer);
procedure SetMaxMem(const Value: int64);
public
constructor Create; public
destructor Destroy; override; destructor Destroy; override;
procedure SetCP(CP: TControlPoint); procedure SetCP(CP: TControlPoint);
procedure Render; procedure Render;
procedure RenderMaxMem(MaxMem: Int64);
function GetBucketSize: integer; virtual; abstract;
function GetImage: TBitmap; function GetImage: TBitmap;
procedure UpdateImage(CP: TControlPoint);
procedure SaveImage(const FileName: String);
procedure Stop; procedure Stop;
property OnProgress: TOnProgress property OnProgress: TOnProgress
read FOnProgress read FOnProgress
write FOnProgress; write FOnProgress;
property Slice: integer
read GetSlice;
property NrSlices: integer
read GetNrSlices;
property MaxMem: int64
read FMaxMem
write SetMaxMem;
property compatibility: Integer
read Fcompatibility
write Setcompatibility;
end; end;
implementation implementation
uses uses
Math, Sysutils, Render64, RenderMM; Math, SysUtils, Forms,
Render32;
{ TRenderThread }
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
//
// { TBaseRenderer }
//
///////////////////////////////////////////////////////////////////////////////
constructor TBaseRenderer.Create;
begin
inherited Create;
FNumSlices := 1;
FSlice := 0;
FStop := 0; // False;
FImageMaker := TImageMaker.Create;
end;
///////////////////////////////////////////////////////////////////////////////
destructor TBaseRenderer.Destroy;
begin
FImageMaker.Free;
if assigned(FCP) then
FCP.Free;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SetCP(CP: TControlPoint);
begin
if assigned(FCP) then
FCP.Free;
FCP := Cp.Clone;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.Stop;
begin
FStop := 1; //True;
end;
procedure TBaseRenderer.Break;
begin
FStop := -1;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.Progress(value: double);
begin
if assigned(FOnprogress) then
FOnprogress(Value);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SetNumThreads(const n: integer);
begin
FNumThreads := n;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SetMinDensity(const q: double);
begin
if q < fcp.sample_density then FMinDensity := q
else FMinDensity := fcp.sample_density;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.GetBucketStats(var Stats: TBucketStats);
begin
FImageMaker.GetBucketStats(Stats);
Stats.TotalSamples := int64(FNumBatches) * SUB_BATCH_SIZE; // * fcp.nbatches ?
Stats.RenderTime := RenderTime;
end;
///////////////////////////////////////////////////////////////////////////////
function TBaseRenderer.GetImage: TBitmap;
begin
if FStop <> 0 then begin
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
Result := FImageMaker.GetImage;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.UpdateImage(CP: TControlPoint);
begin
FCP.background := cp.background;
FCP.spatial_filter_radius := cp.spatial_filter_radius;
FCP.gamma := cp.Gamma;
FCP.vibrancy := cp.vibrancy;
FCP.contrast := cp.contrast;
FCP.brightness := cp.brightness;
FImageMaker.SetCP(FCP);
FImageMaker.Init;
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SaveImage(const FileName: String);
begin
if FStop <> 0 then begin
if Assigned(strOutput) then
strOutput.Add(TimeToStr(Now) + Format(' : Creating image with quality = %f', [fcp.actual_density]));
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
if Assigned(strOutput) then
strOutput.Add(TimeToStr(Now) + ' : Saving image');
FImageMaker.SaveImage(FileName);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.CreateColorMap;
var
i: integer;
begin
for i := 0 to 255 do
with ColorMap[i] do begin
Red := (fcp.CMap[i][0] * fcp.white_level) div 256;
Green := (fcp.CMap[i][1] * fcp.white_level) div 256;
Blue := (fcp.CMap[i][2] * fcp.white_level) div 256;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.CreateCamera;
var
scale: double;
t0, t1: double;
t2, t3: double;
corner_x, corner_y, Xsize, Ysize: double;
shift: Integer;
begin
scale := power(2, fcp.zoom);
sample_density := fcp.sample_density * scale * scale;
ppux := fcp.pixels_per_unit * scale;
ppuy := fcp.pixels_per_unit * scale;
// todo field stuff
shift := 0;
corner_x := fcp.center[0] - fcp.Width / ppux / 2.0;
corner_y := fcp.center[1] - fcp.Height / ppuy / 2.0;
t0 := gutter_width / (oversample * ppux);
t1 := gutter_width / (oversample * ppuy);
t2 := (2 * max_gutter_width - gutter_width) / (oversample * ppux);
t3 := (2 * max_gutter_width - gutter_width) / (oversample * ppuy);
camX0 := corner_x - t0;
camY0 := corner_y - t1 + shift;
camX1 := corner_x + fcp.Width / ppux + t2;
camY1 := corner_y + fcp.Height / ppuy + t3; //+ shift;
camW := camX1 - camX0;
if abs(camW) > 0.01 then
Xsize := 1.0 / camW
else
Xsize := 1;
camH := camY1 - camY0;
if abs(camH) > 0.01 then
Ysize := 1.0 / camH
else
Ysize := 1;
bws := (BucketWidth - 0.5) * Xsize;
bhs := (BucketHeight - 0.5) * Ysize;
if FCP.FAngle <> 0 then
begin
cosa := cos(FCP.FAngle);
sina := sin(FCP.FAngle);
rcX := FCP.Center[0]*(1 - cosa) - FCP.Center[1]*sina - camX0;
rcY := FCP.Center[1]*(1 - cosa) + FCP.Center[0]*sina - camY0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.CreateCameraMM;
var
scale: double;
t0, t1: double;
corner_x, corner_y, Xsize, Ysize: double;
shift: Integer;
begin
scale := power(2, fcp.zoom);
sample_density := fcp.sample_density * scale * scale;
ppux := fcp.pixels_per_unit * scale;
ppuy := fcp.pixels_per_unit * scale;
// todo field stuff
shift := 0;
t0 := gutter_width / (oversample * ppux);
t1 := gutter_width / (oversample * ppuy);
corner_x := fcp.center[0] - image_width / ppux / 2.0;
corner_y := fcp.center[1] - image_height / ppuy / 2.0;
camX0 := corner_x - t0;
camY0 := corner_y - t1 + shift;
camX1 := corner_x + image_width / ppux + t0;
camY1 := corner_y + image_height / ppuy + t1; //+ shift;
camW := camX1 - camX0;
if abs(camW) > 0.01 then
Xsize := 1.0 / camW
else
Xsize := 1;
camH := camY1 - camY0;
if abs(camH) > 0.01 then
Ysize := 1.0 / camH
else
Ysize := 1;
bws := (BucketWidth - 0.5) * Xsize;
bhs := (BucketHeight - 0.5) * Ysize;
if FCP.FAngle <> 0 then
begin
cosa := cos(FCP.FAngle);
sina := sin(FCP.FAngle);
rcX := image_Center_X*(1 - cosa) - image_Center_Y*sina - camX0;
rcY := image_Center_Y*(1 - cosa) + image_Center_X*sina - camY0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.CalcBufferSize;
begin
oversample := fcp.spatial_oversample;
max_gutter_width := (MAX_FILTER_WIDTH - oversample) div 2;
gutter_width := (FImageMaker.GetFilterSize - oversample) div 2;
BucketWidth := oversample * fcp.Width + 2 * max_gutter_width;
BucketHeight := oversample * fcp.Height + 2 * max_gutter_width;
BucketSize := BucketWidth * BucketHeight;
end;
procedure TBaseRenderer.CalcBufferSizeMM;
begin
oversample := fcp.spatial_oversample;
gutter_width := (FImageMaker.GetFilterSize - oversample) div 2;
BucketHeight := oversample * image_height + 2 * gutter_width;
Bucketwidth := oversample * image_width + 2 * gutter_width;
BucketSize := BucketWidth * BucketHeight;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.InitBuffers;
var
w, h, bits: integer;
begin
bits := GetBits;
w := BucketWidth;
h := BucketHeight;
CalcBufferSize;
try
if Assigned(strOutput) then
strOutput.Add(TimeToStr(Now) +
Format(' : Allocating %n Mb of memory', [BucketSize * SizeOfBucket[bits] / 1048576]));
AllocateBuckets; // SetLength(buckets, BucketHeight, BucketWidth); // hmm :-/
except
on EOutOfMemory do begin
if Assigned(strOutput) then
strOutput.Add('Error: not enough memory for this render!')
else
Application.MessageBox('Error: not enough memory for this render!', 'Apophysis', 48);
BucketWidth := 0;
BucketHeight := 0;
FStop := 1; //true;
exit;
end;
end;
// share the buffer with imagemaker
FImageMaker.SetBucketData(GetBucketsPtr, BucketWidth, BucketHeight, bits);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.Render;
begin
if fcp.NumXForms <= 0 then exit;
FStop := 0; //False;
FImageMaker.SetCP(FCP);
FImageMaker.Init;
InitBuffers;
if FStop <> 0 then exit; // memory allocation error?
CreateColorMap;
Prepare;
CreateCamera;
if not FRenderOver then ClearBuckets;
RenderTime := Now;
SetPixels;
RenderTime := Now - RenderTime;
if FStop >= 0 then begin
if Assigned(strOutput) then begin
if fcp.sample_density = fcp.actual_density then
strOutput.Add(TimeToStr(Now) + ' : Creating image')
else
strOutput.Add(TimeToStr(Now) + Format(' : Creating image with quality = %f', [fcp.actual_density]));
end;
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.RenderMM;
const
Dividers: array[0..15] of integer = (1, 2, 3, 4, 5, 6, 7, 8, 10, 16, 20, 32, 64, 128, 256, 512);
var
ApproxMemory, MaxMemory: int64;
i: integer;
zoom_scale, center_base, center_y: double;
t: TDateTime;
begin
FStop := 0; //False;
image_Center_X := fcp.center[0];
image_Center_Y := fcp.center[1];
image_Height := fcp.Height;
image_Width := fcp.Width;
oversample := fcp.spatial_oversample;
// entered memory - imagesize
MaxMemory := FMaxMem * 1024 * 1024 - 4 * image_Height * int64(image_Width);
ApproxMemory := SizeOfBucket[GetBits] * sqr(oversample) * image_Height * int64(image_Width);
assert(MaxMemory > 0);
if MaxMemory <= 0 then exit;
FNumSlices := 1 + ApproxMemory div MaxMemory;
if FNumSlices > Dividers[High(Dividers)] then begin
for i := High(Dividers) downto 0 do begin
if image_height <> (image_height div dividers[i]) * dividers[i] then begin
FNumSlices := dividers[i];
break;
end;
end;
end else begin
for i := 0 to High(Dividers) do begin
if image_height <> (image_height div dividers[i]) * dividers[i] then
continue;
if FNumSlices <= dividers[i] then begin
FNumSlices := dividers[i];
break;
end;
end;
end;
FImageMaker.SetCP(FCP);
FImageMaker.Init;
fcp.height := fcp.height div FNumSlices;
center_y := fcp.center[1];
zoom_scale := power(2.0, fcp.zoom);
center_base := center_y - ((FNumSlices - 1) * fcp.height) / (2 * fcp.pixels_per_unit * zoom_scale);
image_height := fcp.Height;
image_Width := fcp.Width;
InitBuffers;
CreateColorMap;
Prepare;
RenderTime := 0;
for i := 0 to FNumSlices - 1 do begin
if FStop <> 0 then Exit;
FSlice := i;
fcp.center[1] := center_base + fcp.height * slice / (fcp.pixels_per_unit * zoom_scale);
CreateCameraMM;
ClearBuckets;
t := Now;
SetPixels;
RenderTime := RenderTime + (Now - t);
if FStop = 0 then begin
if Assigned(strOutput) then strOutput.Add(TimeToStr(Now) + ' : Creating image');
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage(Slice * fcp.height);
end;
end;
fcp.height := fcp.height * FNumSlices;
end;
///////////////////////////////////////////////////////////////////////////////
//
// { TRenderer }
//
///////////////////////////////////////////////////////////////////////////////
destructor TRenderer.Destroy; destructor TRenderer.Destroy;
begin begin
if assigned(FRenderer) then if assigned(FRenderer) then
@ -169,10 +601,12 @@ begin
FCP := CP; FCP := CP;
end; end;
{
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
constructor TRenderer.Create; constructor TRenderer.Create;
begin begin
end; end;
}
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.Render; procedure TRenderer.Render;
@ -180,154 +614,45 @@ begin
if assigned(FRenderer) then if assigned(FRenderer) then
FRenderer.Free; FRenderer.Free;
if MaxMem = 0 then begin assert(Fmaxmem=0);
FRenderer := TRenderer64.Create; if FMaxMem = 0 then begin
FRenderer := TRenderer32.Create;
end else begin end else begin
FRenderer := TRendererMM64.Create; FRenderer := TRenderer32MM.Create;
FRenderer.MaxMem := MaxMem FRenderer.MaxMem := FMaxMem
end; end;
FRenderer.SetCP(FCP); FRenderer.SetCP(FCP);
FRenderer.compatibility := compatibility; // FRenderer.compatibility := compatibility;
FRenderer.OnProgress := FOnProgress; FRenderer.OnProgress := FOnProgress;
Frenderer.Render; FRenderer.Render;
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.Stop; procedure TRenderer.Stop;
begin begin
if assigned(FRenderer) then if assigned(FRenderer) then
FRenderer.Stop; FRenderer.Stop;
end; end;
/////////////////////////////////////////////////////////////////////////////// {
function TRenderer.GetNrSlices: integer;
begin
if assigned(FRenderer) then
Result := FRenderer.Nrslices
else
Result := 1;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderer.GetSlice: integer;
begin
if assigned(FRenderer) then
Result := FRenderer.Slice
else
Result := 1;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.Setcompatibility(const Value: Integer);
begin
Fcompatibility := Value;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.SetMaxMem(const Value: int64);
begin
FMaxMem := Value;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.RenderMaxMem(MaxMem: Int64);
begin
FMaxMem := MaxMem;
Render;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.UpdateImage(CP: TControlPoint); procedure TRenderer.UpdateImage(CP: TControlPoint);
begin begin
end; end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.SaveImage(const FileName: String); procedure TRenderer.SaveImage(const FileName: String);
begin begin
if assigned(FRenderer) then if assigned(FRenderer) then
FRenderer.SaveImage(FileName); FRenderer.SaveImage(FileName);
end; end;
procedure TRenderer.GetBucketStats(var Stats: TBucketStats);
{ TBaseRenderer }
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SetOnProgress(const Value: TOnProgress);
begin begin
FOnProgress := Value; if assigned(FRenderer) then
FRenderer.GetBucketStats(Stats);
end; end;
}
///////////////////////////////////////////////////////////////////////////////
constructor TBaseRenderer.Create;
begin
inherited Create;
FCompatibility := 1;
FStop := False;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SetCP(CP: TControlPoint);
begin
if assigned(FCP) then
FCP.Free;
FCP := Cp.Clone;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.UpdateImage(CP: TControlPoint);
begin
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.Stop;
begin
FStop := True;
end;
procedure TBaseRenderer.Pause(paused: boolean);
begin
end;
///////////////////////////////////////////////////////////////////////////////
destructor TBaseRenderer.Destroy;
begin
if assigned(FCP) then
FCP.Free;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
function TBaseRenderer.GetNrSlices: integer;
begin
Result := 1;
end;
///////////////////////////////////////////////////////////////////////////////
function TBaseRenderer.GetSlice: integer;
begin
Result := 0;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.Progress(value: double);
begin
if assigned(FOnprogress) then
FOnprogress(Value);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SaveImage(const FileName: String);
begin
end;
///////////////////////////////////////////////////////////////////////////////
end. end.

353
2.10/Source/Render64.pas
View File

@ -1,7 +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 Borys, Peter Sdobnov Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, 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
@ -22,61 +22,43 @@ unit Render64;
interface interface
uses uses
Windows, Forms, Graphics, ImageMaker, Windows, Classes, Forms, Graphics, ImageMaker,
Render, xform, Controlpoint; RenderST, RenderTypes, Xform, ControlPoint;
type type
TRenderer64 = class(TBaseRenderer) TRenderer64 = class(TBaseSTRenderer)
protected protected
camX0, camX1, camY0, camY1, // camera bounds Buckets: TBucket64Array;
camW, camH, // camera sizes
bws, bhs, cosa, sina, rcX, rcY: double;
ppux, ppuy: extended;
BucketWidth, BucketHeight: int64;
BucketSize: int64;
sample_density: extended;
oversample: integer;
gutter_width: Integer;
max_gutter_width: Integer;
Buckets: TBucketArray;
ColorMap: TColorMapArray; ColorMap: TColorMapArray;
FImageMaker: TImageMaker; function GetBits: integer; override;
function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
procedure InitBuffers; procedure ClearBuckets; override;
procedure CreateColorMap; override;
procedure ClearBuffers;
procedure ClearBuckets;
procedure CreateColorMap;
procedure CreateCamera;
procedure SetPixels;
protected protected
PropTable: array[0..SUB_BATCH_SIZE] of TXform; procedure IterateBatch; override;
finalXform: TXform; procedure IterateBatchAngle; override;
UseFinalXform: boolean; procedure IterateBatchFX; override;
procedure IterateBatchAngleFX; override;
procedure Prepare; end;
procedure IterateBatch;
procedure IterateBatchAngle; // ----------------------------------------------------------------------------
procedure IterateBatchFX;
procedure IterateBatchAngleFX; type
TRenderer64MM = class(TRenderer64)
protected
procedure CalcBufferSize; override;
public public
constructor Create; override;
destructor Destroy; override;
procedure Render; override; procedure Render; override;
function GetImage: TBitmap; override; end;
// procedure UpdateImage(CP: TControlPoint); override;
procedure SaveImage(const FileName: String); override;
end;
implementation implementation
@ -87,88 +69,19 @@ uses
{ TRenderer64 } { TRenderer64 }
///////////////////////////////////////////////////////////////////////////////
constructor TRenderer64.Create;
begin
inherited Create;
FImageMaker := TImageMaker.Create;
end;
///////////////////////////////////////////////////////////////////////////////
destructor TRenderer64.Destroy;
begin
FImageMaker.Free;
inherited;
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.ClearBuckets; procedure TRenderer64.ClearBuckets;
var var
i: integer; i, j: integer;
begin begin
for i := 0 to BucketSize - 1 do begin for j := 0 to BucketHeight - 1 do
buckets[i].Red := 0; for i := 0 to BucketWidth - 1 do
buckets[i].Green := 0; with Buckets[j][i] do begin
buckets[i].Blue := 0; Red := 0;
buckets[i].Count := 0; Green := 0;
end; Blue := 0;
end; Count := 0;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.ClearBuffers;
begin
ClearBuckets;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.CreateCamera;
var
scale: double;
t0, t1: double;
t2, t3: double;
corner_x, corner_y, Xsize, Ysize: double;
shift: Integer;
begin
scale := power(2, fcp.zoom);
sample_density := fcp.sample_density * scale * scale;
ppux := fcp.pixels_per_unit * scale;
ppuy := fcp.pixels_per_unit * scale;
// todo field stuff
shift := 0;
t0 := (gutter_width) / (oversample * ppux);
t1 := (gutter_width) / (oversample * ppuy);
t2 := (2 * max_gutter_width - gutter_width) / (oversample * ppux);
t3 := (2 * max_gutter_width - gutter_width) / (oversample * ppuy);
corner_x := fcp.center[0] - fcp.Width / ppux / 2.0;
corner_y := fcp.center[1] - fcp.Height / ppuy / 2.0;
camX0 := corner_x - t0;
camY0 := corner_y - t1 + shift;
camX1 := corner_x + fcp.Width / ppux + t2;
camY1 := corner_y + fcp.Height / ppuy + t3; //+ shift;
camW := camX1 - camX0;
if abs(camW) > 0.01 then
Xsize := 1.0 / camW
else
Xsize := 1;
camH := camY1 - camY0;
if abs(camH) > 0.01 then
Ysize := 1.0 / camH
else
Ysize := 1;
bws := (BucketWidth - 0.5) * Xsize;
bhs := (BucketHeight - 0.5) * Ysize;
if FCP.FAngle <> 0 then
begin
cosa := cos(FCP.FAngle);
sina := sin(FCP.FAngle);
rcX := FCP.Center[0]*(1 - cosa) - FCP.Center[1]*sina - camX0;
rcY := FCP.Center[1]*(1 - cosa) + FCP.Center[0]*sina - camY0;
end;
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
@ -194,175 +107,27 @@ begin
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
function TRenderer64.GetImage: TBitmap; function TRenderer64.GetBits: integer;
begin begin
Result := FImageMaker.GetImage; Result := BITS_64;
end;
function TRenderer64.GetBucketsPtr: pointer;
begin
Result := Buckets;
end;
procedure TRenderer64.AllocateBuckets;
begin
SetLength(buckets, BucketHeight, BucketWidth);
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.InitBuffers;
const
MaxFilterWidth = 25;
begin
oversample := fcp.spatial_oversample;
max_gutter_width := (MaxFilterWidth - oversample) div 2;
gutter_width := (FImageMaker.GetFilterSize - oversample) div 2;
BucketHeight := oversample * fcp.Height + 2 * max_gutter_width;
Bucketwidth := oversample * fcp.Width + 2 * max_gutter_width;
BucketSize := BucketWidth * BucketHeight;
assert(BucketSize > 0); // who knows ;)
if high(buckets) <> (BucketSize - 1) then
try
SetLength(buckets, BucketSize);
except
on EOutOfMemory do begin
Application.MessageBox('Error: not enough memory for this render!', 'Apophysis', 48);
FStop := true;
exit;
end;
end;
// share the buffer with imagemaker
FImageMaker.SetBucketData(Buckets, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.SetPixels;
var
i: integer;
nsamples: Int64;
nrbatches: Integer;
IterateBatchProc: procedure of object;
begin
Randomize;
if FCP.FAngle = 0 then begin
if UseFinalXform then
IterateBatchProc := IterateBatchFX
else
IterateBatchProc := IterateBatch;
end
else begin
if UseFinalXform then
IterateBatchProc := IterateBatchAngleFX
else
IterateBatchProc := IterateBatchAngle;
end;
nsamples := Round(sample_density * NrSlices * bucketSize / (oversample * oversample));
nrbatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
for i := 0 to nrbatches do begin
if FStop then
Exit;
if ((i and $1F) = 0) then
if nrbatches > 0 then
Progress(i / nrbatches)
else
Progress(0);
IterateBatchProc;
end;
Progress(1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.Render;
begin
if fcp.NumXForms <= 0 then exit;
FStop := False;
FImageMaker.SetCP(FCP);
FImageMaker.Init;
InitBuffers;
if FStop then exit; // memory allocation error
CreateColorMap;
Prepare;
CreateCamera;
ClearBuffers;
SetPixels;
if not FStop then begin
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
end;
///////////////////////////////////////////////////////////////////////////////
{
procedure TRenderer64.UpdateImage(CP: TControlPoint);
begin
FCP.background := cp.background;
FCP.spatial_filter_radius := cp.spatial_filter_radius;
FCP.gamma := cp.Gamma;
FCP.vibrancy := cp.vibrancy;
FCP.contrast := cp.contrast;
FCP.brightness := cp.brightness;
FImageMaker.SetCP(FCP);
FImageMaker.Init;
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
}
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.SaveImage(const FileName: String);
begin
FImageMaker.SaveImage(FileName);
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; procedure TRenderer64.IterateBatch;
var var
i: integer; i: integer;
px, py: double; px, py: double;
Bucket: PBucket; Bucket: PBucket64;
MapColor: PColorMapColor; MapColor: PColorMapColor;
p: TCPPoint; p: TCPPoint;
@ -399,7 +164,7 @@ end;
py := p.y - camY0; py := p.y - camY0;
if (py < 0) or (py > camH) then continue; if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth]; Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)]; MapColor := @ColorMap[Round(p.c * 255)];
Inc(Bucket.Red, MapColor.Red); Inc(Bucket.Red, MapColor.Red);
@ -419,7 +184,7 @@ procedure TRenderer64.IterateBatchAngle;
var var
i: integer; i: integer;
px, py: double; px, py: double;
Bucket: PBucket; Bucket: PBucket64;
MapColor: PColorMapColor; MapColor: PColorMapColor;
p: TCPPoint; p: TCPPoint;
@ -456,7 +221,7 @@ end;
py := p.y * cosa - p.x * sina + rcY; py := p.y * cosa - p.x * sina + rcY;
if (py < 0) or (py > camH) then continue; if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth]; Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)]; MapColor := @ColorMap[Round(p.c * 255)];
Inc(Bucket.Red, MapColor.Red); Inc(Bucket.Red, MapColor.Red);
@ -477,7 +242,7 @@ procedure TRenderer64.IterateBatchFX;
var var
i: integer; i: integer;
px, py: double; px, py: double;
Bucket: PBucket; Bucket: PBucket64;
MapColor: PColorMapColor; MapColor: PColorMapColor;
p, q: TCPPoint; p, q: TCPPoint;
@ -515,7 +280,7 @@ end;
py := q.y - camY0; py := q.y - camY0;
if (py < 0) or (py > camH) then continue; if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth]; Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)]; MapColor := @ColorMap[Round(q.c * 255)];
Inc(Bucket.Red, MapColor.Red); Inc(Bucket.Red, MapColor.Red);
@ -535,7 +300,7 @@ procedure TRenderer64.IterateBatchAngleFX;
var var
i: integer; i: integer;
px, py: double; px, py: double;
Bucket: PBucket; Bucket: PBucket64;
MapColor: PColorMapColor; MapColor: PColorMapColor;
p, q: TCPPoint; p, q: TCPPoint;
@ -573,7 +338,7 @@ end;
py := q.y * cosa - q.x * sina + rcY; py := q.y * cosa - q.x * sina + rcY;
if (py < 0) or (py > camH) then continue; if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth]; Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)]; MapColor := @ColorMap[Round(q.c * 255)];
Inc(Bucket.Red, MapColor.Red); Inc(Bucket.Red, MapColor.Red);
@ -589,5 +354,17 @@ end;
end; end;
end; end;
// -- { TRenderer32MM } -------------------------------------------------------
procedure TRenderer64MM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderer64MM.Render;
begin
RenderMM;
end;
end. end.

388
2.10/Source/Render64MT.pas
View File

@ -23,66 +23,39 @@ interface
uses uses
Windows, Forms, Classes, Graphics, Windows, Forms, Classes, Graphics,
Render, Controlpoint, ImageMaker, BucketFillerthread; Render, RenderMT, ControlPoint, ImageMaker, RenderTypes;
type type
TRenderer64MT = class(TBaseRenderer) TRenderer64MT = class(TBaseMTRenderer)
protected protected
camX0, camX1, camY0, camY1, // camera bounds Buckets: TBucket64Array;
camW, camH, // camera sizes // ColorMap: TColorMapArray;
bws, bhs, cosa, sina, rcX, rcY: double;
ppux, ppuy: extended;
BucketWidth, BucketHeight: Int64; function GetBits: integer; override;
BucketSize: Int64; function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
sample_density: extended; procedure ClearBuckets; override;
oversample: integer; // procedure CreateColorMap; override;
gutter_width: Integer;
max_gutter_width: Integer;
batchcounter: Integer; procedure AddPointsToBuckets(const points: TPointsArray); override;
FNrBatches: Int64; procedure AddPointsToBucketsAngle(const points: TPointsArray); override;
Buckets: TBucketArray; end;
ColorMap: TColorMapArray;
FNrOfTreads: integer; // ----------------------------------------------------------------------------
WorkingThreads: array of TBucketFillerThread;
CriticalSection: TRTLCriticalSection;
FImageMaker: TImageMaker; type
TRenderer64MT_MM = class(TRenderer64MT)
procedure InitBuffers; protected
procedure CalcBufferSize; override;
procedure ClearBuffers;
procedure ClearBuckets;
procedure CreateColorMap;
procedure CreateCamera;
procedure SetPixelsMT;
procedure SetNrOfTreads(const Value: integer);
function NewThread: TBucketFillerThread;
public public
constructor Create; override;
destructor Destroy; override;
function GetImage: TBitmap; override;
procedure Render; override; procedure Render; override;
procedure Stop; override;
procedure Pause(paused: boolean); override; end;
procedure UpdateImage(CP: TControlPoint); override;
procedure SaveImage(const FileName: String); override;
property NrOfTreads: integer
read FNrOfTreads
write SetNrOfTreads;
end;
implementation implementation
@ -91,298 +64,103 @@ uses
{ TRenderer64MT } { TRenderer64MT }
///////////////////////////////////////////////////////////////////////////////
function TRenderer64MT.GetBits: integer;
begin
Result := BITS_64;
end;
function TRenderer64MT.GetBucketsPtr: pointer;
begin
Result := Buckets;
end;
procedure TRenderer64MT.AllocateBuckets;
begin
SetLength(buckets, BucketHeight, BucketWidth);
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.ClearBuckets; procedure TRenderer64MT.ClearBuckets;
var var
i: integer; i, j: integer;
begin begin
for i := 0 to BucketSize - 1 do begin for j := 0 to BucketHeight - 1 do
buckets[i].Red := 0; for i := 0 to BucketWidth - 1 do
buckets[i].Green := 0; with Buckets[j][i] do begin
buckets[i].Blue := 0; Red := 0;
buckets[i].Count := 0; Green := 0;
end; Blue := 0;
end; Count := 0;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.ClearBuffers;
begin
ClearBuckets;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.CreateCamera;
var
scale: double;
t0, t1: double;
t2, t3: double;
corner_x, corner_y, Xsize, Ysize: double;
shift: Integer;
begin
scale := power(2, fcp.zoom);
sample_density := fcp.sample_density * scale * scale;
ppux := fcp.pixels_per_unit * scale;
ppuy := fcp.pixels_per_unit * scale;
// todo field stuff
shift := 0;
t0 := (gutter_width) / (oversample * ppux);
t1 := (gutter_width) / (oversample * ppuy);
t2 := (2 * max_gutter_width - gutter_width) / (oversample * ppux);
t3 := (2 * max_gutter_width - gutter_width) / (oversample * ppuy);
corner_x := fcp.center[0] - fcp.Width / ppux / 2.0;
corner_y := fcp.center[1] - fcp.Height / ppuy / 2.0;
camX0 := corner_x - t0;
camY0 := corner_y - t1 + shift;
camX1 := corner_x + fcp.Width / ppux + t2;
camY1 := corner_y + fcp.Height / ppuy + t3; //+ shift;
camW := camX1 - camX0;
if abs(camW) > 0.01 then
Xsize := 1.0 / camW
else
Xsize := 1;
camH := camY1 - camY0;
if abs(camH) > 0.01 then
Ysize := 1.0 / camH
else
Ysize := 1;
bws := (BucketWidth - 0.5) * Xsize;
bhs := (BucketHeight - 0.5) * Ysize;
if FCP.FAngle <> 0 then
begin
cosa := cos(FCP.FAngle);
sina := sin(FCP.FAngle);
rcX := FCP.Center[0]*(1 - cosa) - FCP.Center[1]*sina - camX0;
rcY := FCP.Center[1]*(1 - cosa) + FCP.Center[0]*sina - camY0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.CreateColorMap;
var
i: integer;
begin
{$IFDEF TESTVARIANT}
for i := 0 to 255 do begin
ColorMap[i].Red := i;
ColorMap[i].Green := i;
ColorMap[i].Blue := i;
// cmap[i][3] := fcp.white_level;
end;
{$ELSE}
for i := 0 to 255 do begin
ColorMap[i].Red := (fcp.CMap[i][0] * fcp.white_level) div 256;
ColorMap[i].Green := (fcp.CMap[i][1] * fcp.white_level) div 256;
ColorMap[i].Blue := (fcp.CMap[i][2] * fcp.white_level) div 256;
// cmap[i][3] := fcp.white_level;
end;
{$ENDIF}
end;
///////////////////////////////////////////////////////////////////////////////
constructor TRenderer64MT.Create;
begin
inherited Create;
FImageMaker := TImageMaker.Create;
end;
///////////////////////////////////////////////////////////////////////////////
destructor TRenderer64MT.Destroy;
begin
FImageMaker.Free;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderer64MT.GetImage: TBitmap;
begin
Result := FImageMaker.GetImage;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.InitBuffers;
const
MaxFilterWidth = 25;
begin
oversample := fcp.spatial_oversample;
max_gutter_width := (MaxFilterWidth - oversample) div 2;
gutter_width := (FImageMaker.GetFilterSize - oversample) div 2;
BucketHeight := oversample * fcp.Height + 2 * max_gutter_width;
Bucketwidth := oversample * fcp.width + 2 * max_gutter_width;
BucketSize := BucketWidth * BucketHeight;
if high(buckets) <> (BucketSize - 1) then
try
SetLength(buckets, BucketSize);
except
on EOutOfMemory do begin
Application.MessageBox('Error: not enough memory for this render!', 'Apophysis', 48);
FStop := true;
exit;
end; end;
end;
// share the buffer with imagemaker
FImageMaker.SetBucketData(Buckets, BucketWidth);
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.SetPixelsMT; procedure TRenderer64MT.AddPointsToBuckets(const points: TPointsArray);
var var
i: integer; i: integer;
nsamples: Int64; px, py: double;
bc : integer; // R: double;
// V1, v2, v3: integer;
Bucket: PBucket64;
MapColor: PColorMapColor;
begin begin
nsamples := Round(sample_density * NrSlices * bucketSize / (oversample * oversample)); for i := SUB_BATCH_SIZE - 1 downto 0 do begin
FNrBatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE)); // if FStop then Exit;
batchcounter := 0;
Randomize;
InitializeCriticalSection(CriticalSection); 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;
SetLength(WorkingThreads, NrOfTreads); Bucket := @Buckets[Round(bhs * py)][Round(bws * px)];
for i := 0 to NrOfTreads - 1 do MapColor := @ColorMap[Round(points[i].c * 255)];
WorkingThreads[i] := NewThread;
for i := 0 to NrOfTreads - 1 do Inc(Bucket.Red, MapColor.Red);
WorkingThreads[i].Resume; Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
bc := 0; Inc(Bucket.Count);
while (Not FStop) and (bc < FNrBatches) do begin
sleep(200);
try
EnterCriticalSection(CriticalSection);
if batchcounter > 0 then
Progress(batchcounter / FNrBatches)
else
Progress(0);
bc := batchcounter;
finally
LeaveCriticalSection(CriticalSection);
end;
end; end;
{ for i := 0 to NrOfTreads - 1 do
begin
WorkingThreads[i].Terminate;
WorkingThreads[i].Free;
end;}
DeleteCriticalSection(CriticalSection);
Progress(1);
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.Stop; procedure TRenderer64MT.AddPointsToBucketsAngle(const points: TPointsArray);
var var
i: integer; i: integer;
px, py: double;
Bucket: PBucket64;
MapColor: PColorMapColor;
begin begin
for i := 0 to NrOfTreads - 1 do for i := SUB_BATCH_SIZE - 1 downto 0 do begin
WorkingThreads[i].Terminate; // if FStop then Exit;
inherited; px := points[i].x * cosa + points[i].y * sina + rcX;
end; 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;
procedure TRenderer64MT.Pause(paused: boolean); Bucket := @Buckets[Round(bhs * py)][Round(bws * px)];
var MapColor := @ColorMap[Round(points[i].c * 255)];
i: integer;
begin Inc(Bucket.Red, MapColor.Red);
if paused then begin Inc(Bucket.Green, MapColor.Green);
for i := 0 to NrOfTreads - 1 do Inc(Bucket.Blue, MapColor.Blue);
WorkingThreads[i].Suspend; Inc(Bucket.Count);
end
else begin
for i := 0 to NrOfTreads - 1 do
WorkingThreads[i].Resume;
end; end;
end; end;
/////////////////////////////////////////////////////////////////////////////// // -- { TRenderer64MT_MM } ----------------------------------------------------
procedure TRenderer64MT.Render;
procedure TRenderer64MT_MM.CalcBufferSize;
begin begin
FStop := False; CalcBufferSizeMM;
FImageMaker.SetCP(FCP);
FImageMaker.Init;
InitBuffers;
if FStop then exit; // memory allocation error
CreateColorMap;
fcp.Prepare;
CreateCamera;
ClearBuffers;
SetPixelsMT;
if not FStop then begin
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end;
end; end;
/////////////////////////////////////////////////////////////////////////////// procedure TRenderer64MT_MM.Render;
procedure TRenderer64MT.UpdateImage(CP: TControlPoint);
begin begin
FCP.background := cp.background; RenderMM;
FCP.spatial_filter_radius := cp.spatial_filter_radius;
FCP.gamma := cp.Gamma;
FCP.vibrancy := cp.vibrancy;
FCP.contrast := cp.contrast;
FCP.brightness := cp.brightness;
FImageMaker.SetCP(FCP);
FImageMaker.Init;
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage;
end; end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.SetNrOfTreads(const Value: integer);
begin
FNrOfTreads := Value;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderer64MT.NewThread: TBucketFillerThread;
begin
Result := TBucketFillerThread.Create(fcp);
assert(Result<>nil);
Result.BucketWidth := BucketWidth;
Result.BucketHeight := BucketHeight;
Result.Buckets := @Buckets;
Result.camX0 := camX0;
Result.camY0 := camY0;
Result.camW := camW;
Result.camH := camH;
Result.bws := bws;
Result.bhs := bhs;
Result.cosa := cosa;
Result.sina := sina;
Result.rcX := rcX;
Result.rcY := rcY;
Result.ColorMap := colorMap;
Result.CriticalSection := CriticalSection;
Result.Nrbatches := FNrBatches;
Result.batchcounter := @batchcounter;
// Result.Resume;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.SaveImage(const FileName: String);
begin
FImageMaker.SaveImage(FileName);
end;
///////////////////////////////////////////////////////////////////////////////
end. end.

240
2.10/Source/RenderMM.pas
View File

@ -1,240 +0,0 @@
{
Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
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
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit RenderMM;
interface
uses
Windows, Forms, Graphics,
Render64, Controlpoint, ImageMaker, XForm;
type
TRendererMM64 = class(TRenderer64)
private
image_Width, image_Height: Int64;
image_Center_X, image_Center_Y: double;
Slice, nrSlices: integer;
procedure InitBuffers;
procedure CreateCamera;
protected
function GetSlice: integer; override;
function GetNrSlices: integer; override;
public
function GetImage: TBitmap; override;
procedure SaveImage(const FileName: String); override;
procedure Render; override;
end;
implementation
uses
Math, Sysutils;
{ TRendererMM64 }
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.CreateCamera;
var
scale: double;
t0, t1: double;
corner_x, corner_y, Xsize, Ysize: double;
shift: Integer;
begin
scale := power(2, fcp.zoom);
sample_density := fcp.sample_density * scale * scale;
ppux := fcp.pixels_per_unit * scale;
ppuy := fcp.pixels_per_unit * scale;
// todo field stuff
shift := 0;
t0 := gutter_width / (oversample * ppux);
t1 := gutter_width / (oversample * ppuy);
corner_x := fcp.center[0] - image_width / ppux / 2.0;
corner_y := fcp.center[1] - image_height / ppuy / 2.0;
camX0 := corner_x - t0;
camY0 := corner_y - t1 + shift;
camX1 := corner_x + image_width / ppux + t0;
camY1 := corner_y + image_height / ppuy + t1; //+ shift;
camW := camX1 - camX0;
if abs(camW) > 0.01 then
Xsize := 1.0 / camW
else
Xsize := 1;
camH := camY1 - camY0;
if abs(camH) > 0.01 then
Ysize := 1.0 / camH
else
Ysize := 1;
bws := (BucketWidth - 0.5) * Xsize;
bhs := (BucketHeight - 0.5) * Ysize;
if FCP.FAngle <> 0 then
begin
cosa := cos(FCP.FAngle);
sina := sin(FCP.FAngle);
rcX := image_Center_X*(1 - cosa) - image_Center_Y*sina - camX0;
rcY := image_Center_Y*(1 - cosa) + image_Center_X*sina - camY0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TRendererMM64.GetImage: TBitmap;
begin
Result := FImageMaker.GetImage;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.InitBuffers;
begin
oversample := fcp.spatial_oversample;
gutter_width := (FImageMaker.GetFilterSize - oversample) div 2;
BucketHeight := oversample * image_height + 2 * gutter_width;
Bucketwidth := oversample * image_width + 2 * gutter_width;
BucketSize := BucketWidth * BucketHeight;
if high(buckets) <> (BucketSize - 1) then
try
SetLength(buckets, BucketSize);
except
on EOutOfMemory do begin
Application.MessageBox('Error: not enough memory for this render!', 'Apophysis', 48);
FStop := true;
exit;
end;
end;
// share the buffer with imagemaker
FImageMaker.SetBucketData(Buckets, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.Render;
const
Dividers: array[0..15] of integer = (1, 2, 3, 4, 5, 6, 7, 8, 10, 16, 20, 32, 64, 128, 256, 512);
var
ApproxMemory, MaxMemory: int64;
i: integer;
zoom_scale, center_base, center_y: double;
begin
FStop := False;
image_Center_X := fcp.center[0];
image_Center_Y := fcp.center[1];
image_height := fcp.Height;
image_width := fcp.Width;
oversample := fcp.spatial_oversample;
// entered memory - imagesize
MaxMemory := FMaxMem * 1024 * 1024 - 4 * image_height * image_width;
ApproxMemory := 32 * oversample * oversample * image_height * image_width;
assert(MaxMemory > 0);
if MaxMemory <= 0 then exit;
// All this 'dividers' stuff looks very VERY weird! :-\
nrSlices := 1 + ApproxMemory div MaxMemory;
if nrSlices > Dividers[High(Dividers)] then begin
for i := High(Dividers) downto 0 do begin
if image_height <> (image_height div dividers[i]) * dividers[i] then begin
nrSlices := dividers[i];
break;
end;
end;
end else begin
for i := 0 to High(Dividers) do begin
if image_height <> (image_height div dividers[i]) * dividers[i] then
continue;
if nrslices <= dividers[i] then begin
nrSlices := dividers[i];
break;
end;
end;
end;
FImageMaker.SetCP(FCP);
FImageMaker.Init;
// fcp.sample_density := fcp.sample_density * nrslices;
fcp.height := fcp.height div nrslices;
center_y := fcp.center[1];
zoom_scale := power(2.0, fcp.zoom);
center_base := center_y - ((nrslices - 1) * fcp.height) / (2 * fcp.pixels_per_unit * zoom_scale);
image_height := fcp.Height;
image_width := fcp.Width;
InitBuffers;
CreateColorMap;
Prepare;
for i := 0 to NrSlices - 1 do begin
if FStop then
Exit;
Slice := i;
fcp.center[1] := center_base + fcp.height * slice / (fcp.pixels_per_unit * zoom_scale);
CreateCamera;
ClearBuffers;
SetPixels;
if not FStop then begin
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage(Slice * fcp.height);
end;
end;
// fcp.sample_density := fcp.sample_density / nrslices;
fcp.height := fcp.height * nrslices;
end;
///////////////////////////////////////////////////////////////////////////////
function TRendererMM64.GetSlice: integer;
begin
Result := Slice;
end;
///////////////////////////////////////////////////////////////////////////////
function TRendererMM64.GetNrSlices: integer;
begin
Result := NrSlices;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.SaveImage(const FileName: String);
begin
FImageMaker.SaveImage(FileName);
end;
///////////////////////////////////////////////////////////////////////////////
end.

798
2.10/Source/RenderMM2.pas
View File

@ -1,798 +0,0 @@
{
Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend
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
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit RenderMM2;
interface
uses
Windows, Graphics,
Render, Controlpoint;
type
TOnProgress = procedure(prog: double) of object;
type
TColorMapColor = Record
Red : Int64;
Green: Int64;
Blue : Int64;
// Count: Integer;
end;
PColorMapColor = ^TColorMapColor;
TColorMapArray = array[0..255] of TColorMapColor;
TBucket = Record
Red : Int64;
Green: Int64;
Blue : Int64;
Count: Int64;
end;
PBucket = ^TBucket;
TBucketArray = array of TBucket;
Type
TResPoint = record
x,y,c: integer;
end;
type
TRendererMM64 = class(TBaseRenderer)
private
bm: TBitmap;
oversample: Integer;
filter_width: Integer;
filter: array of array of extended;
image_Width: Integer;
image_Height: Integer;
BucketWidth: Integer;
BucketHeight: Integer;
BucketSize: Integer;
gutter_width: Integer;
sample_density: extended;
Buckets: TBucketArray;
ColorMap: TColorMapArray;
bg: array[0..2] of extended;
vib_gam_n: Integer;
vibrancy: double;
gamma: double;
bounds: array[0..3] of extended;
size: array[0..1] of extended;
ppux, ppuy: extended;
nrSlices: int64;
Slice: int64;
PointResBuffer: Array of TResPoint;
MaxNrResPoints: integer;
NrResPoints: integer;
procedure CreateFilter;
procedure NormalizeFilter;
procedure InitValues;
procedure InitBuffers;
procedure InitBitmap(w: Integer = 0; h: Integer = 0);
procedure ClearBuffers;
procedure ClearBuckets;
procedure CreateColorMap;
procedure CreateCamera;
procedure AddPointsToPointResBuffer(const points: TPointsArray); overload;
procedure AddPointsToPointResBufferAngle(const points: TPointsArray); overload;
procedure AddPointsFromPointResBufferToBucket(Slice: Integer);
procedure SetPixels;
procedure CreateBMFromBuckets(YOffset: Integer = 0);
procedure StoreBuffer(Index: integer);
procedure RestoreBuffer(Index: integer);
procedure CreatePointResBuffer(MaxMemory: integer);
procedure FillBuckets;
protected
function GetSlice: integer; override;
function GetNrSlices: integer; override;
public
constructor Create; override;
destructor Destroy; override;
function GetImage: TBitmap; override;
procedure Render; override;
end;
implementation
uses
Classes, Math, Sysutils;
{ TRendererMM64 }
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.ClearBuckets;
var
i: integer;
begin
for i := 0 to BucketSize - 1 do begin
buckets[i].Red := 0;
buckets[i].Green := 0;
buckets[i].Blue := 0;
buckets[i].Count := 0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.ClearBuffers;
begin
ClearBuckets;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.CreateCamera;
var
scale: double;
t0, t1: double;
corner0, corner1: double;
shift: Integer;
begin
scale := power(2, fcp.zoom);
sample_density := fcp.sample_density * scale * scale;
ppux := fcp.pixels_per_unit * scale;
ppuy := fcp.pixels_per_unit * scale;
// todo field stuff
shift := 0;
t0 := gutter_width / (oversample * ppux);
t1 := gutter_width / (oversample * ppuy);
corner0 := fcp.center[0] - image_width / ppux / 2.0;
corner1 := fcp.center[1] - image_height / ppuy / 2.0;
bounds[0] := corner0 - t0;
bounds[1] := corner1 - t1 + shift;
bounds[2] := corner0 + image_width / ppux + t0;
bounds[3] := corner1 + image_height / ppuy + t1; //+ shift;
if abs(bounds[2] - bounds[0]) > 0.01 then
size[0] := 1.0 / (bounds[2] - bounds[0])
else
size[0] := 1;
if abs(bounds[3] - bounds[1]) > 0.01 then
size[1] := 1.0 / (bounds[3] - bounds[1])
else
size[1] := 1;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.CreateColorMap;
var
i: integer;
begin
for i := 0 to 255 do begin
ColorMap[i].Red := (fcp.CMap[i][0] * fcp.white_level) div 256;
ColorMap[i].Green := (fcp.CMap[i][1] * fcp.white_level) div 256;
ColorMap[i].Blue := (fcp.CMap[i][2] * fcp.white_level) div 256;
// cmap[i][3] := fcp.white_level;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.CreateFilter;
var
i, j: integer;
begin
oversample := fcp.spatial_oversample;
filter_width := Round(2.0 * FILTER_CUTOFF * oversample * fcp.spatial_filter_radius);
// make sure it has same parity as oversample
if odd(filter_width + oversample) then
inc(filter_width);
setLength(filter, filter_width, filter_width);
for i := 0 to filter_width - 1 do begin
for j := 0 to filter_width - 1 do begin
filter[i, j] := exp(-2.0 * power(((2.0 * i + 1.0) / filter_width - 1.0) * FILTER_CUTOFF, 2) *
power(((2.0 * j + 1.0) / filter_width - 1.0) * FILTER_CUTOFF, 2));
end;
end;
Normalizefilter;
end;
///////////////////////////////////////////////////////////////////////////////
destructor TRendererMM64.Destroy;
begin
if assigned(bm) then
bm.Free;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
function TRendererMM64.GetImage: TBitmap;
begin
Result := bm;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.InitBuffers;
begin
gutter_width := (filter_width - oversample) div 2;
BucketHeight := oversample * image_height + 2 * gutter_width;
Bucketwidth := oversample * image_width + 2 * gutter_width;
BucketSize := BucketWidth * BucketHeight;
if high(buckets) <> (BucketSize - 1) then begin
SetLength(buckets, BucketSize);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.InitValues;
begin
image_height := fcp.Height;
image_Width := fcp.Width;
CreateFilter;
CreateCamera;
InitBuffers;
CreateColorMap;
vibrancy := 0;
gamma := 0;
vib_gam_n := 0;
bg[0] := 0;
bg[1] := 0;
bg[2] := 0;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.NormalizeFilter;
var
i, j: integer;
t: double;
begin
t := 0;
for i := 0 to filter_width - 1 do
for j := 0 to filter_width - 1 do
t := t + filter[i, j];
for i := 0 to filter_width - 1 do
for j := 0 to filter_width - 1 do
filter[i, j] := filter[i, j] / t;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.AddPointsToPointResBuffer(const points: TPointsArray);
var
i: integer;
px, py: double;
bws, bhs: double;
bx, by: double;
wx, wy: double;
Bucket: PBucket;
MapColor: PColorMapColor;
begin
bws := (BucketWidth - 0.5) * size[0];
bhs := ((oversample * image_height + 2 * gutter_width) - 0.5) * size[1];
bx := bounds[0];
by := bounds[1];
wx := bounds[2] - bounds[0];
wy := bounds[3] - bounds[1];
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
px := points[i].x - bx;
py := points[i].y - by;
if ((px < 0) or (px > wx) or
(py < 0) or (py > wy)) then
continue;
PointResBuffer[NrResPoints].x := Round(bws * px);
PointResBuffer[NrResPoints].y := Round(bhs * py);
PointResBuffer[NrResPoints].c := Round(points[i].c * 255);
Inc(NrResPoints);
// MapColor := @ColorMap[Round(points[i].c * 255)];
// Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
//
// Inc(Bucket.Red, MapColor.Red);
// Inc(Bucket.Green, MapColor.Green);
// Inc(Bucket.Blue, MapColor.Blue);
// Inc(Bucket.Count);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.AddPointsToPointResBufferAngle(const points: TPointsArray);
var
i: integer;
px, py: double;
ca,sa: double;
nx, ny: double;
bws, bhs: double;
bx, by: double;
wx, wy: double;
Bucket: PBucket;
MapColor: PColorMapColor;
begin
bws := (BucketWidth - 0.5) * size[0];
bhs := ((oversample * image_height + 2 * gutter_width) - 0.5) * size[1];
bx := bounds[0];
by := bounds[1];
wx := bounds[2] - bounds[0];
wy := bounds[3] - bounds[1];
ca := cos(FCP.FAngle);
sa := sin(FCP.FAngle);
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
px := points[i].x - FCP.Center[0];
py := points[i].y - FCP.Center[1];
nx := px * ca + py * sa;
ny := -px * sa + py * ca;
px := nx + FCP.Center[0] - bx;
py := ny + FCP.Center[1] - by;
if ((px < 0) or (px > wx) or
(py < 0) or (py > wy)) then
continue;
PointResBuffer[NrResPoints].x := Round(bws * px);
PointResBuffer[NrResPoints].y := Round(bhs * py);
PointResBuffer[NrResPoints].c := Round(points[i].c * 255);
Inc(NrResPoints);
// MapColor := @ColorMap[Round(points[i].c * 255)];
// Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
//
// Inc(Bucket.Red, MapColor.Red);
// Inc(Bucket.Green, MapColor.Green);
// Inc(Bucket.Blue, MapColor.Blue);
// Inc(Bucket.Count);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.AddPointsFromPointResBufferToBucket(Slice: Integer);
var
i: integer;
Bucket: PBucket;
MapColor: PColorMapColor;
Miny,MaxY: integer;
y: integer;
begin
MinY := Slice * fcp.Height;
// MaxY := (Slice + 1) * fcp.Height;
for i:= 0 to NrResPoints - 1 do begin
y := PointResBuffer[i].y - MinY;
if (y < 0) or (Y >= fcp.Height) then
continue;
MapColor := @ColorMap[PointResBuffer[i].c];
Bucket := @buckets[PointResBuffer[i].X + y * BucketWidth];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.SetPixels;
var
i: integer;
nsamples: Int64;
nrbatches: Integer;
points: TPointsArray;
bkuNrSlices: integer;
begin
bkuNrSlices := NrSlices;
NrSlices := 1;
Slice := 0;
SetLength(Points, SUB_BATCH_SIZE);
nsamples := Round(sample_density * bucketSize / (oversample * oversample));
nrbatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
Randomize;
for i := 0 to nrbatches do begin
if (MaxNrResPoints - NrResPoints) < SUB_BATCH_SIZE then begin
NrSlices := bkuNrSlices;
FillBuckets;
NrSlices := 1;
end;
if FStop then
Exit;
if (i and $F = 0) then
Progress(i / nrbatches);
// generate points
case Compatibility of
0: fcp.iterate_Old(SUB_BATCH_SIZE, points);
1: fcp.iterateXYC(SUB_BATCH_SIZE, points);
end;
if FCP.FAngle = 0 then
AddPointsToPointResBuffer(points)
else
AddPointsToPointResBufferAngle(points);
end;
NrSlices := bkuNrSlices;
FillBuckets;
Progress(1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.CreateBMFromBuckets(YOffset: Integer);
var
i, j: integer;
alpha: double;
// r,g,b: double;
ai, ri, gi, bi: Integer;
bgtot: Integer;
ls: double;
ii, jj: integer;
fp: array[0..3] of double;
Row: PLongintArray;
vib, notvib: Integer;
bgi: array[0..2] of Integer;
bucketpos: Integer;
filterValue: double;
filterpos: Integer;
lsa: array[0..1024] of double;
var
k1, k2: double;
area: double;
begin
if fcp.gamma = 0 then
gamma := fcp.gamma
else
gamma := 1 / fcp.gamma;
vib := round(fcp.vibrancy * 256.0);
notvib := 256 - vib;
bgi[0] := round(fcp.background[0]);
bgi[1] := round(fcp.background[1]);
bgi[2] := round(fcp.background[2]);
bgtot := RGB(bgi[2], bgi[1], bgi[0]);
k1 := (fcp.Contrast * BRIGHT_ADJUST * fcp.brightness * 268 * PREFILTER_WHITE) / 256.0;
area := image_width * image_height / (ppux * ppuy);
k2 := (oversample * oversample) / (fcp.Contrast * area * fcp.White_level * sample_density);
lsa[0] := 0;
for i := 1 to 1024 do begin
lsa[i] := (k1 * log10(1 + fcp.White_level * i * k2)) / (fcp.White_level * i);
end;
if filter_width > 1 then begin
for i := 0 to BucketWidth * BucketHeight - 1 do begin
if Buckets[i].count = 0 then
Continue;
ls := lsa[Min(1023, Buckets[i].Count)];
Buckets[i].Red := Round(Buckets[i].Red * ls);
Buckets[i].Green := Round(Buckets[i].Green * ls);
Buckets[i].Blue := Round(Buckets[i].Blue * ls);
Buckets[i].Count := Round(Buckets[i].Count * ls);
end;
end;
ls := 0;
ai := 0;
bucketpos := 0;
for i := 0 to Image_Height - 1 do begin
if FStop then
Break;
Progress(i / Image_Height);
Row := PLongintArray(bm.scanline[YOffset + i]);
for j := 0 to Image_Width - 1 do begin
if filter_width > 1 then begin
fp[0] := 0;
fp[1] := 0;
fp[2] := 0;
fp[3] := 0;
for ii := 0 to filter_width - 1 do begin
for jj := 0 to filter_width - 1 do begin
filterValue := filter[ii, jj];
filterpos := bucketpos + ii * BucketWidth + jj;
fp[0] := fp[0] + filterValue * Buckets[filterpos].Red;
fp[1] := fp[1] + filterValue * Buckets[filterpos].Green;
fp[2] := fp[2] + filterValue * Buckets[filterpos].Blue;
fp[3] := fp[3] + filterValue * Buckets[filterpos].Count;
end;
end;
fp[0] := fp[0] / PREFILTER_WHITE;
fp[1] := fp[1] / PREFILTER_WHITE;
fp[2] := fp[2] / PREFILTER_WHITE;
fp[3] := fcp.white_level * fp[3] / PREFILTER_WHITE;
end else begin
ls := lsa[Min(1023, Buckets[bucketpos].count)] / PREFILTER_WHITE;
fp[0] := ls * Buckets[bucketpos].Red;
fp[1] := ls * Buckets[bucketpos].Green;
fp[2] := ls * Buckets[bucketpos].Blue;
fp[3] := ls * Buckets[bucketpos].Count * fcp.white_level;
end;
Inc(bucketpos, oversample);
if (fp[3] > 0.0) then begin
alpha := power(fp[3], gamma);
ls := vib * alpha / fp[3];
ai := round(alpha * 256);
if (ai < 0) then
ai := 0
else if (ai > 256) then
ai := 256;
ai := 256 - ai;
end else begin
// no intensity so simply set the BG;
Row[j] := bgtot;
continue;
end;
if (notvib > 0) then
ri := Round(ls * fp[0] + notvib * power(fp[0], gamma))
else
ri := Round(ls * fp[0]);
ri := ri + (ai * bgi[0]) shr 8;
if (ri < 0) then
ri := 0
else if (ri > 255) then
ri := 255;
if (notvib > 0) then
gi := Round(ls * fp[1] + notvib * power(fp[1], gamma))
else
gi := Round(ls * fp[1]);
gi := gi + (ai * bgi[1]) shr 8;
if (gi < 0) then
gi := 0
else if (gi > 255) then
gi := 255;
if (notvib > 0) then
bi := Round(ls * fp[2] + notvib * power(fp[2], gamma))
else
bi := Round(ls * fp[2]);
bi := bi + (ai * bgi[2]) shr 8;
if (bi < 0) then
bi := 0
else if (bi > 255) then
bi := 255;
Row[j] := RGB(bi, gi, ri);
end;
Inc(bucketpos, 2 * gutter_width);
Inc(bucketpos, (oversample - 1) * BucketWidth);
end;
Progress(1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.InitBitmap(w, h: Integer);
begin
if not Assigned(bm) then
bm := TBitmap.Create;
bm.PixelFormat := pf32bit;
if (w <> 0) and (h <> 0) then begin
bm.Width := w;
bm.Height := h;
end else begin
bm.Width := image_Width;
bm.Height := image_Height;
end;
end;
///////////////////////////////////////////////////////////////////////////////
constructor TRendererMM64.Create;
begin
inherited Create;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.Render;
const
Dividers: array[0..16] of integer = (1, 2, 3, 4, 5, 6, 7, 8, 10, 16, 20, 32, 64, 128, 256, 512, 1024);
var
ApproxMemory, MaxMemory: int64;
i: integer;
zoom_scale, center_base, center_y: double;
OldCenter: double;
PointResMem: Integer;
begin
FStop := False;
image_height := fcp.Height;
image_Width := fcp.Width;
oversample := fcp.spatial_oversample;
// entered memory - imagesize
MaxMemory := FMaxMem * 1024 * 1024 - 4 * image_height * image_width;
if (MaxMemory < 0) then
Exit;
PointResMem := round(0.90 * MaxMemory);
CreatePointResBuffer(PointResMem);
MaxMemory := MaxMemory - PointResMem;
ApproxMemory := 32 * oversample * oversample * image_height * image_width;
nrSlices := 1 + ApproxMemory div MaxMemory;
if nrSlices > Dividers[High(Dividers)] then begin
for i := High(Dividers) downto 0 do begin
if image_height <> (image_height div dividers[i]) * dividers[i] then begin
nrSlices := dividers[i];
break;
end;
end;
end else begin
for i := 0 to High(Dividers) do begin
if image_height <> (image_height div dividers[i]) * dividers[i] then
continue;
if nrslices <= dividers[i] then begin
nrSlices := dividers[i];
break;
end;
end;
end;
fcp.sample_density := fcp.sample_density * nrslices;
fcp.height := fcp.height div nrslices;
center_y := fcp.center[1];
zoom_scale := power(2.0, fcp.zoom);
center_base := center_y - ((nrslices - 1) * fcp.height) / (2 * fcp.pixels_per_unit * zoom_scale);
InitValues;
InitBitmap(fcp.Width, NrSlices * fcp.Height);
ClearBuffers;
for i := 0 to NrSlices - 1 do begin
StoreBuffer(i);
end;
image_height := fcp.Height * nrslices;
fcp.center[1] := center_y;
CreateCamera;
SetPixels;
fcp.height := fcp.height div nrslices;
for i := 0 to NrSlices - 1 do begin
Progress(i/NrSlices);
Slice := i;
fcp.center[1] := center_base + fcp.height * slice / (fcp.pixels_per_unit * zoom_scale);
CreateCamera;
RestoreBuffer(i);
CreateBMFromBuckets(Slice * fcp.height);
end;
Progress(1);
bm.PixelFormat := pf24bit;
fcp.sample_density := fcp.sample_density / nrslices;
fcp.height := fcp.height * nrslices;
end;
///////////////////////////////////////////////////////////////////////////////
function TRendererMM64.GetSlice: integer;
begin
Result := Slice;
end;
///////////////////////////////////////////////////////////////////////////////
function TRendererMM64.GetNrSlices: integer;
begin
Result := NrSlices;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.RestoreBuffer(Index: integer);
var
FileName: string;
stream: TFileStream;
begin
FileName := 'c:\temp\' + 'buff' + inttostr(Index) +'.buf';
if not FileExists(Filename) then
Raise exception.create('Unable to find ' + FileName);
Stream := TFileStream.Create(FileName, fmOpenRead);
Stream.Read(Buckets[0], BucketSize * sizeOf(TBucket));
Stream.Free;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.StoreBuffer(Index: integer);
var
FileName: string;
Stream: TFileStream;
begin
FileName := 'c:\temp\' + 'buff' + inttostr(Index) +'.buf';
if not FileExists(Filename) then
DeleteFile(FileName);
Stream := TFileStream.Create(FileName,fmCreate or fmOpenWrite);
Stream.Write(Buckets[0], BucketSize * sizeOf(TBucket));
Stream.Free;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.CreatePointResBuffer(MaxMemory: integer);
begin
MaxNrResPoints := MaxMemory div sizeOf(TResPoint);
if MaxNrResPoints < SUB_BATCH_SIZE then
raise Exception.create('Insuffient memory to create the PointResBuffer');
SetLength(PointResBuffer, MaxNrResPoints);
NrResPoints := 0;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64.FillBuckets;
var
i: integer;
begin
for i := 0 to NrSlices - 1 do begin
if FStop then
Break;
// Slice := i;
// Progress(i/NrSlices);
RestoreBuffer(i);
AddPointsFromPointResBufferToBucket(i);
StoreBuffer(i);
end;
// Progress(1);
NrResPoints := 0;
end;
///////////////////////////////////////////////////////////////////////////////
end.

257
2.10/Source/RenderMM_MT.pas
View File

@ -1,257 +0,0 @@
{
Flame screensaver Copyright (C) 2002 Ronald Hordijk
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
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
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit RenderMM_MT;
interface
uses
Windows, Forms, Graphics,
Render64MT, Controlpoint, ImageMaker, BucketFillerThread, XForm;
type
TRendererMM64_MT = class(TRenderer64MT)
private
image_Width, image_Height: int64;
image_Center_X, image_Center_Y: double;
Slice, nrSlices: integer;
procedure InitBuffers;
procedure CreateCamera;
protected
function GetSlice: integer; override;
function GetNrSlices: integer; override;
public
function GetImage: TBitmap; override;
procedure Render; override;
procedure Stop; override;
procedure Pause(paused: boolean); override;
end;
implementation
uses
Math, Sysutils;
{ TRendererMM64_MT }
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64_MT.CreateCamera;
var
scale: double;
t0, t1: double;
corner_x, corner_y, Xsize, Ysize: double;
shift: Integer;
begin
scale := power(2, fcp.zoom);
sample_density := fcp.sample_density * scale * scale;
ppux := fcp.pixels_per_unit * scale;
ppuy := fcp.pixels_per_unit * scale;
// todo field stuff
shift := 0;
t0 := gutter_width / (oversample * ppux);
t1 := gutter_width / (oversample * ppuy);
corner_x := fcp.center[0] - image_width / ppux / 2.0;
corner_y := fcp.center[1] - image_height / ppuy / 2.0;
camX0 := corner_x - t0;
camY0 := corner_y - t1 + shift;
camX1 := corner_x + image_width / ppux + t0;
camY1 := corner_y + image_height / ppuy + t1; //+ shift;
camW := camX1 - camX0;
if abs(camW) > 0.01 then
Xsize := 1.0 / camW
else
Xsize := 1;
camH := camY1 - camY0;
if abs(camH) > 0.01 then
Ysize := 1.0 / camH
else
Ysize := 1;
bws := (BucketWidth - 0.5) * Xsize;
bhs := (BucketHeight - 0.5) * Ysize;
if FCP.FAngle <> 0 then
begin
cosa := cos(FCP.FAngle);
sina := sin(FCP.FAngle);
rcX := image_Center_X*(1 - cosa) - image_Center_Y*sina - camX0;
rcY := image_Center_Y*(1 - cosa) + image_Center_X*sina - camY0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TRendererMM64_MT.GetImage: TBitmap;
begin
Result := FImageMaker.GetImage;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64_MT.InitBuffers;
begin
oversample := fcp.spatial_oversample;
gutter_width := (FImageMaker.GetFilterSize - oversample) div 2;
BucketHeight := oversample * image_height + 2 * gutter_width;
Bucketwidth := oversample * image_width + 2 * gutter_width;
BucketSize := BucketWidth * BucketHeight;
if high(buckets) <> (BucketSize - 1) then
try
SetLength(buckets, BucketSize);
except
on EOutOfMemory do begin
Application.MessageBox('Error: not enough memory for this render!', 'Apophysis', 48);
FStop := true;
exit;
end;
end;
// share the buffer with imagemaker
FImageMaker.SetBucketData(Buckets, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64_MT.Stop;
var
i: integer;
begin
for i := 0 to NrOfTreads - 1 do
WorkingThreads[i].Terminate;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64_MT.Pause(paused: boolean);
var
i: integer;
begin
if paused then begin
for i := 0 to NrOfTreads - 1 do
WorkingThreads[i].Suspend;
end
else begin
for i := 0 to NrOfTreads - 1 do
WorkingThreads[i].Resume;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRendererMM64_MT.Render;
const
Dividers: array[0..15] of integer = (1, 2, 3, 4, 5, 6, 7, 8, 10, 16, 20, 32, 64, 128, 256, 512);
var
ApproxMemory, MaxMemory: int64;
i: integer;
zoom_scale, center_base, center_y: double;
begin
FStop := False;
image_Center_X := fcp.center[0];
image_Center_Y := fcp.center[1];
image_height := fcp.Height;
image_Width := fcp.Width;
oversample := fcp.spatial_oversample;
// entered memory - imagesize
MaxMemory := FMaxMem * 1024 * 1024 - 4 * image_height * int64(image_width);
ApproxMemory := 32 * oversample * oversample * image_height * int64(image_width);
if (MaxMemory < 0) then
Exit;
nrSlices := 1 + ApproxMemory div MaxMemory;
if nrSlices > Dividers[High(Dividers)] then begin
for i := High(Dividers) downto 0 do begin
if image_height <> (image_height div dividers[i]) * dividers[i] then begin
nrSlices := dividers[i];
break;
end;
end;
end else begin
for i := 0 to High(Dividers) do begin
if image_height <> (image_height div dividers[i]) * dividers[i] then
continue;
if nrslices <= dividers[i] then begin
nrSlices := dividers[i];
break;
end;
end;
end;
FImageMaker.SetCP(FCP);
FImageMaker.Init;
//fcp.sample_density := fcp.sample_density * nrslices;
fcp.height := fcp.height div nrslices;
center_y := fcp.center[1];
zoom_scale := power(2.0, fcp.zoom);
center_base := center_y - ((nrslices - 1) * fcp.height) / (2 * fcp.pixels_per_unit * zoom_scale);
image_height := fcp.Height;
image_Width := fcp.Width;
InitBuffers;
CreateColorMap;
fcp.Prepare;
for i := 0 to NrSlices - 1 do begin
if FStop then
Exit;
Slice := i;
fcp.center[1] := center_base + fcp.height * slice / (fcp.pixels_per_unit * zoom_scale);
CreateCamera;
ClearBuffers;
SetPixelsMT;
if not FStop then begin
FImageMaker.OnProgress := OnProgress;
FImageMaker.CreateImage(Slice * fcp.height);
end;
end;
//fcp.sample_density := fcp.sample_density / nrslices;
fcp.height := fcp.height * nrslices;
end;
///////////////////////////////////////////////////////////////////////////////
function TRendererMM64_MT.GetSlice: integer;
begin
Result := Slice;
end;
///////////////////////////////////////////////////////////////////////////////
function TRendererMM64_MT.GetNrSlices: integer;
begin
Result := NrSlices;
end;
///////////////////////////////////////////////////////////////////////////////
end.

161
2.10/Source/RenderThread.pas
View File

@ -1,7 +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 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
@ -23,7 +23,12 @@ interface
uses uses
Classes, Windows, Messages, Graphics, Classes, Windows, Messages, Graphics,
ControlPoint, Render, Render64, Render64MT, RenderMM, RenderMM_MT; ControlPoint, Render,
Global, RenderTypes,
Render64, Render64MT,
Render48, Render48MT,
Render32, Render32MT,
Render32f, Render32fMT;
const const
WM_THREAD_COMPLETE = WM_APP + 5437; WM_THREAD_COMPLETE = WM_APP + 5437;
@ -36,18 +41,24 @@ type
FOnProgress: TOnProgress; FOnProgress: TOnProgress;
FCP: TControlPoint; FCP: TControlPoint;
Fcompatibility: Integer; // Fcompatibility: Integer;
FMaxMem: int64; FMaxMem: int64;
FNrThreads: Integer; FNrThreads: Integer;
FBitsPerSample: integer;
FMinDensity: double;
FOutput: TStrings;
procedure Render; procedure CreateRenderer;
function GetNrSlices: integer; function GetNrSlices: integer;
function GetSlice: integer; function GetSlice: integer;
procedure Setcompatibility(const Value: Integer); // procedure Setcompatibility(const Value: Integer);
procedure SetMaxMem(const Value: int64); // procedure SetMaxMem(const Value: int64);
procedure SetNrThreads(const Value: Integer); // procedure SetNrThreads(const Value: Integer);
procedure SetBitsPerSample(const bits: Integer);
public public
TargetHandle: HWND; TargetHandle: HWND;
WaitForMore, More: boolean;
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -62,6 +73,9 @@ type
procedure Terminate; procedure Terminate;
procedure Suspend; procedure Suspend;
procedure Resume; procedure Resume;
procedure Break;
procedure GetBucketStats(var Stats: TBucketStats);
property OnProgress: TOnProgress property OnProgress: TOnProgress
read FOnProgress read FOnProgress
@ -73,13 +87,18 @@ type
read GetNrSlices; read GetNrSlices;
property MaxMem: int64 property MaxMem: int64
read FMaxMem read FMaxMem
write SetMaxMem; write FMaxMem;
property compatibility: Integer // property compatibility: Integer read Fcompatibility write Fcompatibility;
read Fcompatibility
write Setcompatibility;
property NrThreads: Integer property NrThreads: Integer
read FNrThreads read FNrThreads
write SetNrThreads; write FNrThreads;
property BitsPerSample: Integer
read FBitsPerSample
write SetBitsPerSample;
property Output: TStrings
write FOutput;
property MinDensity: double
write FMinDensity;
end; end;
implementation implementation
@ -117,50 +136,89 @@ end;
constructor TRenderThread.Create; constructor TRenderThread.Create;
begin begin
MaxMem := 0; MaxMem := 0;
FreeOnTerminate := False; BitsPerSample := InternalBitsPerSample;
FreeOnTerminate := false;
WaitForMore := false;
inherited Create(True); // Create Suspended; inherited Create(True); // Create Suspended;
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.Render; procedure TRenderThread.CreateRenderer;
begin begin
if assigned(FRenderer) then if assigned(FRenderer) then
FRenderer.Free; FRenderer.Free;
if MaxMem = 0 then begin if NrThreads <= 1 then begin
if NrThreads <= 1 then begin if MaxMem = 0 then begin
FRenderer := TRenderer64.Create; case FBitsPerSample of
0: FRenderer := TRenderer32.Create;
1: FRenderer := TRenderer32f.Create;
2: FRenderer := TRenderer48.Create;
3: FRenderer := TRenderer64.Create;
end;
end else begin end else begin
FRenderer := TRenderer64MT.Create; case FBitsPerSample of
TRenderer64MT(FRenderer).NrOfTreads := NrThreads; 0: FRenderer := TRenderer32MM.Create;
1: FRenderer := TRenderer32fMM.Create;
2: FRenderer := TRenderer48MM.Create;
3: FRenderer := TRenderer64MM.Create;
end;
FRenderer.MaxMem := MaxMem;
end; end;
end else begin end
if NrThreads <= 1 then begin else begin
FRenderer := TRendererMM64.Create; if MaxMem = 0 then begin
case FBitsPerSample of
0: FRenderer := TRenderer32MT.Create;
1: FRenderer := TRenderer32fMT.Create;
2: FRenderer := TRenderer48MT.Create;
3: FRenderer := TRenderer64MT.Create;
end;
end else begin end else begin
FRenderer := TRendererMM64_MT.Create; case FBitsPerSample of
TRendererMM64_MT(FRenderer).NrOfTreads := NrThreads; 0: FRenderer := TRenderer32MT_MM.Create;
1: FRenderer := TRenderer32fMT_MM.Create;
2: FRenderer := TRenderer48MT_MM.Create;
3: FRenderer := TRenderer64MT_MM.Create;
end;
FRenderer.MaxMem := MaxMem;
end; end;
FRenderer.MaxMem := MaxMem FRenderer.NumThreads := NrThreads;
end; end;
FRenderer.SetCP(FCP); FRenderer.SetCP(FCP);
FRenderer.compatibility := compatibility; // FRenderer.compatibility := compatibility;
FRenderer.MinDensity := FMinDensity;
FRenderer.OnProgress := FOnProgress; FRenderer.OnProgress := FOnProgress;
Frenderer.Render; FRenderer.Output := FOutput;
if FRenderer.Failed then Terminate; // hmm // FRenderer.Render;
//?... if FRenderer.Failed then Terminate; // hmm
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.Execute; procedure TRenderThread.Execute;
label RenderMore;
begin begin
Render; CreateRenderer;
if Terminated then RenderMore:
PostMessage(TargetHandle, WM_THREAD_TERMINATE, 0, 0) FRenderer.Render;
else
PostMessage(TargetHandle, WM_THREAD_COMPLETE, 0, 0); if Terminated then begin
PostMessage(TargetHandle, WM_THREAD_TERMINATE, 0, 0);
exit;
end
else PostMessage(TargetHandle, WM_THREAD_COMPLETE, 0, 0);
if WaitForMore and (FRenderer <> nil) then begin
FRenderer.RenderMore := true;
inherited Suspend;
if WaitForMore then goto RenderMore;
end;
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
@ -169,13 +227,15 @@ begin
if assigned(FRenderer) then if assigned(FRenderer) then
FRenderer.Stop; FRenderer.Stop;
WaitForMore := false;
inherited Terminate; inherited Terminate;
end; end;
procedure TRenderThread.Suspend; procedure TRenderThread.Suspend;
begin begin
if NrThreads > 1 then if NrThreads > 1 then
if assigned(FRenderer) then FRenderer.Pause(true); if assigned(FRenderer) then FRenderer.Pause;
inherited; inherited;
end; end;
@ -183,16 +243,22 @@ end;
procedure TRenderThread.Resume; procedure TRenderThread.Resume;
begin begin
if NrThreads > 1 then if NrThreads > 1 then
if assigned(FRenderer) then FRenderer.Pause(false); if assigned(FRenderer) then FRenderer.UnPause;
inherited; inherited;
end; end;
procedure TRenderThread.Break;
begin
if assigned(FRenderer) then
FRenderer.Break;
end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetNrSlices: integer; function TRenderThread.GetNrSlices: integer;
begin begin
if assigned(FRenderer) then if assigned(FRenderer) then
Result := FRenderer.Nrslices Result := FRenderer.NrSlices
else else
Result := 1; Result := 1;
end; end;
@ -206,18 +272,6 @@ begin
Result := 1; Result := 1;
end; end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.Setcompatibility(const Value: Integer);
begin
Fcompatibility := Value;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.SetMaxMem(const Value: int64);
begin
FMaxMem := Value;
end;
////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////
function TRenderThread.GetRenderer: TBaseRenderer; function TRenderThread.GetRenderer: TBaseRenderer;
begin begin
@ -226,9 +280,10 @@ begin
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.SetNrThreads(const Value: Integer); procedure TRenderThread.SetBitsPerSample(const bits: Integer);
begin begin
FNrThreads := Value; if FRenderer = nil then FBitsPerSample := bits
else assert(false);
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
@ -239,4 +294,10 @@ begin
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TRenderThread.GetBucketStats(var Stats: TBucketStats);
begin
if assigned(FRenderer) then
FRenderer.GetBucketStats(Stats);
end;
end. end.

70
2.10/Source/ScriptForm.dfm
View File

@ -20,7 +20,7 @@ object ScriptEditor: TScriptEditor
TextHeight = 13 TextHeight = 13
object Splitter1: TSplitter object Splitter1: TSplitter
Left = 0 Left = 0
Top = 244 Top = 250
Width = 531 Width = 531
Height = 4 Height = 4
Cursor = crVSplit Cursor = crVSplit
@ -30,7 +30,7 @@ object ScriptEditor: TScriptEditor
Left = 508 Left = 508
Top = 0 Top = 0
Width = 23 Width = 23
Height = 244 Height = 250
Align = alRight Align = alRight
AutoSize = True AutoSize = True
Caption = 'ToolBar' Caption = 'ToolBar'
@ -96,7 +96,7 @@ object ScriptEditor: TScriptEditor
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Top = 337 Top = 343
Width = 531 Width = 531
Height = 19 Height = 19
Anchors = [akLeft, akRight] Anchors = [akLeft, akRight]
@ -106,7 +106,7 @@ object ScriptEditor: TScriptEditor
Left = 0 Left = 0
Top = 0 Top = 0
Width = 508 Width = 508
Height = 244 Height = 250
Align = alClient Align = alClient
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvLowered BevelOuter = bvLowered
@ -116,7 +116,7 @@ object ScriptEditor: TScriptEditor
Left = 2 Left = 2
Top = 2 Top = 2
Width = 504 Width = 504
Height = 240 Height = 246
Cursor = crIBeam Cursor = crIBeam
PopupMenu = PopupMenu PopupMenu = PopupMenu
ActiveLineSettings.ShowActiveLine = False ActiveLineSettings.ShowActiveLine = False
@ -144,6 +144,11 @@ object ScriptEditor: TScriptEditor
Gutter.Font.Height = -13 Gutter.Font.Height = -13
Gutter.Font.Name = 'Courier New' Gutter.Font.Name = 'Courier New'
Gutter.Font.Style = [] Gutter.Font.Style = []
Gutter.LineNumberStart = 1
Gutter.LineNumberTextColor = clBlack
Gutter.ShowLineNumbers = True
Gutter.Visible = True
Gutter.ShowLeadingZeros = False
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack Font.Color = clBlack
Font.Height = -13 Font.Height = -13
@ -185,14 +190,14 @@ object ScriptEditor: TScriptEditor
UrlStyle.BkColor = clWhite UrlStyle.BkColor = clWhite
UrlStyle.Style = [fsUnderline] UrlStyle.Style = [fsUnderline]
UseStyler = True UseStyler = True
Version = '2.0.0.1' Version = '1.6.0.17'
WordWrap = wwNone WordWrap = wwNone
OnChange = EditorChange OnChange = EditorChange
end end
end end
object Console: TMemo object Console: TMemo
Left = 0 Left = 0
Top = 248 Top = 254
Width = 531 Width = 531
Height = 89 Height = 89
Align = alBottom Align = alBottom
@ -356,9 +361,7 @@ object ScriptEditor: TScriptEditor
end> end>
AutoCompletion.Strings = ( AutoCompletion.Strings = (
'ShowMessage' 'ShowMessage'
'MessageDlg' 'MessageDlg')
'Flame'
'Transform')
HintParameter.TextColor = clBlack HintParameter.TextColor = clBlack
HintParameter.BkColor = clInfoBk HintParameter.BkColor = clInfoBk
HintParameter.HintCharStart = '(' HintParameter.HintCharStart = '('
@ -376,53 +379,6 @@ object ScriptEditor: TScriptEditor
DefaultExtension = '.pas' DefaultExtension = '.pas'
StylerName = 'Pascal' StylerName = 'Pascal'
Extensions = 'pas;dpr;dpk;inc' Extensions = 'pas;dpr;dpk;inc'
RegionDefinitions = <
item
Identifier = 'procedure'
RegionStart = 'begin'
RegionEnd = 'end'
RegionType = rtClosed
ShowComments = False
end
item
Identifier = 'interface'
RegionStart = 'interface'
RegionType = rtOpen
ShowComments = False
end
item
Identifier = 'unit'
RegionStart = 'unit'
RegionType = rtFile
ShowComments = False
end
item
Identifier = 'implementation'
RegionStart = 'implementation'
RegionType = rtOpen
ShowComments = False
end
item
Identifier = 'case'
RegionStart = 'case'
RegionEnd = 'end'
RegionType = rtIgnore
ShowComments = False
end
item
Identifier = 'function'
RegionStart = 'begin'
RegionEnd = 'end'
RegionType = rtClosed
ShowComments = False
end
item
Identifier = '{$region'
RegionStart = '{$region'
RegionEnd = '{$endregion'
RegionType = rtClosed
ShowComments = False
end>
Left = 328 Left = 328
Top = 32 Top = 32
end end

46
2.10/Source/ScriptForm.pas
View File

@ -51,9 +51,6 @@ type
y: byte; y: byte;
Gradient: byte; Gradient: byte;
Background: byte; Background: byte;
estimator_radius: byte;
estimator_min: byte;
estimator_curve: byte;
end; end;
TScriptRender = class TScriptRender = class
public public
@ -157,12 +154,6 @@ type
procedure GetFlameURLProc(AMachine: TatVirtualMachine); procedure GetFlameURLProc(AMachine: TatVirtualMachine);
procedure SetFlameBatchesProc(AMachine: TatVirtualMachine); procedure SetFlameBatchesProc(AMachine: TatVirtualMachine);
procedure GetFlameBatchesProc(AMachine: TatVirtualMachine); procedure GetFlameBatchesProc(AMachine: TatVirtualMachine);
procedure GetFlameEstimatorRadius(AMachine: TatVirtualMachine);
procedure SetFlameEstimatorRadius(AMachine: TatVirtualMachine);
procedure GetFlameEstimatorMin(AMachine: TatVirtualMachine);
procedure SetFlameEstimatorMin(AMachine: TatVirtualMachine);
procedure GetFlameEstimatorCurve(AMachine: TatVirtualMachine);
procedure SetFlameEstimatorCurve(AMachine: TatVirtualMachine);
{ Transform interface } { Transform interface }
procedure GetTransformAProc(AMachine: TatVirtualMachine); procedure GetTransformAProc(AMachine: TatVirtualMachine);
@ -1128,13 +1119,13 @@ end;
procedure TScriptEditor.GetExportPath(AMachine: TatVirtualMachine); procedure TScriptEditor.GetExportPath(AMachine: TatVirtualMachine);
begin begin
with AMachine do with AMachine do
ReturnOutPutArg(HqiPath); ReturnOutPutArg(flam3Path);
end; end;
procedure TScriptEditor.SetExportPath(AMachine: TatVirtualMachine); procedure TScriptEditor.SetExportPath(AMachine: TatVirtualMachine);
begin begin
with AMachine do with AMachine do
HqiPath := GetInputArgAsString(0); flam3Path := GetInputArgAsString(0);
end; end;
{ ***************************** Operation Library **************************** } { ***************************** Operation Library **************************** }
@ -2398,36 +2389,6 @@ begin
cp.nbatches := GetInputArgAsInteger(0); cp.nbatches := GetInputArgAsInteger(0);
end; end;
procedure TScriptEditor.GetFlameEstimatorRadius(AMachine: TatVirtualMachine);
begin
AMachine.ReturnOutputArg(cp.estimator);
end;
procedure TScriptEditor.SetFlameEstimatorRadius(AMachine: TatVirtualMachine);
begin
cp.estimator := AMachine.GetInputArgAsFloat(0);
end;
procedure TScriptEditor.GetFlameEstimatorMin(AMachine: TatVirtualMachine);
begin
AMachine.ReturnOutputArg(cp.estimator_min);
end;
procedure TScriptEditor.SetFlameEstimatorMin(AMachine: TatVirtualMachine);
begin
cp.estimator_min := AMachine.GetInputArgAsFloat(0);
end;
procedure TScriptEditor.GetFlameEstimatorCurve(AMachine: TatVirtualMachine);
begin
AMachine.ReturnOutputArg(cp.estimator_curve);
end;
procedure TScriptEditor.SetFlameEstimatorCurve(AMachine: TatVirtualMachine);
begin
cp.estimator_curve := AMachine.GetInputArgAsFloat(0);
end;
{ *************************** Transform interface **************************** } { *************************** Transform interface **************************** }
@ -2671,9 +2632,6 @@ begin
DefineProp('URL', tkString, GetFlameURLProc, SetFlameURLProc); DefineProp('URL', tkString, GetFlameURLProc, SetFlameURLProc);
DefineProp('Hue', tkFloat, GetFlameHueProc, SetFlameHueProc); DefineProp('Hue', tkFloat, GetFlameHueProc, SetFlameHueProc);
DefineProp('Batches', tkInteger, GetFlameBatchesProc, SetFlameBatchesProc); DefineProp('Batches', tkInteger, GetFlameBatchesProc, SetFlameBatchesProc);
DefineProp('estimator_radius', tkFloat, GetFlameEstimatorRadius, SetFlameEstimatorRadius);
DefineProp('estimator_min', tkFloat, GetFlameEstimatorMin, SetFlameEstimatorMin);
DefineProp('estimator_curve', tkFloat, GetFlameEstimatorCurve, SetFlameEstimatorCurve);
end; end;
Scripter.AddObject('Flame', Flame); Scripter.AddObject('Flame', Flame);
{ Transform interface } { Transform interface }

2
2.10/Source/ScriptRender.pas
View File

@ -91,7 +91,7 @@ begin
cp.AdjustScale(ScriptEditor.Renderer.Width, ScriptEditor.Renderer.Height); cp.AdjustScale(ScriptEditor.Renderer.Width, ScriptEditor.Renderer.Height);
Renderer.OnProgress := OnProgress; Renderer.OnProgress := OnProgress;
Renderer.Compatibility := Compatibility; // Renderer.Compatibility := Compatibility;
Renderer.SetCP(cp); Renderer.SetCP(cp);
if (ScriptEditor.Renderer.MaxMemory > 0) then Renderer.MaxMem := ScriptEditor.Renderer.MaxMemory; if (ScriptEditor.Renderer.MaxMemory > 0) then Renderer.MaxMem := ScriptEditor.Renderer.MaxMemory;
Renderer.TargetHandle := Handle; Renderer.TargetHandle := Handle;

78
2.10/Source/XForm.pas
View File

@ -34,8 +34,8 @@ type
color: double; // color coord for this function. 0 - 1 color: double; // color coord for this function. 0 - 1
color2: double; // Second color coord for this function. 0 - 1 color2: double; // Second color coord for this function. 0 - 1
symmetry: double; symmetry: double;
c00, c01, c10, c11, c20, c21: double; c00, c01, c10, c11, c20, c21: double;// unnecessary duplicated variables
p00, p01, p10, p11, p20, p21: double; p00, p01, p10, p11, p20, p21: double;// :-)
// nx,ny,x,y: double; // nx,ny,x,y: double;
// script: TatPascalScripter; // script: TatPascalScripter;
@ -62,6 +62,9 @@ type
cosine_var2, cosine_var2,
polar_vpi: double; polar_vpi: double;
gauss_rnd: array [0..3] of double;
gauss_N: integer;
FRegVariations: array of TBaseVariation; FRegVariations: array of TBaseVariation;
procedure PrecalcAngle; procedure PrecalcAngle;
@ -97,7 +100,7 @@ type
procedure Cylinder; // var[25] procedure Cylinder; // var[25]
procedure Noise; // var[26] procedure Noise; // var[26]
procedure Blur; // var[27] procedure Blur; // var[27]
// procedure Focus; // var[28] procedure Gaussian; // var[28]
function Mul33(const M1, M2: TMatrix): TMatrix; function Mul33(const M1, M2: TMatrix): TMatrix;
function Identity: TMatrix; function Identity: TMatrix;
@ -125,8 +128,8 @@ type
procedure Multiply(const a, b, c, d: double); procedure Multiply(const a, b, c, d: double);
procedure Scale(const s: double); procedure Scale(const s: double);
procedure SetVariable(const name: string; var Value: double);
procedure GetVariable(const name: string; var Value: double); procedure GetVariable(const name: string; var Value: double);
procedure SetVariable(const name: string; var Value: double);
procedure ResetVariable(const name: string); procedure ResetVariable(const name: string);
function ToXMLString: string; function ToXMLString: string;
@ -253,6 +256,12 @@ begin
polar_vpi := vars[5]/pi; polar_vpi := vars[5]/pi;
gauss_rnd[0] := random;
gauss_rnd[1] := random;
gauss_rnd[2] := random;
gauss_rnd[3] := random;
gauss_N := 0;
if (p[0,0]<>1) or (p[0,1]<>0) or(p[1,0]<>0) or (p[1,1]<>1) or (p[2,0]<>0) or (p[2,1]<>0) then if (p[0,0]<>1) or (p[0,1]<>0) or(p[1,0]<>0) or (p[1,1]<>1) or (p[2,0]<>0) or (p[2,1]<>0) then
begin begin
p00 := p[0][0]; p00 := p[0][0];
@ -1543,31 +1552,34 @@ asm
{$endif} {$endif}
end; end;
(*
//--28--/////////////////////////////////////////////////////////////////////// //--28--///////////////////////////////////////////////////////////////////////
procedure TXForm.Focus; procedure TXForm.Gaussian;
{$ifndef _ASM_} {$ifndef _ASM_}
var var
r, sinr, cosr: double; r, sina, cosa: double;
begin begin
SinCos(random * 2*pi, sinr, cosr); SinCos(random * 2*pi, sina, cosa);
r := vars[28] * random * sqrt(sqr(FTx) + sqr(FTy)); r := vars[28] * (random + random + random + random - 2);
FPx := FPx + r * cosr; FPx := FPx + r * cosa;
FPy := FPy + r * sinr; FPy := FPy + r * sina;
{$else} {$else}
asm asm
fld qword ptr [ebx + gauss_rnd]
fadd qword ptr [ebx + gauss_rnd+8]
fadd qword ptr [ebx + gauss_rnd+16]
fadd qword ptr [ebx + gauss_rnd+24]
fld1
fadd st,st
fsubp st(1),st
mov edx, [ebx + vars] mov edx, [ebx + vars]
fld qword ptr [edx + 28*8] fmul qword ptr [edx + 28*8]
call System.@RandExt
fmulp
fld qword ptr [ebx + FTx]
fmul st, st
fld qword ptr [ebx + FTy]
fmul st, st
faddp
fsqrt
fmulp
call System.@RandExt call System.@RandExt
mov edx, [ebx + gauss_N]
fst qword ptr [ebx + gauss_rnd + edx*8]
inc edx
and edx,$03
mov [eax + gauss_N], edx
fadd st, st fadd st, st
fldpi fldpi
fmulp fmulp
@ -1581,7 +1593,6 @@ asm
fwait fwait
{$endif} {$endif}
end; end;
*)
//***************************************************************************// //***************************************************************************//
@ -1916,8 +1927,6 @@ end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TXForm.BuildFunctionlist; procedure TXForm.BuildFunctionlist;
var
i: integer;
begin begin
SetLength(FFunctionList, NrVar + Length(FRegVariations)); SetLength(FFunctionList, NrVar + Length(FRegVariations));
@ -1950,7 +1959,7 @@ begin
FFunctionList[25] := Cylinder; FFunctionList[25] := Cylinder;
FFunctionList[26] := Noise; FFunctionList[26] := Noise;
FFunctionList[27] := Blur; FFunctionList[27] := Blur;
// FFunctionList[28] := Focus; FFunctionList[28] := Gaussian;
//registered //registered
// for i := 0 to High(FRegVariations) do // for i := 0 to High(FRegVariations) do
@ -2059,15 +2068,6 @@ begin
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TXForm.SetVariable(const name: string; var Value: double);
var
i: integer;
begin
for i := 0 to High(FRegVariations) do
if FRegVariations[i].SetVariable(name, value) then
break;
end;
procedure TXForm.GetVariable(const name: string; var Value: double); procedure TXForm.GetVariable(const name: string; var Value: double);
var var
i: integer; i: integer;
@ -2077,6 +2077,15 @@ begin
break; break;
end; end;
procedure TXForm.SetVariable(const name: string; var Value: double);
var
i: integer;
begin
for i := 0 to High(FRegVariations) do
if FRegVariations[i].SetVariable(name, value) then
break;
end;
procedure TXForm.ResetVariable(const name: string); procedure TXForm.ResetVariable(const name: string);
var var
i: integer; i: integer;
@ -2087,4 +2096,5 @@ begin
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
end. end.

5
2.10/Source/XFormMan.pas
View File

@ -6,7 +6,7 @@ uses
BaseVariation; BaseVariation;
const const
NRLOCVAR = 28; NRLOCVAR = 29;
function NrVar: integer; function NrVar: integer;
function Varnames(const index: integer): String; function Varnames(const index: integer): String;
@ -62,7 +62,8 @@ const
'bubble', 'bubble',
'cylinder', 'cylinder',
'noise', 'noise',
'blur' 'blur',
'gaussian_blur'
); );
begin begin
if Index < NRLOCVAR then if Index < NRLOCVAR then

4
2.10/Source/formPostProcess.dfm
View File

@ -1,6 +1,6 @@
object frmPostProcess: TfrmPostProcess object frmPostProcess: TfrmPostProcess
Left = 61 Left = 76
Top = 77 Top = 103
Width = 640 Width = 640
Height = 534 Height = 534
Caption = 'Post Render' Caption = 'Post Render'

4
2.10/Source/formPostProcess.pas
View File

@ -184,8 +184,10 @@ end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
procedure TfrmPostProcess.UpdateFlame; procedure TfrmPostProcess.UpdateFlame;
begin begin
Screen.Cursor := crHourGlass;
FRenderer.UpdateImage(FCP); FRenderer.UpdateImage(FCP);
Image.Picture.Graphic := FRenderer.GetImage; Image.Picture.Graphic := FRenderer.GetImage;
Screen.Cursor := crDefault;
end; end;
/////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////
@ -425,7 +427,7 @@ begin
if pValue^ = pDefaultValue^ then exit; if pValue^ = pDefaultValue^ then exit;
pValue^ := pDefaultValue^; pValue^ := pDefaultValue^;
pEdit^.Text := FloatToStr(pValue^); pEdit^.Text := FloatToStr(pValue^);
UpdateFlame; //UpdateFlame;
end; end;
end. end.

68
2.10/Source/varJuliaN.pas
View File

@ -90,10 +90,10 @@ begin
FPy^ := FPy^ + r * sina; FPy^ := FPy^ + r * sina;
{$else} {$else}
asm asm
mov edx, [eax + FTy]
fld qword ptr [edx]
fld qword ptr [eax + cn]
mov edx, [eax + FTx] mov edx, [eax + FTx]
fld qword ptr [edx + 8]
fld qword ptr [eax + cn]
// mov edx, [eax + FTx]
fld qword ptr [edx] fld qword ptr [edx]
fld st(2) fld st(2)
fld st(1) fld st(1)
@ -136,9 +136,9 @@ asm
fadd qword ptr [edx] fadd qword ptr [edx]
fstp qword ptr [edx] fstp qword ptr [edx]
fmulp fmulp
mov edx, [ecx + FPy] // mov edx, [ecx + FPy]
fadd qword ptr [edx] fadd qword ptr [edx + 8]
fstp qword ptr [edx] fstp qword ptr [edx + 8]
fwait fwait
{$endif} {$endif}
end; end;
@ -156,9 +156,9 @@ begin
FPy^ := FPy^ + r * sina; FPy^ := FPy^ + r * sina;
{$else} {$else}
asm asm
mov edx, [eax + FTy]
fld qword ptr [edx]
mov edx, [eax + FTx] mov edx, [eax + FTx]
fld qword ptr [edx + 8]
// mov edx, [eax + FTx]
fld qword ptr [edx] fld qword ptr [edx]
fld st(1) fld st(1)
fld st(1) fld st(1)
@ -192,9 +192,9 @@ asm
fadd qword ptr [edx] fadd qword ptr [edx]
fstp qword ptr [edx] fstp qword ptr [edx]
fmulp fmulp
mov edx, [ecx + FPy] // mov edx, [ecx + FPy]
fadd qword ptr [edx] fadd qword ptr [edx + 8]
fstp qword ptr [edx] fstp qword ptr [edx + 8]
fwait fwait
{$endif} {$endif}
end; end;
@ -212,9 +212,9 @@ begin
FPy^ := FPy^ - r * sina; FPy^ := FPy^ - r * sina;
{$else} {$else}
asm asm
mov edx, [eax + FTy]
fld qword ptr [edx]
mov edx, [eax + FTx] mov edx, [eax + FTx]
fld qword ptr [edx + 8]
// mov edx, [eax + FTx]
fld qword ptr [edx] fld qword ptr [edx]
fld st(1) fld st(1)
fld st(1) fld st(1)
@ -248,9 +248,9 @@ asm
fadd qword ptr [edx] fadd qword ptr [edx]
fstp qword ptr [edx] fstp qword ptr [edx]
fmulp fmulp
mov edx, [ecx + FPy] // mov edx, [ecx + FPy]
fsubr qword ptr [edx] fsubr qword ptr [edx + 8]
fstp qword ptr [edx] fstp qword ptr [edx + 8]
fwait fwait
{$endif} {$endif}
end; end;
@ -262,19 +262,19 @@ begin
FPy^ := FPy^ + vvar * FTy^; FPy^ := FPy^ + vvar * FTy^;
{$else} {$else}
asm asm
mov edx, [eax + FTy] mov edx, [eax + FTx] //[eax + FTy]
fld qword ptr [edx]
mov edx, [eax + FTx]
fld qword ptr [edx] fld qword ptr [edx]
// mov edx, [eax + FTx]
fld qword ptr [edx + 8]
fld qword ptr [eax + vvar] fld qword ptr [eax + vvar]
fmul st(2), st fmul st(2), st
fmulp fmulp
mov edx, [eax + FPx] // mov edx, [eax + FPx]
fadd qword ptr [edx] fadd qword ptr [edx + 16]
fstp qword ptr [edx] fstp qword ptr [edx + 16]
mov edx, [eax + FPy] // mov edx, [eax + FPy]
fadd qword ptr [edx] fadd qword ptr [edx + 24]
fstp qword ptr [edx] fstp qword ptr [edx + 24]
fwait fwait
{$endif} {$endif}
end; end;
@ -290,10 +290,10 @@ begin
FPy^ := FPy^ - r * FTy^; FPy^ := FPy^ - r * FTy^;
{$else} {$else}
asm asm
mov edx, [eax + FTy]
fld qword ptr [edx]
mov edx, [eax + FTx] mov edx, [eax + FTx]
fld qword ptr [edx] fld qword ptr [edx + 8] // FTy
// mov edx, [eax + FTx]
fld qword ptr [edx] // FTx
fld st(1) fld st(1)
fmul st, st fmul st, st
fld st(1) fld st(1)
@ -302,12 +302,12 @@ asm
fdivr qword ptr [eax + vvar] fdivr qword ptr [eax + vvar]
fmul st(2), st fmul st(2), st
fmulp fmulp
mov edx, [eax + FPx] // mov edx, [eax + FPx]
fadd qword ptr [edx] fadd qword ptr [edx + 16] // FPx
fstp qword ptr [edx] fstp qword ptr [edx + 16] // FPx
mov edx, [eax + FPy] // mov edx, [eax + FPy]
fsubr qword ptr [edx] fsubr qword ptr [edx + 24] // FPy
fstp qword ptr [edx] fstp qword ptr [edx + 24] // FPy
fwait fwait
{$endif} {$endif}
end; end;