From c3e610920fc4c04d4d682d4f1c5af961097486ee Mon Sep 17 00:00:00 2001 From: zueuk Date: Tue, 22 Aug 2006 13:35:52 +0000 Subject: [PATCH] version 2.05: 64/48/32-bit depth support many other changes --- 2.10/Source/Adjust.pas | 6 +- 2.10/Source/BaseVariation.pas | 18 +- 2.10/Source/Browser.pas | 5 +- 2.10/Source/BucketFillerThread.pas | 80 +-- 2.10/Source/ControlPoint.pas | 14 +- 2.10/Source/Editor.dfm | 26 +- 2.10/Source/Editor.pas | 78 ++- 2.10/Source/FormRender.dfm | 829 ++++++++++++++++------------- 2.10/Source/FormRender.pas | 217 ++++++-- 2.10/Source/Fullscreen.dfm | 30 ++ 2.10/Source/Fullscreen.pas | 129 ++++- 2.10/Source/Global.pas | 7 +- 2.10/Source/ImageMaker.pas | 634 ++++++++++------------ 2.10/Source/Main.dfm | 4 +- 2.10/Source/Main.pas | 62 ++- 2.10/Source/Mutate.pas | 7 +- 2.10/Source/Options.dfm | 131 ++++- 2.10/Source/Options.pas | 31 +- 2.10/Source/Preview.pas | 2 +- 2.10/Source/Regstry.pas | 53 +- 2.10/Source/Render.pas | 705 +++++++++++++++++------- 2.10/Source/Render64.pas | 353 +++--------- 2.10/Source/Render64MT.pas | 388 +++----------- 2.10/Source/RenderMM.pas | 240 --------- 2.10/Source/RenderMM2.pas | 798 --------------------------- 2.10/Source/RenderMM_MT.pas | 257 --------- 2.10/Source/RenderThread.pas | 161 ++++-- 2.10/Source/ScriptForm.dfm | 70 +-- 2.10/Source/ScriptForm.pas | 46 +- 2.10/Source/ScriptRender.pas | 2 +- 2.10/Source/XForm.pas | 78 +-- 2.10/Source/XFormMan.pas | 5 +- 2.10/Source/formPostProcess.dfm | 4 +- 2.10/Source/formPostProcess.pas | 4 +- 2.10/Source/varJuliaN.pas | 68 +-- 35 files changed, 2273 insertions(+), 3269 deletions(-) delete mode 100644 2.10/Source/RenderMM.pas delete mode 100644 2.10/Source/RenderMM2.pas delete mode 100644 2.10/Source/RenderMM_MT.pas diff --git a/2.10/Source/Adjust.pas b/2.10/Source/Adjust.pas index c6a5056..26a8bea 100644 --- a/2.10/Source/Adjust.pas +++ b/2.10/Source/Adjust.pas @@ -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); diff --git a/2.10/Source/BaseVariation.pas b/2.10/Source/BaseVariation.pas index cbd4ec1..d0a65a9 100644 --- a/2.10/Source/BaseVariation.pas +++ b/2.10/Source/BaseVariation.pas @@ -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 diff --git a/2.10/Source/Browser.pas b/2.10/Source/Browser.pas index d22c3f2..79908bb 100644 --- a/2.10/Source/Browser.pas +++ b/2.10/Source/Browser.pas @@ -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; diff --git a/2.10/Source/BucketFillerThread.pas b/2.10/Source/BucketFillerThread.pas index 889886c..f9f0349 100644 --- a/2.10/Source/BucketFillerThread.pas +++ b/2.10/Source/BucketFillerThread.pas @@ -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. diff --git a/2.10/Source/ControlPoint.pas b/2.10/Source/ControlPoint.pas index 74b40bc..16726bc 100644 --- a/2.10/Source/ControlPoint.pas +++ b/2.10/Source/ControlPoint.pas @@ -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]); diff --git a/2.10/Source/Editor.dfm b/2.10/Source/Editor.dfm index 9e2cc1f..f842567 100644 --- a/2.10/Source/Editor.dfm +++ b/2.10/Source/Editor.dfm @@ -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 diff --git a/2.10/Source/Editor.pas b/2.10/Source/Editor.pas index 48e444a..53584f5 100644 --- a/2.10/Source/Editor.pas +++ b/2.10/Source/Editor.pas @@ -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; diff --git a/2.10/Source/FormRender.dfm b/2.10/Source/FormRender.dfm index 5e3fc6b..f08ac95 100644 --- a/2.10/Source/FormRender.dfm +++ b/2.10/Source/FormRender.dfm @@ -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 diff --git a/2.10/Source/FormRender.pas b/2.10/Source/FormRender.pas index cb7c4b2..d4b6806 100644 --- a/2.10/Source/FormRender.pas +++ b/2.10/Source/FormRender.pas @@ -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. diff --git a/2.10/Source/Fullscreen.dfm b/2.10/Source/Fullscreen.dfm index 4d8e97a..cea7fef 100644 --- a/2.10/Source/Fullscreen.dfm +++ b/2.10/Source/Fullscreen.dfm @@ -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 diff --git a/2.10/Source/Fullscreen.pas b/2.10/Source/Fullscreen.pas index 83d03eb..f287ca0 100644 --- a/2.10/Source/Fullscreen.pas +++ b/2.10/Source/Fullscreen.pas @@ -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. diff --git a/2.10/Source/Global.pas b/2.10/Source/Global.pas index e582dbc..09af8b2 100644 --- a/2.10/Source/Global.pas +++ b/2.10/Source/Global.pas @@ -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 diff --git a/2.10/Source/ImageMaker.pas b/2.10/Source/ImageMaker.pas index 7d5522d..a034f08 100644 --- a/2.10/Source/ImageMaker.pas +++ b/2.10/Source/ImageMaker.pas @@ -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. diff --git a/2.10/Source/Main.dfm b/2.10/Source/Main.dfm index 02d248c..6f3045a 100644 --- a/2.10/Source/Main.dfm +++ b/2.10/Source/Main.dfm @@ -1,6 +1,6 @@ object MainForm: TMainForm - Left = 401 - Top = 158 + Left = 501 + Top = 211 Width = 729 Height = 530 Caption = 'Apophysis' diff --git a/2.10/Source/Main.pas b/2.10/Source/Main.pas index 9b2a863..d3df0d7 100644 --- a/2.10/Source/Main.pas +++ b/2.10/Source/Main.pas @@ -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'); diff --git a/2.10/Source/Mutate.pas b/2.10/Source/Mutate.pas index 61d9b0a..66d07b4 100644 --- a/2.10/Source/Mutate.pas +++ b/2.10/Source/Mutate.pas @@ -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); diff --git a/2.10/Source/Options.dfm b/2.10/Source/Options.dfm index 887ee6c..b10a74d 100644 --- a/2.10/Source/Options.dfm +++ b/2.10/Source/Options.dfm @@ -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' diff --git a/2.10/Source/Options.pas b/2.10/Source/Options.pas index 2a60fdd..6d0c076 100644 --- a/2.10/Source/Options.pas +++ b/2.10/Source/Options.pas @@ -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 diff --git a/2.10/Source/Preview.pas b/2.10/Source/Preview.pas index f9e971e..9ab83f8 100644 --- a/2.10/Source/Preview.pas +++ b/2.10/Source/Preview.pas @@ -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); diff --git a/2.10/Source/Regstry.pas b/2.10/Source/Regstry.pas index dcab769..5d95661 100644 --- a/2.10/Source/Regstry.pas +++ b/2.10/Source/Regstry.pas @@ -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; diff --git a/2.10/Source/Render.pas b/2.10/Source/Render.pas index 88e9a75..2cf28e6 100644 --- a/2.10/Source/Render.pas +++ b/2.10/Source/Render.pas @@ -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. diff --git a/2.10/Source/Render64.pas b/2.10/Source/Render64.pas index 2290f26..f9fca62 100644 --- a/2.10/Source/Render64.pas +++ b/2.10/Source/Render64.pas @@ -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. diff --git a/2.10/Source/Render64MT.pas b/2.10/Source/Render64MT.pas index e864ac5..f79a36a 100644 --- a/2.10/Source/Render64MT.pas +++ b/2.10/Source/Render64MT.pas @@ -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. diff --git a/2.10/Source/RenderMM.pas b/2.10/Source/RenderMM.pas deleted file mode 100644 index a8038ae..0000000 --- a/2.10/Source/RenderMM.pas +++ /dev/null @@ -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. - diff --git a/2.10/Source/RenderMM2.pas b/2.10/Source/RenderMM2.pas deleted file mode 100644 index 058fd5c..0000000 --- a/2.10/Source/RenderMM2.pas +++ /dev/null @@ -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. - diff --git a/2.10/Source/RenderMM_MT.pas b/2.10/Source/RenderMM_MT.pas deleted file mode 100644 index 0fb42d1..0000000 --- a/2.10/Source/RenderMM_MT.pas +++ /dev/null @@ -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. - diff --git a/2.10/Source/RenderThread.pas b/2.10/Source/RenderThread.pas index e3e7dc0..9565be6 100644 --- a/2.10/Source/RenderThread.pas +++ b/2.10/Source/RenderThread.pas @@ -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. diff --git a/2.10/Source/ScriptForm.dfm b/2.10/Source/ScriptForm.dfm index 35d0b00..40d678d 100644 --- a/2.10/Source/ScriptForm.dfm +++ b/2.10/Source/ScriptForm.dfm @@ -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 diff --git a/2.10/Source/ScriptForm.pas b/2.10/Source/ScriptForm.pas index c5a98ce..5adc2ed 100644 --- a/2.10/Source/ScriptForm.pas +++ b/2.10/Source/ScriptForm.pas @@ -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 } diff --git a/2.10/Source/ScriptRender.pas b/2.10/Source/ScriptRender.pas index aa34d7f..af22f90 100644 --- a/2.10/Source/ScriptRender.pas +++ b/2.10/Source/ScriptRender.pas @@ -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; diff --git a/2.10/Source/XForm.pas b/2.10/Source/XForm.pas index f0c31f0..2c0dde8 100644 --- a/2.10/Source/XForm.pas +++ b/2.10/Source/XForm.pas @@ -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. diff --git a/2.10/Source/XFormMan.pas b/2.10/Source/XFormMan.pas index f05fca3..d0bc81b 100644 --- a/2.10/Source/XFormMan.pas +++ b/2.10/Source/XFormMan.pas @@ -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 diff --git a/2.10/Source/formPostProcess.dfm b/2.10/Source/formPostProcess.dfm index 3e307d2..6f2fef5 100644 --- a/2.10/Source/formPostProcess.dfm +++ b/2.10/Source/formPostProcess.dfm @@ -1,6 +1,6 @@ object frmPostProcess: TfrmPostProcess - Left = 61 - Top = 77 + Left = 76 + Top = 103 Width = 640 Height = 534 Caption = 'Post Render' diff --git a/2.10/Source/formPostProcess.pas b/2.10/Source/formPostProcess.pas index c962f0b..427d01c 100644 --- a/2.10/Source/formPostProcess.pas +++ b/2.10/Source/formPostProcess.pas @@ -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. diff --git a/2.10/Source/varJuliaN.pas b/2.10/Source/varJuliaN.pas index 454f6ea..ae98608 100644 --- a/2.10/Source/varJuliaN.pas +++ b/2.10/Source/varJuliaN.pas @@ -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;