From 10b8ac3c6bf52d23449484267029b9ac39a70252 Mon Sep 17 00:00:00 2001 From: ronaldhordijk Date: Sat, 29 Jan 2005 11:09:50 +0000 Subject: [PATCH] splitup of renderers --- 2.02g/Source/Render.pas | 80 ++++- 2.02g/Source/Render32.pas | 105 +++--- 2.02g/Source/Render64.pas | 591 ++++++++++++++++++++++++++++++++++ 2.02g/Source/RenderThread.pas | 42 +-- 4 files changed, 720 insertions(+), 98 deletions(-) create mode 100644 2.02g/Source/Render64.pas diff --git a/2.02g/Source/Render.pas b/2.02g/Source/Render.pas index ecef811..5428d08 100644 --- a/2.02g/Source/Render.pas +++ b/2.02g/Source/Render.pas @@ -46,6 +46,40 @@ type PBucket = ^TBucket; TBucketArray = array of TBucket; + +type + TBaseRenderer = class + private + procedure SetOnProgress(const Value: TOnProgress); + protected + FMaxMem: integer; + FCompatibility: integer; + FStop: boolean; + FOnProgress: TOnProgress; + FCP: TControlPoint; + public + constructor Create; virtual; + destructor Destroy; override; + + procedure SetCP(CP: TControlPoint); + function GetImage: TBitmap; virtual; abstract; + procedure Render; virtual; abstract; + procedure Stop; + + property OnProgress: TOnProgress + read FOnProgress + write SetOnProgress; + + property compatibility : integer + read Fcompatibility + write Fcompatibility; + + property MaxMem : integer + read FMaxMem + write FMaxMem; + + end; + type TRenderer = class private @@ -794,8 +828,8 @@ begin // generate points case Compatibility of - 0: fcp.iterate(SUB_BATCH_SIZE, points); - 1: fcp.iterate_d(SUB_BATCH_SIZE, points); + 0: fcp.iterate_Old(SUB_BATCH_SIZE, points); + 1: fcp.iterateXYC(SUB_BATCH_SIZE, points); end; if FCP.FAngle = 0 then @@ -803,6 +837,9 @@ begin else AddPointsToBucketsAngle(points); end; + + if assigned(FOnProgress) then + FOnProgress(1); end; procedure TRenderer.Stop; @@ -964,6 +1001,9 @@ begin Inc(bucketpos, (oversample - 1) * BucketWidth); end; bm.PixelFormat := pf24bit; + + if assigned(FOnProgress) then + FOnProgress(1); end; procedure TRenderer.InitBitmap(w, h: int64); @@ -1045,5 +1085,41 @@ begin end; +{ TBaseRenderer } + +procedure TBaseRenderer.SetOnProgress(const Value: TOnProgress); +begin + FOnProgress := Value; +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.Stop; +begin + FStop := True; +end; + + +destructor TBaseRenderer.Destroy; +begin + if assigned(FCP) then + FCP.Free; + + inherited; +end; + end. diff --git a/2.02g/Source/Render32.pas b/2.02g/Source/Render32.pas index 980c14e..8bc3436 100644 --- a/2.02g/Source/Render32.pas +++ b/2.02g/Source/Render32.pas @@ -22,7 +22,7 @@ interface uses Windows, Graphics, - Controlpoint; + Render, Controlpoint; type TOnProgress = procedure(prog: double) of object; @@ -47,9 +47,8 @@ type TBucketArray = array of TBucket; type - TRenderer32 = class + TRenderer32 = class(TBaseRenderer) private - Fcp: TControlPoint; bm: TBitmap; oversample: Integer; @@ -63,8 +62,7 @@ type BucketSize: Integer; gutter_width: Integer; -// sample_density: double; - sample_density: extended; // mt + sample_density: extended; Buckets: TBucketArray; ColorMap: TColorMapArray; @@ -78,12 +76,6 @@ type size: array[0..1] of extended; ppux, ppuy: extended; - bStop: boolean; - - FOnProgress: TOnProgress; - - procedure SetOnProgress(const Value: TOnProgress); - procedure CreateFilter; procedure NormalizeFilter; @@ -98,24 +90,17 @@ type procedure AddPointsToBuckets(const points: TPointsArray); overload; procedure AddPointsToBucketsAngle(const points: TPointsArray); overload; - public - compatibility : integer; - constructor Create; - destructor Destroy; override; - - procedure SetCP(CP: TControlPoint); - function GetImage: TBitmap; procedure SetPixels; procedure CreateBMFromBuckets(YOffset: Integer = 0); - procedure RenderMaxMem(MaxMemory: Integer = 64); - procedure Render; overload; - procedure Render(Time: double); overload; - procedure Stop; + public + constructor Create; override; + destructor Destroy; override; + + function GetImage: TBitmap; override; + + procedure Render; override; - property OnProgress: TOnProgress - read FOnProgress - write SetOnProgress; end; implementation @@ -125,7 +110,7 @@ uses { TRenderer32 } - +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.ClearBuckets; var i: integer; @@ -138,12 +123,13 @@ begin end; end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.ClearBuffers; begin ClearBuckets; end; - +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.CreateCamera; var scale: double; @@ -175,6 +161,7 @@ begin size[1] := 1; end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.CreateColorMap; var i: integer; @@ -187,6 +174,7 @@ begin end; end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.CreateFilter; var i, j: integer; @@ -207,6 +195,7 @@ begin Normalizefilter; end; +/////////////////////////////////////////////////////////////////////////////// destructor TRenderer32.Destroy; begin if assigned(bm) then @@ -215,11 +204,13 @@ begin inherited; end; +/////////////////////////////////////////////////////////////////////////////// function TRenderer32.GetImage: TBitmap; begin Result := bm; end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.InitBuffers; begin gutter_width := (filter_width - oversample) div 2; @@ -232,6 +223,7 @@ begin end; end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.InitValues; begin image_height := fcp.Height; @@ -252,6 +244,7 @@ begin bg[2] := 0; end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.NormalizeFilter; var i, j: integer; @@ -267,25 +260,7 @@ begin filter[i, j] := filter[i, j] / t; end; -procedure TRenderer32.RenderMaxMem(MaxMemory: Integer); -begin -end; - - -procedure TRenderer32.Render(Time: double); -begin -end; - -procedure TRenderer32.SetCP(CP: TControlPoint); -begin - FCP := CP; -end; - -procedure TRenderer32.SetOnProgress(const Value: TOnProgress); -begin - FOnProgress := Value; -end; - +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.AddPointsToBuckets(const points: TPointsArray); var i: integer; @@ -306,7 +281,7 @@ begin wy := bounds[3] - bounds[1]; for i := SUB_BATCH_SIZE - 1 downto 0 do begin - if bStop then + if FStop then Exit; px := points[i].x - bx; @@ -326,6 +301,7 @@ begin end; end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.AddPointsToBucketsAngle(const points: TPointsArray); var i: integer; @@ -352,7 +328,7 @@ begin sa := sin(FCP.FAngle); for i := SUB_BATCH_SIZE - 1 downto 0 do begin - if BStop then + if FStop then Exit; px := points[i].x - FCP.Center[0]; @@ -378,6 +354,7 @@ begin end; end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.SetPixels; var i: integer; @@ -392,16 +369,16 @@ begin Randomize; for i := 0 to nrbatches do begin - if bStop then + if FStop then Exit; - if (i and $FF = 0) and assigned(FOnProgress) then + if (i and $F = 0) and assigned(FOnProgress) then FOnProgress(i / nrbatches); // generate points case Compatibility of - 0: fcp.iterate(SUB_BATCH_SIZE, points); - 1: fcp.iterate_d(SUB_BATCH_SIZE, points); + 0: fcp.iterate_Old(SUB_BATCH_SIZE, points); + 1: fcp.iterateXYC(SUB_BATCH_SIZE, points); end; if FCP.FAngle = 0 then @@ -409,13 +386,12 @@ begin else AddPointsToBucketsAngle(points); end; + + if assigned(FOnProgress) then + FOnProgress(1); end; -procedure TRenderer32.Stop; -begin - bStop := True; -end; - +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.CreateBMFromBuckets(YOffset: Integer); var i, j: integer; @@ -477,7 +453,7 @@ begin ai := 0; bucketpos := 0; for i := 0 to Image_Height - 1 do begin - if bStop then + if FStop then Break; if assigned(FOnProgress) then @@ -569,9 +545,13 @@ begin Inc(bucketpos, 2 * gutter_width); Inc(bucketpos, (oversample - 1) * BucketWidth); end; - bm.PixelFormat := pf24bit; +// bm.PixelFormat := pf24bit; + + if assigned(FOnProgress) then + FOnProgress(1); end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.InitBitmap(w, h: Integer); begin if not Assigned(bm) then @@ -588,13 +568,16 @@ begin end; end; +/////////////////////////////////////////////////////////////////////////////// constructor TRenderer32.Create; begin + inherited Create; end; +/////////////////////////////////////////////////////////////////////////////// procedure TRenderer32.Render; begin - bStop := False; + FStop := False; InitValues; InitBitmap; @@ -603,6 +586,6 @@ begin CreateBMFromBuckets; end; - +/////////////////////////////////////////////////////////////////////////////// end. diff --git a/2.02g/Source/Render64.pas b/2.02g/Source/Render64.pas new file mode 100644 index 0000000..6779d99 --- /dev/null +++ b/2.02g/Source/Render64.pas @@ -0,0 +1,591 @@ +{ + 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 Render64; + +interface + +uses + Windows, Graphics, + Render, Controlpoint; + +type + TOnProgress = procedure(prog: double) of object; + +type + TColorMapColor = Record + Red : Integer; + Green: Integer; + Blue : Integer; +// Count: Integer; + end; + PColorMapColor = ^TColorMapColor; + TColorMapArray = array[0..255] of TColorMapColor; + + TBucket = Record + Red : Integer; + Green: Integer; + Blue : Integer; + Count: Integer; + end; + PBucket = ^TBucket; + TBucketArray = array of TBucket; + +type + TRenderer64 = 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; + + 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 AddPointsToBuckets(const points: TPointsArray); overload; + procedure AddPointsToBucketsAngle(const points: TPointsArray); overload; + + procedure SetPixels; + procedure CreateBMFromBuckets(YOffset: Integer = 0); + + public + constructor Create; override; + destructor Destroy; override; + + function GetImage: TBitmap; override; + + procedure Render; override; + + end; + +implementation + +uses + Math, Sysutils; + +{ TRenderer64 } + +/////////////////////////////////////////////////////////////////////////////// +procedure TRenderer64.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 TRenderer64.ClearBuffers; +begin + ClearBuckets; +end; + +/////////////////////////////////////////////////////////////////////////////// +procedure TRenderer64.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 TRenderer64.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 TRenderer64.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 TRenderer64.Destroy; +begin + if assigned(bm) then + bm.Free; + + inherited; +end; + +/////////////////////////////////////////////////////////////////////////////// +function TRenderer64.GetImage: TBitmap; +begin + Result := bm; +end; + +/////////////////////////////////////////////////////////////////////////////// +procedure TRenderer64.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 TRenderer64.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 TRenderer64.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 TRenderer64.AddPointsToBuckets(const points: TPointsArray); +var + i: integer; + px, py: double; + bws, bhs: double; + bx, by: double; + wx, wy: double; +// R: double; +// V1, v2, v3: integer; + Bucket: PBucket; + MapColor: PColorMapColor; +begin + bws := (BucketWidth - 0.5) * size[0]; + bhs := (BucketHeight - 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 + if FStop then + Exit; + + px := points[i].x - bx; + py := points[i].y - by; + + if ((px < 0) or (px > wx) or + (py < 0) or (py > wy)) then + continue; + + 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 TRenderer64.AddPointsToBucketsAngle(const points: TPointsArray); +var + i: integer; + px, py: double; + ca,sa: double; + nx, ny: double; + bws, bhs: double; + bx, by: double; + wx, wy: double; +// R: double; +// V1, v2, v3: integer; + Bucket: PBucket; + MapColor: PColorMapColor; +begin + + bws := (BucketWidth - 0.5) * size[0]; + bhs := (BucketHeight - 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 + if FStop then + Exit; + + 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; + + 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 TRenderer64.SetPixels; +var + i: integer; + nsamples: Integer; + nrbatches: Integer; + points: TPointsArray; +begin + 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 FStop then + Exit; + + if (i and $F = 0) and assigned(FOnProgress) then + FOnProgress(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 + AddPointsToBuckets(points) + else + AddPointsToBucketsAngle(points); + end; + + if assigned(FOnProgress) then + FOnProgress(1); +end; + +/////////////////////////////////////////////////////////////////////////////// +procedure TRenderer64.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; + + if assigned(FOnProgress) then + FOnProgress(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; + bm.PixelFormat := pf24bit; + + if assigned(FOnProgress) then + FOnProgress(1); +end; + +/////////////////////////////////////////////////////////////////////////////// +procedure TRenderer64.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 TRenderer64.Create; +begin + inherited Create; +end; + +/////////////////////////////////////////////////////////////////////////////// +procedure TRenderer64.Render; +begin + FStop := False; + + InitValues; + InitBitmap; + ClearBuffers; + SetPixels; + CreateBMFromBuckets; +end; + +/////////////////////////////////////////////////////////////////////////////// +end. + diff --git a/2.02g/Source/RenderThread.pas b/2.02g/Source/RenderThread.pas index 30da423..9a623c8 100644 --- a/2.02g/Source/RenderThread.pas +++ b/2.02g/Source/RenderThread.pas @@ -22,7 +22,7 @@ interface uses Classes, windows, Messages, Graphics, - controlPoint, Render, Render32; + controlPoint, Render, Render32, Render64; const WM_THREAD_COMPLETE = WM_APP + 5437; @@ -31,7 +31,7 @@ const type TRenderThread = class(TThread) private - FRenderer: TRenderer32; + FRenderer: TBaseRenderer; FOnProgress: TOnProgress; FCP: TControlPoint; @@ -48,9 +48,7 @@ type procedure SetCP(CP: TControlPoint); function GetImage: TBitmap; - procedure RenderMaxMem(MaxMemory: int64 = 64); procedure Render; overload; - procedure Render(Time: double); overload; procedure Terminate; property OnProgress: TOnProgress @@ -81,32 +79,6 @@ begin Result := FRenderer.GetImage; end; - -procedure TRenderThread.RenderMaxMem(MaxMemory: int64); -begin - if assigned(FRenderer) then - FRenderer.Free; - - FRenderer := TRenderer32.Create; - FRenderer.SetCP(FCP); - FRenderer.compatibility := compatibility; - FRenderer.OnProgress := FOnProgress; - FRenderer.RenderMaxMem(MaxMemory); -end; - - -procedure TRenderThread.Render(Time: double); -begin - if assigned(FRenderer) then - FRenderer.Free; - - FRenderer := TRenderer32.Create; - FRenderer.SetCP(FCP); - FRenderer.compatibility := compatibility; - FRenderer.OnProgress := FOnProgress; - FRenderer.Render(Time); -end; - procedure TRenderThread.SetCP(CP: TControlPoint); begin FCP := CP; @@ -127,7 +99,7 @@ begin if assigned(FRenderer) then FRenderer.Free; - FRenderer := TRenderer32.Create; + FRenderer := TRenderer64.Create; FRenderer.SetCP(FCP); FRenderer.compatibility := compatibility; FRenderer.OnProgress := FOnProgress; @@ -136,10 +108,10 @@ end; procedure TRenderThread.Execute; begin - if MaxMem = 0 then - Render - else - RenderMaxMem(MaxMem); +// if MaxMem = 0 then + Render; +// else +// RenderMaxMem(MaxMem); if Terminated then PostMessage(TargetHandle, WM_THREAD_TERMINATE, 0, 0)