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

18
2.10/Source/BaseVariation.pas
View File

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

5
2.10/Source/Browser.pas
View File

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

80
2.10/Source/BucketFillerThread.pas
View File

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

14
2.10/Source/ControlPoint.pas
View File

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

26
2.10/Source/Editor.dfm
View File

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

78
2.10/Source/Editor.pas
View File

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

829
2.10/Source/FormRender.dfm
View File

@ -1,11 +1,11 @@
object RenderForm: TRenderForm
Left = 287
Top = 252
Left = 431
Top = 336
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'RenderForm'
ClientHeight = 414
ClientWidth = 422
ClientHeight = 449
ClientWidth = 434
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@ -51,395 +51,54 @@ object RenderForm: TRenderForm
TextHeight = 13
object ProgressBar: TProgressBar
Left = 0
Top = 382
Width = 422
Top = 417
Width = 434
Height = 13
Align = alBottom
TabOrder = 0
end
object btnRender: TButton
Left = 256
Top = 356
Left = 264
Top = 388
Width = 75
Height = 23
Caption = 'Render'
Default = True
TabOrder = 5
TabOrder = 1
OnClick = btnRenderClick
end
object btnCancel: TButton
Left = 344
Top = 354
Left = 352
Top = 386
Width = 75
Height = 25
Caption = 'Close'
TabOrder = 6
TabOrder = 2
OnClick = btnCancelClick
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
Left = 168
Top = 354
Left = 176
Top = 386
Width = 75
Height = 25
Caption = 'Pause'
TabOrder = 7
TabOrder = 3
OnClick = btnPauseClick
end
object chkSave: TCheckBox
Left = 8
Top = 322
Top = 358
Width = 113
Height = 17
Caption = 'Save parameters'
Checked = True
State = cbChecked
TabOrder = 8
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
TabOrder = 4
end
object StatusBar: TStatusBar
Left = 0
Top = 395
Width = 422
Top = 430
Width = 434
Height = 19
Panels = <
item
@ -454,33 +113,455 @@ object RenderForm: TRenderForm
end
object chkShutdown: TCheckBox
Left = 8
Top = 360
Top = 396
Width = 137
Height = 17
Caption = 'Shutdown on complete'
TabOrder = 10
TabOrder = 6
end
object cbPostProcess: TCheckBox
Left = 8
Top = 340
Width = 97
Top = 377
Width = 121
Height = 17
Caption = 'Post render'
TabOrder = 9
Caption = 'Postprocess render'
TabOrder = 5
end
object chkSaveIncompleteRenders: TCheckBox
Left = 272
Top = 328
Width = 145
Left = 288
Top = 358
Width = 137
Height = 17
Alignment = taLeftJustify
Caption = 'Save incomplete renders'
TabOrder = 13
Visible = False
Caption = 'Save incomplete render'
TabOrder = 8
OnClick = chkSaveIncompleteRendersClick
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
Left = 376
Top = 304
Left = 136
Top = 360
end
end

217
2.10/Source/FormRender.pas
View File

@ -1,5 +1,6 @@
{
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
it under the terms of the GNU General Public License as published by
@ -21,15 +22,28 @@ interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ControlPoint, RenderThread, ComCtrls, Math, Buttons, Registry, cmap,
ExtCtrls, MMSystem,
Render; // 'use'd only for SizeOf()
StdCtrls, ComCtrls, Math, Buttons, Registry, ExtCtrls, MMSystem,
ControlPoint, RenderThread, cmap, RenderTypes;
type
TRenderForm = class(TForm)
ProgressBar: TProgressBar;
btnRender: 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;
btnBrowse: TSpeedButton;
Label10: TLabel;
@ -37,34 +51,29 @@ type
GroupBox2: TGroupBox;
Label1: TLabel;
Label2: TLabel;
chkMaintain: TCheckBox;
cbWidth: TComboBox;
cbHeight: TComboBox;
GroupBox3: TGroupBox;
Label3: TLabel;
Label5: TLabel;
Label4: TLabel;
txtOversample: TEdit;
txtFilterRadius: TEdit;
udOversample: TUpDown;
txtDensity: TComboBox;
GroupBox4: TGroupBox;
lblApproxMem: TLabel;
lblPhysical: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
lblMaxbits: TLabel;
Label9: TLabel;
cbMaxMemory: TComboBox;
chkLimitMem: TCheckBox;
SaveDialog: TSaveDialog;
btnPause: TButton;
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;
cbBitsPerSample: TComboBox;
Output: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnRenderClick(Sender: TObject);
@ -86,9 +95,12 @@ type
procedure cmbPresetChange(Sender: TObject);
procedure chkMaintainClick(Sender: TObject);
procedure chkSaveIncompleteRendersClick(Sender: TObject);
procedure cbBitsPerSampleSelect(Sender: TObject);
private
StartTime, oldElapsed, edt: TDateTime;
StartTime, EndTime, oldElapsed, edt: TDateTime;
oldProg: double;
ApproxSamples: int64;
SaveIncompleteRenders: boolean;
procedure DoPostProcess;
@ -99,6 +111,7 @@ type
message WM_THREAD_TERMINATE;
procedure ListPresets;
function WindowsExit(RebootParam: Longword = EWX_POWEROFF or EWX_FORCE): Boolean;
public
Renderer: TRenderThread;
PhysicalMemory, ApproxMemory: int64;
@ -106,14 +119,19 @@ type
cp: TControlPoint;
Filename: string;
ImageWidth, ImageHeight, Oversample: Integer;
BitsPerSample: integer;
zoom, Sample_Density, Brightness, Gamma, Vibrancy, Filter_Radius: double;
center: array[0..1] of double;
MaxMemory: integer;
procedure OnProgress(prog: double);
procedure ShowMemoryStatus;
procedure ResetControls;
end;
const
ShowRenderStats = true;
var
RenderForm: TRenderForm;
Ratio: double;
@ -136,6 +154,7 @@ begin
txtOversample.Enabled := true;
chkLimitMem.Enabled := true;
cbMaxMemory.enabled := chkLimitMem.Checked;
cbBitsPerSample.Enabled := true;
cbPostProcess.Enabled := not chkLimitMem.Checked;
btnRender.Enabled := true;
cmbPreset.enabled := true;
@ -157,22 +176,59 @@ begin
GlobalMemoryInfo.dwLength := SizeOf(GlobalMemoryInfo);
GlobalMemoryStatus(GlobalMemoryInfo);
PhysicalMemory := GlobalMemoryInfo.dwAvailPhys div 1048576;
ApproxMemory := int64(ImageHeight) * int64(ImageWidth) * int64(Oversample * Oversample
* SizeOf(TBucket)) div 1048576;
ApproxMemory := int64(ImageHeight) * int64(ImageWidth) * sqr(Oversample) * SizeOfBucket[BitsPerSample] div 1048576;
lblPhysical.Caption := 'Physical memory available: ' + Format('%u', [PhysicalMemory]) + ' Mb';
lblApproxMem.Caption := 'Approximate memory required: ' + Format('%u', [ApproxMemory]) + ' Mb';
lblPhysical.Caption := Format('%u', [PhysicalMemory]) + ' Mb';
lblApproxMem.Caption := Format('%u', [ApproxMemory]) + ' Mb';
if ApproxMemory > PhysicalMemory then lblPhysical.Font.Color := clRed
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;
procedure TRenderForm.HandleThreadCompletion(var Message: TMessage);
var
Stats: TBucketStats;
begin
if not chkLimitMem.Checked and cbPostProcess.checked then
DoPostProcess;
Renderer.SaveImage(FileName);
EndTime := Now;
// Output.Lines.Add(TimeToStr(EndTime) + ' : Saving image');
try
Renderer.SaveImage(FileName);
except
Output.Lines.Add(TimeToStr(Now) + ' : Error saving image!');
end;
if PlaySoundOnRenderComplete then
if RenderCompleteSoundFile <> '' then
@ -180,6 +236,30 @@ begin
else
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 := nil;
ResetControls;
@ -191,8 +271,15 @@ procedure TRenderForm.HandleThreadTermination(var Message: TMessage);
begin
if Assigned(Renderer) then
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 := nil;
ResetControls;
@ -251,6 +338,8 @@ procedure TRenderForm.FormCreate(Sender: TObject);
begin
cp := TControlPoint.Create;
cbMaxMemory.ItemIndex := 1;
cbBitsPerSample.ItemIndex := 0;
BitsPerSample := 0;
MainForm.Buttons.GetBitmap(2, btnSavePreset.Glyph);
MainForm.Buttons.GetBitmap(9, btnDeletePreset.Glyph);
ListPresets;
@ -323,6 +412,16 @@ begin
Application.MessageBox('Invalid image height', 'Apophysis', 16);
exit;
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;
btnBrowse.Enabled := false;
cbWidth.Enabled := False;
@ -332,6 +431,7 @@ begin
txtOversample.Enabled := false;
chkLimitMem.Enabled := false;
cbMaxMemory.Enabled := false;
cbBitsPerSample.Enabled := false;
cmbPreset.enabled := false;
chkSave.enabled := false;
// cbPostProcess.enabled := false;
@ -343,7 +443,26 @@ begin
btnCancel.Caption := 'Stop';
StartTime := Now;
// 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
Output.Lines.Add(TimeToStr(Now) + 'Shutting down previous render...'); // hmm
Renderer.Terminate;
Renderer.WaitFor;
Renderer.Free;
@ -357,6 +476,7 @@ begin
cp.spatial_oversample := Oversample;
cp.spatial_filter_radius := Filter_Radius;
cp.AdjustScale(ImageWidth, ImageHeight);
cp.Transparency := (PNGTransparency <> 0) and (UpperCase(ExtractFileExt(FileName)) = '.PNG');
renderPath := ExtractFilePath(Filename);
if chkSave.checked then
MainForm.SaveXMLFlame(cp, ExtractFileName(FileName), renderPath + 'renders.flame');
@ -364,23 +484,28 @@ begin
oldProg:=0;
oldElapsed:=0;
edt:=0;
ApproxSamples := Round(sample_density * sqr(power(2, cp.zoom)) * int64(ImageHeight) * int64(ImageWidth) / sqr(oversample) );
try
Renderer := TRenderThread.Create;
assert(Renderer <> nil);
Renderer.BitsPerSample := BitsPerSample;
if chkLimitMem.checked then
Renderer.MaxMem := StrToInt(cbMaxMemory.text);
Renderer.MaxMem := MaxMemory;//StrToInt(cbMaxMemory.text);
Renderer.OnProgress := OnProgress;
Renderer.TargetHandle := self.Handle;
Renderer.Compatibility := compatibility;
// Renderer.Output := Output.Lines;
// Renderer.Compatibility := compatibility;
Renderer.SetCP(cp);
Renderer.Priority := tpLower;
Renderer.NrThreads := NrTreads;
Renderer.Resume;
Renderer.Output := Output.Lines;
Renderer.Resume;
except
Application.MessageBox('Error while rendering!', 'Apophysis', 48)
Output.Lines.Add(TimeToStr(Now) + ' : Rendering failed!');
Application.MessageBox('Error while rendering!', 'Apophysis', 48)
end;
// enable screensaver
@ -421,6 +546,8 @@ begin
ImageHeight := StrToInt(cbHeight.Text);
sample_density := renderDensity;
txtDensity.Text := FloatToStr(sample_density);
BitsPerSample := renderBitsPerSample;
cbBitsPerSample.ItemIndex := BitsPerSample;
ShowMemoryStatus;
Ratio := ImageWidth / ImageHeight;
end;
@ -496,8 +623,17 @@ begin
Renderer.Resume;
btnPause.caption := 'Pause';
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
else close;
end;
@ -508,6 +644,7 @@ begin
Sample_Density := StrToFloat(txtDensity.Text);
except
end;
ShowMemoryStatus;
end;
procedure TRenderForm.txtFilterRadiusChange(Sender: TObject);
@ -532,6 +669,7 @@ begin
renderHeight := ImageHeight;
renderDensity := Sample_density;
renderOversample := Oversample;
renderBitsPerSample := BitsPerSample;
{ Write position to registry }
Registry := TRegistry.Create;
try
@ -791,5 +929,12 @@ begin
SaveIncompleteRenders := chkSaveIncompleteRenders.Checked;
end;
procedure TRenderForm.cbBitsPerSampleSelect(Sender: TObject);
begin
BitsPerSample := cbBitsPerSample.ItemIndex;
ShowMemoryStatus;
end;
end.

30
2.10/Source/Fullscreen.dfm
View File

@ -12,8 +12,10 @@ object FullscreenForm: TFullscreenForm
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PopupMenu = FullscreenPopup
OnClose = FormClose
OnCreate = FormCreate
OnDblClick = ImageDblClick
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
OnShow = FormShow
@ -24,6 +26,34 @@ object FullscreenForm: TFullscreenForm
Top = 0
Width = 186
Height = 131
PopupMenu = FullscreenPopup
OnDblClick = ImageDblClick
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

129
2.10/Source/Fullscreen.pas
View File

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

7
2.10/Source/Global.pas
View File

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

634
2.10/Source/ImageMaker.pas
View File

@ -3,7 +3,12 @@ unit ImageMaker;
interface
uses
Windows, Graphics, ControlPoint, Render;
Windows, Graphics, ControlPoint, RenderTypes;
type TPalette = record
logpal : TLogPalette;
colors: array[0..255] of TPaletteEntry;
end;
type
TImageMaker = class
@ -14,14 +19,27 @@ type
FBitmap: TBitmap;
FAlphaBitmap: TBitmap;
AlphaPalette: TPalette;
FTransparentImage: TBitmap;
Fcp: Tcontrolpoint;
FCP: TControlPoint;
FBucketHeight: integer;
FBucketWidth: integer;
FBuckets: TBucketArray;
FBuckets64: TBucket64Array;
FBuckets48: TBucket48Array;
FBuckets32: TBucket32Array;
FBuckets32f: TBucket32fArray;
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 NormalizeFilter;
@ -31,27 +49,26 @@ type
function GetTransparentImage: TBitmap;
procedure CreateImage_MB(YOffset: integer = 0);
procedure CreateImage_Flame3(YOffset: integer = 0);
public
constructor Create;
destructor Destroy; override;
function GetImage: TBitmap;
procedure SetCP(CP: TControlPoint);
procedure Init;
procedure SetBucketData(const Buckets: TBucketArray; const BucketWidth: integer);
procedure SetBucketData(const Buckets: pointer; BucketWidth, BucketHeight: integer; bits: integer);
function GetFilterSize: Integer;
procedure CreateImage(YOffset: integer = 0);
procedure SaveImage(const FileName: String);
procedure SaveImage(FileName: String);
procedure GetBucketStats(var Stats: TBucketStats);
property OnProgress: TOnProgress
read FOnProgress
write SetOnProgress;
property MaxCount: int64 read MaxA;
end;
implementation
@ -75,6 +92,21 @@ type
PRGBArray = ^TRGBArray;
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;
begin
@ -177,10 +209,23 @@ begin
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.SetBucketData(const Buckets: TBucketArray; const BucketWidth: integer);
procedure TImageMaker.SetBucketData(const Buckets: pointer; BucketWidth, BucketHeight: integer; bits: integer);
begin
FBuckets := Buckets;
FBuckets64 := TBucket64Array(Buckets);
FBuckets48 := TBucket48Array(Buckets);
FBuckets32f := TBucket32fArray(Buckets);
FBuckets32 := TBucket32Array(Buckets);
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;
///////////////////////////////////////////////////////////////////////////////
@ -197,25 +242,13 @@ end;
///////////////////////////////////////////////////////////////////////////////
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
gamma: double;
i, j: integer;
alpha: double;
ai, ri, gi, bi: Integer;
bgtot: TRGB;
ri, gi, bi: Integer;
ai, ia: integer;
bgtot, zero_BG: TRGB;
ls: double;
ii, jj: integer;
fp: array[0..3] of double;
@ -223,14 +256,19 @@ var
AlphaRow: PbyteArray;
vib, notvib: Integer;
bgi: array[0..2] of Integer;
bucketpos: Integer;
// bucketpos: Integer;
filterValue: double;
filterpos: Integer;
// filterpos: Integer;
lsa: array[0..1024] of double;
sample_density: double;
sample_density: extended;
gutter_width: integer;
k1, k2: double;
area: double;
GetBucket: function(x, y: integer): TBucket64 of object;
bucket: TBucket64;
bx, by: integer;
label zero_alpha;
begin
if fcp.gamma = 0 then
gamma := fcp.gamma
@ -245,181 +283,21 @@ begin
bgtot.red := bgi[0];
bgtot.green := bgi[1];
bgtot.blue := bgi[2];
zero_BG.red := 0;
zero_BG.green := 0;
zero_BG.blue := 0;
gutter_width := FBucketwidth - FOversample * fcp.Width;
// gutter_width := 2 * ((25 - Foversample) div 2);
FBitmap.PixelFormat := pf24bit;
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
if(FFilterSize <= gutter_width div 2) then // filter too big when 'post-processing' ?
GetBucket := FGetBucket
else
gamma := 1 / (2* fcp.gamma);
vib := round(fcp.vibrancy * 256.0);
notvib := 256 - vib;
GetBucket := SafeGetBucket;
bgi[0] := round(fcp.background[0]);
bgi[1] := round(fcp.background[1]);
bgi[2] := round(fcp.background[2]);
bgtot.red := bgi[0];
bgtot.green := bgi[1];
bgtot.blue := bgi[2];
FBitmap.PixelFormat := pf24bit;
gutter_width := FBucketwidth - FOversample * fcp.Width;
sample_density := fcp.sample_density * power(2, fcp.zoom) * power(2, fcp.zoom);
sample_density := fcp.actual_density * sqr( power(2, fcp.zoom) );
if sample_density = 0 then sample_density := 0.001;
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);
@ -429,34 +307,14 @@ begin
lsa[i] := (k1 * log10(1 + fcp.White_level * i * k2)) / (fcp.White_level * i);
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;
ai := 0;
bucketpos := 0;
//bucketpos := 0;
by := 0;
for i := 0 to fcp.Height - 1 do begin
// if FStop then
// Break;
bx := 0;
Progress(i / fcp.Height);
AlphaRow := PByteArray(FAlphaBitmap.scanline[YOffset + i]);
Row := PRGBArray(FBitmap.scanline[YOffset + i]);
@ -466,23 +324,18 @@ begin
fp[1] := 0;
fp[2] := 0;
fp[3] := 0;
ACount := 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)];
bucket := GetBucket(bx + jj, by + ii);
ls := lsa[Min(1023, bucket.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;
ACount := ACount + filterValue * FBuckets[filterpos].Count;
// RCount := RCount + filterValue * FBuckets[bucketpos].Red;
// GCount := GCount + filterValue * FBuckets[bucketpos].Green;
// BCount := BCount + filterValue * FBuckets[bucketpos].Blue;
fp[0] := fp[0] + filterValue * ls * bucket.Red;
fp[1] := fp[1] + filterValue * ls * bucket.Green;
fp[2] := fp[2] + filterValue * ls * bucket.Blue;
fp[3] := fp[3] + filterValue * ls * bucket.Count;
end;
end;
@ -491,119 +344,136 @@ begin
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;
bucket := GetBucket(bx, by);
ls := lsa[Min(1023, bucket.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;
ACount := FBuckets[bucketpos].Count;
RCount := FBuckets[bucketpos].Red;
GCount := FBuckets[bucketpos].Green;
BCount := FBuckets[bucketpos].Blue;
fp[0] := ls * bucket.Red;
fp[1] := ls * bucket.Green;
fp[2] := ls * bucket.Blue;
fp[3] := ls * bucket.Count * fcp.white_level;
end;
Inc(bucketpos, FOversample);
Inc(bx, FOversample);
if (fp[3] > 0.0) then begin
if(divisor > 1E-12) then
alpha := power(ACount - densLow, Gamma) / divisor
else
alpha := 1;
if fcp.Transparency then begin // -------------------------- 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 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;
ls := vib * power(fp[3], gamma) / 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 begin
ri := Round(ls * fp[0] + notvib * power(fp[0], gamma));
gi := Round(ls * fp[1] + notvib * power(fp[1], gamma));
bi := Round(ls * fp[2] + notvib * power(fp[2], gamma));
end
else begin
ri := Round(ls * fp[0]);
gi := Round(ls * fp[1]);
bi := Round(ls * fp[2]);
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;
// ignoring BG color in transparent renders...
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;
ri := (ri * 255) div ai; // ai > 0 !
if (ri < 0) then ri := 0
else if (ri > 255) then ri := 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;
(*
gi := (gi * 255) div ai;
if (gi < 0) then gi := 0
else if (gi > 255) then gi := 255;
ri := Round(RCount/ACount) + (ai * bgi[0]) shr 8;
if (ri < 0) then
ri := 0
else if (ri > 255) then
ri := 255;
bi := (bi * 255) div ai;
if (bi < 0) then bi := 0
else if (bi > 255) then bi := 255;
gi := Round(GCount/ACount) + (ai * bgi[1]) shr 8;
if (gi < 0) then
gi := 0
else if (gi > 255) then
gi := 255;
Row[j].red := ri;
Row[j].green := gi;
Row[j].blue := bi;
AlphaRow[j] := ai;
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 (bi < 0) then
bi := 0
else if (bi > 255) then
bi := 255;
*)
Row[j].red := ri;
Row[j].green := gi;
Row[j].blue := bi;
if (notvib > 0) then begin
ri := Round(ls * fp[0] + notvib * power(fp[0], gamma));
gi := Round(ls * fp[1] + notvib * power(fp[1], gamma));
bi := Round(ls * fp[2] + notvib * power(fp[2], gamma));
end
else begin
ri := Round(ls * fp[0]);
gi := Round(ls * fp[1]);
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;
Inc(bucketpos, gutter_width);
Inc(bucketpos, (FOversample - 1) * FBucketWidth);
//Inc(bucketpos, gutter_width);
//Inc(bucketpos, (FOversample - 1) * FBucketWidth);
Inc(by, FOversample);
end;
FBitmap.PixelFormat := pf24bit;
Progress(1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TImageMaker.SaveImage(const FileName: String);
procedure TImageMaker.SaveImage(FileName: String);
var
i,row: integer;
PngObject: TPngObject;
rowbm, rowpng: PByteArray;
JPEGImage: TJPEGImage;
PNGerror: boolean;
label BMPhack;
begin
if UpperCase(ExtractFileExt(FileName)) = '.PNG' then begin
pngError := false;
PngObject := TPngObject.Create;
PngObject.Assign(FBitmap);
Case PNGTransparency of
0:
; // do nothing
1,2:
try
PngObject.Assign(FBitmap);
if fcp.Transparency then // PNGTransparency <> 0
begin
PngObject.CreateAlpha;
for i:= 0 to FAlphaBitmap.Height - 1 do begin
@ -614,12 +484,19 @@ begin
end;
end;
end;
else
Exception.CreateFmt('Unexpected value of PNGTransparency [%d]', [PNGTransparency]);
//else 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;
PngObject.SaveToFile(FileName);
PngObject.Free;
end else if UpperCase(ExtractFileExt(FileName)) = '.JPG' then begin
JPEGImage := TJPEGImage.Create;
JPEGImage.Assign(FBitmap);
@ -636,9 +513,14 @@ begin
// Free;
// end;
end else begin // bitmap
BMPHack:
FBitmap.SaveToFile(FileName);
if fcp.Transparency then begin
FAlphaBitmap.Palette := CreatePalette(AlphaPalette.logpal);
FileName := ChangeFileExt(FileName, '_alpha.bmp');
FAlphaBitmap.SaveToFile(FileName);
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
@ -656,41 +538,115 @@ var
PngObject: TPngObject;
rowbm, rowpng: PByteArray;
begin
if assigned(FTransparentImage) then
FTransparentImage.Free;
if assigned(FTransparentImage) then FTransparentImage.Free;
FTransparentImage := TBitmap.Create;
FTransparentImage.Width := Fcp.Width;
FTransparentImage.Height := Fcp.Height;
FTransparentImage.Canvas.Brush.Color := ClSilver;
FTransparentImage.Canvas.FillRect(Rect(0,0,Fcp.Width, Fcp.Height));
FTransparentImage.Canvas.Brush.Color := $CCCCCC;
FTransparentImage.Canvas.FillRect(Rect(0, 0, Fcp.Width, Fcp.Height));
FTransparentImage.Canvas.Brush.Color := ClWhite;
for x := 0 to ((Fcp.Width - 1) div 20) do begin
for y := 0 to ((Fcp.Height - 1) div 20) do begin
FTransparentImage.Canvas.Brush.Color := $FFFFFF;
for x := 0 to ((Fcp.Width - 1) div 8) do begin
for y := 0 to ((Fcp.Height - 1) div 8) do begin
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;
PngObject := TPngObject.Create;
PngObject.Assign(FBitmap);
PngObject.CreateAlpha;
for i:= 0 to FAlphaBitmap.Height - 1 do begin
rowbm := PByteArray(FAlphaBitmap.scanline[i]);
rowpng := PByteArray(PngObject.AlphaScanline[i]);
for row := 0 to FAlphaBitmap.Width -1 do begin
rowpng[row] := rowbm[row];
if fcp.Transparency then begin
PngObject.CreateAlpha;
for i:= 0 to FAlphaBitmap.Height - 1 do begin
rowbm := PByteArray(FAlphaBitmap.scanline[i]);
rowpng := PByteArray(PngObject.AlphaScanline[i]);
for row := 0 to FAlphaBitmap.Width - 1 do begin
rowpng[row] := rowbm[row];
end;
end;
end;
PngObject.Draw(FTransparentImage.Canvas, Rect(0,0,Fcp.Width, Fcp.Height));
PngObject.Draw(FTransparentImage.Canvas, FTransparentImage.Canvas.ClipRect);
PngObject.Free;
Result := FTransparentImage;
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.

4
2.10/Source/Main.dfm
View File

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

62
2.10/Source/Main.pas
View File

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

7
2.10/Source/Mutate.pas
View File

@ -21,7 +21,8 @@ interface
uses
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
TMutateForm = class(TForm)
@ -178,7 +179,7 @@ begin
cps[0].zoom := zoom;
cps[0].center[0] := center[0];
cps[0].center[1] := center[1];
Render.Compatibility := compatibility;
// Render.Compatibility := compatibility;
Render.SetCP(cps[0]);
Render.Render;
BM.Assign(Render.GetImage);
@ -230,7 +231,7 @@ begin
mutants[i].center[1] := center[1];
end;
Render.Compatibility := compatibility;
// Render.Compatibility := compatibility;
Render.SetCP(mutants[i]);
Render.Render;
BM.Assign(Render.GetImage);

131
2.10/Source/Options.dfm
View File

@ -1,6 +1,6 @@
object OptionsForm: TOptionsForm
Left = 540
Top = 274
Left = 675
Top = 365
BorderIcons = [biSystemMenu, biMinimize, biMaximize, biHelp]
BorderStyle = bsDialog
Caption = 'Options'
@ -126,7 +126,7 @@ object OptionsForm: TOptionsForm
end
object GroupBox15: TGroupBox
Left = 136
Top = 96
Top = 158
Width = 297
Height = 75
Caption = 'When render is finished'
@ -230,6 +230,102 @@ object OptionsForm: TOptionsForm
TabOrder = 1
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
object EditorPage: TTabSheet
Caption = 'Editor'
@ -532,7 +628,7 @@ object OptionsForm: TOptionsForm
end
object chkShowTransparency: TCheckBox
Left = 192
Top = 179
Top = 155
Width = 129
Height = 17
Caption = 'Show Transparency'
@ -542,13 +638,12 @@ object OptionsForm: TOptionsForm
Left = 184
Top = 104
Width = 193
Height = 69
Height = 49
Caption = 'PNG Transparency'
ItemIndex = 0
Items.Strings = (
'No transparency'
'Flam3-style'
'Flamesong-style')
'Disabled'
'Enabled')
TabOrder = 3
end
end
@ -618,11 +713,20 @@ object OptionsForm: TOptionsForm
TabOrder = 3
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
Left = 208
Top = 88
Width = 193
Height = 97
Height = 81
Caption = 'Random batch'
TabOrder = 1
object Label38: TLabel
@ -825,15 +929,6 @@ object OptionsForm: TOptionsForm
Thousands = False
end
end
object chkKeepBackground: TCheckBox
Left = 216
Top = 160
Width = 137
Height = 22
HelpContext = 1023
Caption = 'Keep background color'
TabOrder = 4
end
end
object VariationsPage: TTabSheet
Caption = 'Variations'

31
2.10/Source/Options.pas
View File

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

2
2.10/Source/Preview.pas
View File

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

53
2.10/Source/Regstry.pas
View File

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

705
2.10/Source/Render.pas
View File

@ -1,7 +1,7 @@
{
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
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
@ -22,78 +22,124 @@ unit Render;
interface
uses
Windows, Graphics,
Controlpoint;
Windows, Graphics, Classes,
Controlpoint, RenderTypes, ImageMaker;
type
TOnProgress = procedure(prog: double) of object;
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;
///////////////////////////////////////////////////////////////////////////////
//
// { TBaseRenderer }
//
///////////////////////////////////////////////////////////////////////////////
type
TBaseRenderer = class
private
FOnProgress: TOnProgress;
procedure SetOnProgress(const Value: TOnProgress);
protected
FMaxMem: integer;
FCompatibility: integer;
FStop: boolean;
camX0, camX1, camY0, camY1, // camera bounds
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;
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);
function GetSlice: integer; virtual;
function GetNrSlices: integer; virtual;
procedure SetNumThreads(const n: integer);
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
constructor Create; virtual;
destructor Destroy; override;
procedure SetCP(CP: TControlPoint);
procedure Render; virtual; abstract;
procedure Render; virtual;
function GetImage: TBitmap; virtual; abstract;
procedure UpdateImage(CP: TControlPoint); virtual;
procedure SaveImage(const FileName: String); virtual;
function GetImage: TBitmap; virtual;
procedure UpdateImage(CP: TControlPoint);
procedure SaveImage(const FileName: String);
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
read FOnProgress
write SetOnProgress;
property compatibility : integer
read Fcompatibility
write Fcompatibility;
write FOnProgress;
property MaxMem : integer
read FMaxMem
write FMaxMem;
property NrSlices: integer
read GetNrSlices;
read FNumSlices;
property Slice: integer
read GetSlice;
property Failed: boolean // hmm...
read FStop;
read FSlice;
property NumThreads: integer
read FNumThreads
write SetNumThreads;
property Output: TStrings
write strOutput;
property MinDensity: double
write SetMinDensity;
property RenderMore: boolean
write FRenderOver;
end;
///////////////////////////////////////////////////////////////////////////////
{ TRenderer }
///////////////////////////////////////////////////////////////////////////////
type
TRenderer = class
private
@ -101,52 +147,438 @@ type
FOnProgress: TOnProgress;
FCP: TControlPoint;
Fcompatibility: Integer;
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;
procedure SetCP(CP: TControlPoint);
procedure Render;
procedure RenderMaxMem(MaxMem: Int64);
function GetBucketSize: integer; virtual; abstract;
function GetImage: TBitmap;
procedure UpdateImage(CP: TControlPoint);
procedure SaveImage(const FileName: String);
procedure Stop;
property OnProgress: TOnProgress
read 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;
implementation
uses
Math, Sysutils, Render64, RenderMM;
{ TRenderThread }
Math, SysUtils, Forms,
Render32;
///////////////////////////////////////////////////////////////////////////////
//
// { 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;
begin
if assigned(FRenderer) then
@ -169,10 +601,12 @@ begin
FCP := CP;
end;
{
///////////////////////////////////////////////////////////////////////////////
constructor TRenderer.Create;
begin
end;
}
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.Render;
@ -180,154 +614,45 @@ begin
if assigned(FRenderer) then
FRenderer.Free;
if MaxMem = 0 then begin
FRenderer := TRenderer64.Create;
assert(Fmaxmem=0);
if FMaxMem = 0 then begin
FRenderer := TRenderer32.Create;
end else begin
FRenderer := TRendererMM64.Create;
FRenderer.MaxMem := MaxMem
FRenderer := TRenderer32MM.Create;
FRenderer.MaxMem := FMaxMem
end;
FRenderer.SetCP(FCP);
FRenderer.compatibility := compatibility;
// FRenderer.compatibility := compatibility;
FRenderer.OnProgress := FOnProgress;
Frenderer.Render;
FRenderer.Render;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.Stop;
begin
if assigned(FRenderer) then
FRenderer.Stop;
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);
begin
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer.SaveImage(const FileName: String);
begin
if assigned(FRenderer) then
FRenderer.SaveImage(FileName);
end;
{ TBaseRenderer }
///////////////////////////////////////////////////////////////////////////////
procedure TBaseRenderer.SetOnProgress(const Value: TOnProgress);
procedure TRenderer.GetBucketStats(var Stats: TBucketStats);
begin
FOnProgress := Value;
if assigned(FRenderer) then
FRenderer.GetBucketStats(Stats);
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.

353
2.10/Source/Render64.pas
View File

@ -1,7 +1,7 @@
{
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
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
@ -22,61 +22,43 @@ unit Render64;
interface
uses
Windows, Forms, Graphics, ImageMaker,
Render, xform, Controlpoint;
Windows, Classes, Forms, Graphics, ImageMaker,
RenderST, RenderTypes, Xform, ControlPoint;
type
TRenderer64 = class(TBaseRenderer)
TRenderer64 = class(TBaseSTRenderer)
protected
camX0, camX1, camY0, camY1, // camera bounds
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;
Buckets: TBucket64Array;
ColorMap: TColorMapArray;
FImageMaker: TImageMaker;
function GetBits: integer; override;
function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
procedure InitBuffers;
procedure ClearBuffers;
procedure ClearBuckets;
procedure CreateColorMap;
procedure CreateCamera;
procedure SetPixels;
procedure ClearBuckets; override;
procedure CreateColorMap; override;
protected
PropTable: array[0..SUB_BATCH_SIZE] of TXform;
finalXform: TXform;
UseFinalXform: boolean;
procedure IterateBatch; override;
procedure IterateBatchAngle; override;
procedure IterateBatchFX; override;
procedure IterateBatchAngleFX; override;
procedure Prepare;
procedure IterateBatch;
procedure IterateBatchAngle;
procedure IterateBatchFX;
procedure IterateBatchAngleFX;
end;
// ----------------------------------------------------------------------------
type
TRenderer64MM = class(TRenderer64)
protected
procedure CalcBufferSize; override;
public
constructor Create; override;
destructor Destroy; override;
procedure Render; override;
function GetImage: TBitmap; override;
// procedure UpdateImage(CP: TControlPoint); override;
procedure SaveImage(const FileName: String); override;
end;
end;
implementation
@ -87,88 +69,19 @@ uses
{ TRenderer64 }
///////////////////////////////////////////////////////////////////////////////
constructor TRenderer64.Create;
begin
inherited Create;
FImageMaker := TImageMaker.Create;
end;
///////////////////////////////////////////////////////////////////////////////
destructor TRenderer64.Destroy;
begin
FImageMaker.Free;
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64.ClearBuckets;
var
i: integer;
i, j: 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 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;
for j := 0 to BucketHeight - 1 do
for i := 0 to BucketWidth - 1 do
with Buckets[j][i] do begin
Red := 0;
Green := 0;
Blue := 0;
Count := 0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
@ -194,175 +107,27 @@ begin
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderer64.GetImage: TBitmap;
function TRenderer64.GetBits: integer;
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;
///////////////////////////////////////////////////////////////////////////////
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;
var
i: integer;
px, py: double;
Bucket: PBucket;
Bucket: PBucket64;
MapColor: PColorMapColor;
p: TCPPoint;
@ -399,7 +164,7 @@ end;
py := p.y - camY0;
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)];
Inc(Bucket.Red, MapColor.Red);
@ -419,7 +184,7 @@ procedure TRenderer64.IterateBatchAngle;
var
i: integer;
px, py: double;
Bucket: PBucket;
Bucket: PBucket64;
MapColor: PColorMapColor;
p: TCPPoint;
@ -456,7 +221,7 @@ end;
py := p.y * cosa - p.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)];
Inc(Bucket.Red, MapColor.Red);
@ -477,7 +242,7 @@ procedure TRenderer64.IterateBatchFX;
var
i: integer;
px, py: double;
Bucket: PBucket;
Bucket: PBucket64;
MapColor: PColorMapColor;
p, q: TCPPoint;
@ -515,7 +280,7 @@ end;
py := q.y - camY0;
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)];
Inc(Bucket.Red, MapColor.Red);
@ -535,7 +300,7 @@ procedure TRenderer64.IterateBatchAngleFX;
var
i: integer;
px, py: double;
Bucket: PBucket;
Bucket: PBucket64;
MapColor: PColorMapColor;
p, q: TCPPoint;
@ -573,7 +338,7 @@ end;
py := q.y * cosa - q.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bws * px) + Round(bhs * py) * BucketWidth];
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)];
Inc(Bucket.Red, MapColor.Red);
@ -589,5 +354,17 @@ end;
end;
end;
// -- { TRenderer32MM } -------------------------------------------------------
procedure TRenderer64MM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderer64MM.Render;
begin
RenderMM;
end;
end.

388
2.10/Source/Render64MT.pas
View File

@ -23,66 +23,39 @@ interface
uses
Windows, Forms, Classes, Graphics,
Render, Controlpoint, ImageMaker, BucketFillerthread;
Render, RenderMT, ControlPoint, ImageMaker, RenderTypes;
type
TRenderer64MT = class(TBaseRenderer)
TRenderer64MT = class(TBaseMTRenderer)
protected
camX0, camX1, camY0, camY1, // camera bounds
camW, camH, // camera sizes
bws, bhs, cosa, sina, rcX, rcY: double;
ppux, ppuy: extended;
Buckets: TBucket64Array;
// ColorMap: TColorMapArray;
BucketWidth, BucketHeight: Int64;
BucketSize: Int64;
function GetBits: integer; override;
function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
sample_density: extended;
oversample: integer;
gutter_width: Integer;
max_gutter_width: Integer;
procedure ClearBuckets; override;
// procedure CreateColorMap; override;
batchcounter: Integer;
FNrBatches: Int64;
procedure AddPointsToBuckets(const points: TPointsArray); override;
procedure AddPointsToBucketsAngle(const points: TPointsArray); override;
Buckets: TBucketArray;
ColorMap: TColorMapArray;
end;
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
constructor Create; override;
destructor Destroy; override;
function GetImage: TBitmap; override;
procedure Render; override;
procedure Stop; override;
procedure Pause(paused: boolean); override;
procedure UpdateImage(CP: TControlPoint); override;
procedure SaveImage(const FileName: String); override;
property NrOfTreads: integer
read FNrOfTreads
write SetNrOfTreads;
end;
end;
implementation
@ -91,298 +64,103 @@ uses
{ 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;
var
i: integer;
i, j: 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 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;
for j := 0 to BucketHeight - 1 do
for i := 0 to BucketWidth - 1 do
with Buckets[j][i] do begin
Red := 0;
Green := 0;
Blue := 0;
Count := 0;
end;
end;
// share the buffer with imagemaker
FImageMaker.SetBucketData(Buckets, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.SetPixelsMT;
procedure TRenderer64MT.AddPointsToBuckets(const points: TPointsArray);
var
i: integer;
nsamples: Int64;
bc : integer;
px, py: double;
// R: double;
// V1, v2, v3: integer;
Bucket: PBucket64;
MapColor: PColorMapColor;
begin
nsamples := Round(sample_density * NrSlices * bucketSize / (oversample * oversample));
FNrBatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
batchcounter := 0;
Randomize;
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
// if FStop then Exit;
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);
for i := 0 to NrOfTreads - 1 do
WorkingThreads[i] := NewThread;
Bucket := @Buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(points[i].c * 255)];
for i := 0 to NrOfTreads - 1 do
WorkingThreads[i].Resume;
bc := 0;
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;
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
{ for i := 0 to NrOfTreads - 1 do
begin
WorkingThreads[i].Terminate;
WorkingThreads[i].Free;
end;}
DeleteCriticalSection(CriticalSection);
Progress(1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.Stop;
procedure TRenderer64MT.AddPointsToBucketsAngle(const points: TPointsArray);
var
i: integer;
px, py: double;
Bucket: PBucket64;
MapColor: PColorMapColor;
begin
for i := 0 to NrOfTreads - 1 do
WorkingThreads[i].Terminate;
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
// if FStop then Exit;
inherited;
end;
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;
procedure TRenderer64MT.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;
Bucket := @Buckets[Round(bhs * py)][Round(bws * px)];
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 TRenderer64MT.Render;
// -- { TRenderer64MT_MM } ----------------------------------------------------
procedure TRenderer64MT_MM.CalcBufferSize;
begin
FStop := False;
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;
CalcBufferSizeMM;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer64MT.UpdateImage(CP: TControlPoint);
procedure TRenderer64MT_MM.Render;
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;
RenderMM;
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.

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

70
2.10/Source/ScriptForm.dfm
View File

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

46
2.10/Source/ScriptForm.pas
View File

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

2
2.10/Source/ScriptRender.pas
View File

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

5
2.10/Source/XFormMan.pas
View File

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

4
2.10/Source/formPostProcess.dfm
View File

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

4
2.10/Source/formPostProcess.pas
View File

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

68
2.10/Source/varJuliaN.pas
View File

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