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

new files for version 2.05

Browse Source
This commit is contained in:
zueuk 2006-08-22 13:39:27 +00:00
parent c3e610920f
commit 53e8c17ac2
9 changed files with 2167 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

345
2.10/Source/Render32.pas Normal file
View File

@ -0,0 +1,345 @@
{
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 Render32;
{$define _ASM_}
interface
uses
Windows, Classes, Forms, Graphics,
RenderST, RenderTypes, Xform, ControlPoint;
type
TRenderer32 = class(TBaseSTRenderer)
protected
Buckets: TBucket32Array;
function GetBits: integer; override;
function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
procedure ClearBuckets; override;
protected
procedure IterateBatch; override;
procedure IterateBatchAngle; override;
procedure IterateBatchFX; override;
procedure IterateBatchAngleFX; override;
end;
// ----------------------------------------------------------------------------
type
TRenderer32MM = class(TRenderer32)
protected
procedure CalcBufferSize; override;
public
procedure Render; override;
end;
implementation
uses
Math, Sysutils;
{ TRenderer32 }
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.ClearBuckets;
var
i, j: integer;
begin
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;
///////////////////////////////////////////////////////////////////////////////
function TRenderer32.GetBits: integer;
begin
Result := BITS_32;
end;
function TRenderer32.GetBucketsPtr: pointer;
begin
Result := Buckets;
end;
procedure TRenderer32.AllocateBuckets;
begin
SetLength(buckets, BucketHeight, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32.IterateBatch;
var
i: integer;
px, py: double;
Bucket: PBucket32;
MapColor: PColorMapColor;
p: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
px := p.x - camX0;
if (px < 0) or (px > camW) then continue;
py := p.y - camY0;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer32.IterateBatchAngle;
var
i: integer;
px, py: double;
Bucket: PBucket32;
MapColor: PColorMapColor;
p: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
px := p.x * cosa + p.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := p.y * cosa - p.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer32.IterateBatchFX;
var
i: integer;
px, py: double;
Bucket: PBucket32;
MapColor: PColorMapColor;
p, q: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
finalXform.NextPointTo(p, q);
px := q.x - camX0;
if (px < 0) or (px > camW) then continue;
py := q.y - camY0;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer32.IterateBatchAngleFX;
var
i: integer;
px, py: double;
Bucket: PBucket32;
MapColor: PColorMapColor;
p, q: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
finalXform.NextPointTo(p, q);
px := q.x * cosa + q.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := q.y * cosa - q.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)];
Inc(Bucket.Red, MapColor.Red);
Inc(Bucket.Green, MapColor.Green);
Inc(Bucket.Blue, MapColor.Blue);
Inc(Bucket.Count);
end;
except
on EMathError do begin
exit;
end;
end;
end;
// -- { TRenderer32MM } -------------------------------------------------------
procedure TRenderer32MM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderer32MM.Render;
begin
RenderMM;
end;
end.

165
2.10/Source/Render32MT.pas Normal file
View File

@ -0,0 +1,165 @@
{
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 Render32MT;
interface
uses
Windows, Forms, Classes, Graphics,
Render, RenderMT, ControlPoint, ImageMaker, RenderTypes;
type
TRenderer32MT = class(TBaseMTRenderer)
protected
Buckets: TBucket32Array;
// ColorMap: TColorMapArray;
function GetBits: integer; override;
function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
procedure ClearBuckets; override;
public
procedure AddPointsToBuckets(const points: TPointsArray); override;
procedure AddPointsToBucketsAngle(const points: TPointsArray); override;
end;
// ----------------------------------------------------------------------------
type
TRenderer32MT_MM = class(TRenderer32MT)
protected
procedure CalcBufferSize; override;
public
procedure Render; override;
end;
implementation
uses
Math, Sysutils;
{ TRenderer32MT }
///////////////////////////////////////////////////////////////////////////////
function TRenderer32MT.GetBits: integer;
begin
Result := BITS_32;
end;
function TRenderer32MT.GetBucketsPtr: pointer;
begin
Result := Buckets;
end;
procedure TRenderer32MT.AllocateBuckets;
begin
SetLength(buckets, BucketHeight, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32MT.ClearBuckets;
var
i, j: integer;
begin
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;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32MT.AddPointsToBuckets(const points: TPointsArray);
var
i: integer;
px, py: double;
// R: double;
// V1, v2, v3: integer;
Bucket: PBucket32;
MapColor: PColorMapColor;
begin
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
// if FStop then Exit;
px := points[i].x - camX0;
if (px < 0) or (px > camW) then continue;
py := points[i].y - camY0;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(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 TRenderer32MT.AddPointsToBucketsAngle(const points: TPointsArray);
var
i: integer;
px, py: double;
Bucket: PBucket32;
MapColor: PColorMapColor;
begin
for i := SUB_BATCH_SIZE - 1 downto 0 do begin
// if FStop then Exit;
px := points[i].x * cosa + points[i].y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := points[i].y * cosa - points[i].x * sina + rcY;
if (py < 0) or (py > camH) then continue;
Bucket := @buckets[Round(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;
// -- { TRenderer32MT_MM } ----------------------------------------------------
procedure TRenderer32MT_MM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderer32MT_MM.Render;
begin
RenderMM;
end;
end.

381
2.10/Source/Render32f.pas Normal file
View File

@ -0,0 +1,381 @@
{
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 Render32f;
{$define _ASM_}
interface
uses
Windows, Classes, Forms, Graphics, ImageMaker,
RenderST, RenderTypes, Xform, ControlPoint;
type
TRenderer32f = class(TBaseSTRenderer)
protected
Buckets: TBucket32fArray;
ColorMap: array[0..255] of TFloatColor;
// FImageMaker: TImageMaker;
function GetBits: integer; override;
function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
// procedure InitBuffers; override;
procedure ClearBuckets; override;
procedure CreateColorMap; override;
protected
// procedure SetPixels; override;
procedure IterateBatch; override;
procedure IterateBatchAngle; override;
procedure IterateBatchFX; override;
procedure IterateBatchAngleFX; override;
public
// procedure Render; override;
end;
// ----------------------------------------------------------------------------
type
TRenderer32fMM = class(TRenderer32f)
protected
procedure CalcBufferSize; override;
public
procedure Render; override;
end;
implementation
uses
Math, Sysutils;
///////////////////////////////////////////////////////////////////////////////
//
//{ TRenderer32f }
//
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32f.ClearBuckets;
var
i, j: integer;
begin
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;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32f.CreateColorMap;
var
i: integer;
begin
for i := 0 to 255 do
with ColorMap[i] do begin
Red := (fcp.CMap[i][0] * fcp.white_level) / 256;
Green := (fcp.CMap[i][1] * fcp.white_level) / 256;
Blue := (fcp.CMap[i][2] * fcp.white_level) / 256;
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TRenderer32f.GetBits: integer;
begin
Result := BITS_32f;
end;
function TRenderer32f.GetBucketsPtr: pointer;
begin
Result := Buckets;
end;
procedure TRenderer32f.AllocateBuckets;
begin
SetLength(buckets, BucketHeight, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32f.IterateBatch;
var
i: integer;
px, py: double;
pBucket: PBucket32f;
MapColor: ^TFloatColor;
p: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
px := p.x - camX0;
if (px < 0) or (px > camW) then continue;
py := p.y - camY0;
if (py < 0) or (py > camH) then continue;
pBucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)];
with pBucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer32f.IterateBatchAngle;
var
i: integer;
px, py: double;
pBucket: PBucket32f;
MapColor: ^TFloatColor;
p: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
px := p.x * cosa + p.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := p.y * cosa - p.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
pBucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)];
with pBucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer32f.IterateBatchFX;
var
i: integer;
px, py: double;
pBucket: PBucket32f;
MapColor: ^TFloatColor;
p, q: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
finalXform.NextPointTo(p, q);
px := q.x - camX0;
if (px < 0) or (px > camW) then continue;
py := q.y - camY0;
if (py < 0) or (py > camH) then continue;
pBucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)];
with pBucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer32f.IterateBatchAngleFX;
var
i: integer;
px, py: double;
pBucket: PBucket32f;
MapColor: ^TFloatColor;
p, q: TCPPoint;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
finalXform.NextPointTo(p, q);
px := q.x * cosa + q.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := q.y * cosa - q.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
pBucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)];
with pBucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
end;
except
on EMathError do begin
exit;
end;
end;
end;
// -- { TRenderer32fMM } ------------------------------------------------------
procedure TRenderer32fMM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderer32fMM.Render;
begin
RenderMM;
end;
end.

187
2.10/Source/Render32fMT.pas Normal file
View File

@ -0,0 +1,187 @@
{
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 Render32fMT;
interface
uses
Windows, Forms, Classes, Graphics,
Render, RenderMT, Controlpoint, ImageMaker, BucketFillerthread, RenderTypes;
type
TRenderer32fMT = class(TBaseMTRenderer)
protected
Buckets: TBucket32fArray;
FloatColorMap: array[0..255] of TFloatColor;
function GetBits: integer; override;
function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
procedure ClearBuckets; override;
procedure CreateColorMap; override;
public
procedure AddPointsToBuckets(const points: TPointsArray); override;
procedure AddPointsToBucketsAngle(const points: TPointsArray); override;
end;
// ----------------------------------------------------------------------------
type
TRenderer32fMT_MM = class(TRenderer32fMT)
protected
procedure CalcBufferSize; override;
public
procedure Render; override;
end;
implementation
uses
Math, Sysutils;
{ TRenderer32fMT }
///////////////////////////////////////////////////////////////////////////////
function TRenderer32fMT.GetBits: integer;
begin
Result := BITS_32f;
end;
function TRenderer32fMT.GetBucketsPtr: pointer;
begin
Result := Buckets;
end;
procedure TRenderer32fMT.AllocateBuckets;
begin
SetLength(buckets, BucketHeight, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32fMT.ClearBuckets;
var
i, j: integer;
begin
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;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32fMT.CreateColorMap;
var
i: integer;
begin
for i := 0 to 255 do
with FloatColorMap[i] do begin
Red := (fcp.CMap[i][0] * fcp.white_level) / 256;
Green := (fcp.CMap[i][1] * fcp.white_level) / 256;
Blue := (fcp.CMap[i][2] * fcp.white_level) / 256;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32fMT.AddPointsToBuckets(const points: TPointsArray);
var
i: integer;
px, py: double;
// R: double;
// V1, v2, v3: integer;
pBucket: PBucket32f;
MapColor: ^TFloatColor;
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;
pBucket := @Buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @FloatColorMap[Round(points[i].c * 255)];
with pBucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32fMT.AddPointsToBucketsAngle(const points: TPointsArray);
var
i: integer;
px, py: double;
pBucket: PBucket32f;
MapColor: ^TFloatColor;
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;
pBucket := @Buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @FloatColorMap[Round(points[i].c * 255)];
with pBucket^ do begin
Red := Red + MapColor.Red;
Green := Green + MapColor.Green;
Blue := Blue + MapColor.Blue;
Count := Count + 1;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
//
// { TRenderer32fMT_MM }
//
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer32fMT_MM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderer32fMT_MM.Render;
begin
RenderMM;
end;
end.

481
2.10/Source/Render48.pas Normal file
View File

@ -0,0 +1,481 @@
{
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 Render48;
{$define _ASM_}
interface
uses
Windows, Classes, Forms, Graphics, ImageMaker,
RenderST, RenderTypes, Xform, ControlPoint;
type
pInt64 = ^int64;
type
TRenderer48 = class(TBaseSTRenderer)
protected
Buckets: TBucket48Array;
ColorMap: TColorMapArray;
function GetBits: integer; override;
function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
// procedure InitBuffers; override;
procedure ClearBuckets; override;
procedure CreateColorMap; override;
protected
procedure IterateBatch; override;
procedure IterateBatchAngle; override;
procedure IterateBatchFX; override;
procedure IterateBatchAngleFX; override;
end;
// ----------------------------------------------------------------------------
type
TRenderer48MM = class(TRenderer48)
protected
procedure CalcBufferSize; override;
public
procedure Render; override;
end;
implementation
uses
Math, Sysutils;
{ TRenderer48 }
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer48.ClearBuckets;
var
i, j: integer;
begin
for j := 0 to BucketHeight - 1 do
for i := 0 to BucketWidth - 1 do
with buckets[j][i] do begin
rl := 0; rh := 0;
gl := 0; gh := 0;
bl := 0; bh := 0;
cl := 0; ch := 0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer48.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;
///////////////////////////////////////////////////////////////////////////////
function TRenderer48.GetBits: integer;
begin
Result := BITS_48;
end;
function TRenderer48.GetBucketsPtr: pointer;
begin
Result := Buckets;
end;
procedure TRenderer48.AllocateBuckets;
begin
SetLength(buckets, BucketHeight, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer48.IterateBatch;
var
i: integer;
px, py: double;
pBucket: PBucket48;
MapColor: PColorMapColor;
p: TCPPoint;
t: int64;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
px := p.x - camX0;
if (px < 0) or (px > camW) then continue;
py := p.y - camY0;
if (py < 0) or (py > camH) then continue;
pBucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)];
{$ifndef _ASM_}
// HACK warning!!!
// this WILL corrupt data in case of 48-bit overflow!
Inc((pInt64(@pBucket^.rl))^, MapColor.Red);
Inc((pInt64(@pBucket^.gl))^, MapColor.Green);
Inc((pInt64(@pBucket^.bl))^, MapColor.Blue);
Inc((pInt64(@pBucket^.cl))^);
{$else}
asm
mov edx, [MapColor]
mov ecx, [pBucket]
mov eax, [edx]
add [ecx], eax
jnc @skip_r
inc word ptr [ecx + 4]
@skip_r:
mov eax, [edx + 4]
add [ecx + 6], eax
jnc @skip_g
inc word ptr [ecx + 10]
@skip_g:
mov eax, [edx + 8]
add [ecx + 12], eax
jnc @skip_b
inc word ptr [ecx + 16]
@skip_b:
inc [ecx + 18]
jnc @skip_c
inc word ptr [ecx + 22]
@skip_c:
end;
{$endif}
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer48.IterateBatchAngle;
var
i: integer;
px, py: double;
pBucket: PBucket48;
MapColor: PColorMapColor;
p: TCPPoint;
t: int64;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
px := p.x * cosa + p.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := p.y * cosa - p.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
pBucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(p.c * 255)];
{$ifndef _ASM_}
// HACK warning!!!
// this WILL corrupt data in case of 48-bit overflow!
Inc((pInt64(@pBucket^.rl))^, MapColor.Red);
Inc((pInt64(@pBucket^.gl))^, MapColor.Green);
Inc((pInt64(@pBucket^.bl))^, MapColor.Blue);
Inc((pInt64(@pBucket^.cl))^);
{$else}
asm
mov edx, [MapColor]
mov ecx, [pBucket]
mov eax, [edx]
add [ecx], eax
jnc @skip_r
inc word ptr [ecx + 4]
@skip_r:
mov eax, [edx + 4]
add [ecx + 6], eax
jnc @skip_g
inc word ptr [ecx + 10]
@skip_g:
mov eax, [edx + 8]
add [ecx + 12], eax
jnc @skip_b
inc word ptr [ecx + 16]
@skip_b:
inc [ecx + 18]
jnc @skip_c
inc word ptr [ecx + 22]
@skip_c:
end;
{$endif}
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer48.IterateBatchFX;
var
i: integer;
px, py: double;
pBucket: PBucket48;
MapColor: PColorMapColor;
p, q: TCPPoint;
t: int64;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
finalXform.NextPointTo(p, q);
px := q.x - camX0;
if (px < 0) or (px > camW) then continue;
py := q.y - camY0;
if (py < 0) or (py > camH) then continue;
pBucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)];
{$ifndef _ASM_}
// HACK warning!!!
// this WILL corrupt color-data in case of 48-bit overflow!
Inc((pInt64(@pBucket^.rl))^, MapColor.Red);
Inc((pInt64(@pBucket^.gl))^, MapColor.Green);
Inc((pInt64(@pBucket^.bl))^, MapColor.Blue);
Inc((pInt64(@pBucket^.cl))^);
{$else}
asm
mov edx, [MapColor]
mov ecx, [pBucket]
mov eax, [edx]
add [ecx], eax
jnc @skip_r
inc word ptr [ecx + 4]
@skip_r:
mov eax, [edx + 4]
add [ecx + 6], eax
jnc @skip_g
inc word ptr [ecx + 10]
@skip_g:
mov eax, [edx + 8]
add [ecx + 12], eax
jnc @skip_b
inc word ptr [ecx + 16]
@skip_b:
inc [ecx + 18]
jnc @skip_c
inc word ptr [ecx + 22]
@skip_c:
end;
{$endif}
end;
except
on EMathError do begin
exit;
end;
end;
end;
procedure TRenderer48.IterateBatchAngleFX;
var
i: integer;
px, py: double;
pBucket: PBucket48;
MapColor: PColorMapColor;
p, q: TCPPoint;
t: int64;
begin
{$ifndef _ASM_}
p.x := 2 * random - 1;
p.y := 2 * random - 1;
p.c := random;
{$else}
asm
fld1
call System.@RandExt
fadd st, st
fsub st, st(1)
fstp qword ptr [p.x]
call System.@RandExt
fadd st, st
fsubrp st(1), st
fstp qword ptr [p.y]
call System.@RandExt
fstp qword ptr [p.c]
end;
{$endif}
try
for i := 0 to FUSE do
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
for i := 0 to SUB_BATCH_SIZE-1 do begin
PropTable[Random(PROP_TABLE_SIZE)].NextPoint(p);
finalXform.NextPointTo(p, q);
px := q.x * cosa + q.y * sina + rcX;
if (px < 0) or (px > camW) then continue;
py := q.y * cosa - q.x * sina + rcY;
if (py < 0) or (py > camH) then continue;
pBucket := @buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(q.c * 255)];
{$ifndef _ASM_}
// HACK warning!!!
// this WILL corrupt color-data in case of 48-bit overflow!
Inc((pInt64(@pBucket^.rl))^, MapColor.Red);
Inc((pInt64(@pBucket^.gl))^, MapColor.Green);
Inc((pInt64(@pBucket^.bl))^, MapColor.Blue);
Inc((pInt64(@pBucket^.cl))^);
{$else}
asm
mov edx, [MapColor]
mov ecx, [pBucket]
mov eax, [edx]
add [ecx], eax
jnc @skip_r
inc word ptr [ecx + 4]
@skip_r:
mov eax, [edx + 4]
add [ecx + 6], eax
jnc @skip_g
inc word ptr [ecx + 10]
@skip_g:
mov eax, [edx + 8]
add [ecx + 12], eax
jnc @skip_b
inc word ptr [ecx + 16]
@skip_b:
inc [ecx + 18]
jnc @skip_c
inc word ptr [ecx + 22]
@skip_c:
end;
{$endif}
end;
except
on EMathError do begin
exit;
end;
end;
end;
// -- { TRenderer32MM } -------------------------------------------------------
procedure TRenderer48MM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderer48MM.Render;
begin
RenderMM;
end;
end.

210
2.10/Source/Render48MT.pas Normal file
View File

@ -0,0 +1,210 @@
{
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 Render48MT;
interface
uses
Windows, Forms, Classes, Graphics,
Render, RenderMT, ImageMaker, ControlPoint, RenderTypes;
type
TRenderer48MT = class(TBaseMTRenderer)
protected
Buckets: TBucket48Array;
// ColorMap: TColorMapArray;
function GetBits: integer; override;
function GetBucketsPtr: pointer; override;
procedure AllocateBuckets; override;
procedure ClearBuckets; override;
// procedure CreateColorMap; override;
public
procedure AddPointsToBuckets(const points: TPointsArray); override;
procedure AddPointsToBucketsAngle(const points: TPointsArray); override;
end;
// ----------------------------------------------------------------------------
type
TRenderer48MT_MM = class(TRenderer48MT)
protected
procedure CalcBufferSize; override;
public
procedure Render; override;
end;
implementation
uses
Math, Sysutils;
{ TRenderer48MT }
///////////////////////////////////////////////////////////////////////////////
function TRenderer48MT.GetBits: integer;
begin
Result := BITS_48;
end;
function TRenderer48MT.GetBucketsPtr: pointer;
begin
Result := Buckets;
end;
procedure TRenderer48MT.AllocateBuckets;
begin
SetLength(buckets, BucketHeight, BucketWidth);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer48MT.ClearBuckets;
var
i, j: integer;
begin
for j := 0 to BucketHeight - 1 do
for i := 0 to BucketWidth - 1 do
with buckets[j][i] do begin
rl := 0; rh := 0;
gl := 0; gh := 0;
bl := 0; bh := 0;
cl := 0; ch := 0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer48MT.AddPointsToBuckets(const points: TPointsArray);
var
i: integer;
px, py: double;
// R: double;
// V1, v2, v3: integer;
pBucket: PBucket48;
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;
pBucket := @Buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(points[i].c * 255)];
asm
mov edx, [MapColor]
mov ecx, [pBucket]
mov eax, [edx]
add [ecx], eax
jnc @skip_r
inc word ptr [ecx + 4]
@skip_r:
mov eax, [edx + 4]
add [ecx + 6], eax
jnc @skip_g
inc word ptr [ecx + 10]
@skip_g:
mov eax, [edx + 8]
add [ecx + 12], eax
jnc @skip_b
inc word ptr [ecx + 16]
@skip_b:
inc [ecx + 18]
jnc @skip_c
inc word ptr [ecx + 22]
@skip_c:
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer48MT.AddPointsToBucketsAngle(const points: TPointsArray);
var
i: integer;
px, py: double;
pBucket: PBucket48;
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;
pBucket := @Buckets[Round(bhs * py)][Round(bws * px)];
MapColor := @ColorMap[Round(points[i].c * 255)];
asm
mov edx, [MapColor]
mov ecx, [pBucket]
mov eax, [edx]
add [ecx], eax
jnc @skip_r
inc word ptr [ecx + 4]
@skip_r:
mov eax, [edx + 4]
add [ecx + 6], eax
jnc @skip_g
inc word ptr [ecx + 10]
@skip_g:
mov eax, [edx + 8]
add [ecx + 12], eax
jnc @skip_b
inc word ptr [ecx + 16]
@skip_b:
inc [ecx + 18]
jnc @skip_c
inc word ptr [ecx + 22]
@skip_c:
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
//
// { TRenderer48MT_MM }
//
///////////////////////////////////////////////////////////////////////////////
procedure TRenderer48MT_MM.CalcBufferSize;
begin
CalcBufferSizeMM;
end;
procedure TRenderer48MT_MM.Render;
begin
RenderMM;
end;
end.

183
2.10/Source/RenderMT.pas Normal file
View File

@ -0,0 +1,183 @@
{
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 RenderMT;
interface
uses
Windows, Forms, Classes, Graphics,
Render, Controlpoint, ImageMaker, BucketFillerthread, RenderTypes;
type
TBaseMTRenderer = class(TBaseRenderer)
private
batchcounter: Integer;
WorkingThreads: array of TBucketFillerThread;
CriticalSection: TRTLCriticalSection;
function NewThread: TBucketFillerThread;
protected
procedure Prepare; override;
procedure SetPixels; override;
procedure AddPointsToBuckets(const points: TPointsArray); virtual; abstract;
procedure AddPointsToBucketsAngle(const points: TPointsArray); virtual; abstract;
public
procedure Stop; override;
procedure Break; override;
procedure Pause; override;
procedure UnPause; override;
end;
implementation
uses
Math, Sysutils;
{ TBaseMTRenderer }
///////////////////////////////////////////////////////////////////////////////
procedure TBaseMTRenderer.SetPixels;
var
i: integer;
nSamples: Int64;
bc : integer;
begin
if strOutput <> nil then begin
if FNumSlices > 1 then
strOutput.Add(TimeToStr(Now) + Format(' : Rendering slice #%d...', [FSlice + 1]))
else
strOutput.Add(TimeToStr(Now) + ' : Rendering...');
end;
nSamples := Round(sample_density * NrSlices * BucketSize / (oversample * oversample));
FNumBatches := Round(nSamples / (fcp.nbatches * SUB_BATCH_SIZE));
if FNumBatches = 0 then FNumBatches := 1;
FMinBatches := Round(FNumBatches * FMinDensity / fcp.sample_density);
batchcounter := 1;
Randomize;
InitializeCriticalSection(CriticalSection);
SetLength(WorkingThreads, NumThreads);
for i := 0 to NumThreads - 1 do
WorkingThreads[i] := NewThread;
for i := 0 to NumThreads - 1 do
WorkingThreads[i].Resume;
bc := 1;
while (FStop = 0) and (bc <= FNumBatches) do begin
sleep(250);
try
EnterCriticalSection(CriticalSection);
Progress(batchcounter / FNumBatches);
bc := batchcounter;
finally
LeaveCriticalSection(CriticalSection);
end;
end;
for i := 0 to High(WorkingThreads) do begin
WorkingThreads[i].Terminate;
end;
SetLength(WorkingThreads, 0);
fcp.actual_density := fcp.actual_density +
fcp.sample_density * BatchCounter / FNumBatches; // actual quality of incomplete render
FNumBatches := BatchCounter;
DeleteCriticalSection(CriticalSection);
Progress(1);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseMTRenderer.Prepare;
begin
fcp.Prepare;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TBaseMTRenderer.Stop;
var
i: integer;
begin
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Terminate;
SetLength(WorkingThreads, 0); //?
inherited; // FStop := 1;
end;
procedure TBaseMTRenderer.Break;
var
i: integer;
begin
inherited; // FStop := -1;
{if BatchCounter < FMinBatches then exit;}
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Terminate;
SetLength(WorkingThreads, 0); //?
end;
procedure TBaseMTRenderer.Pause;
var
i: integer;
begin
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Suspend;
end;
procedure TBaseMTRenderer.UnPause;
var
i: integer;
begin
for i := 0 to High(WorkingThreads) do
WorkingThreads[i].Resume;
end;
///////////////////////////////////////////////////////////////////////////////
function TBaseMTRenderer.NewThread: TBucketFillerThread;
begin
Result := TBucketFillerThread.Create(fcp);
assert(Result<>nil);
if FCP.FAngle = 0 then
Result.AddPointsProc := self.AddPointsToBuckets
else
Result.AddPointsProc := self.AddPointsToBucketsAngle;
Result.CriticalSection := CriticalSection;
Result.Nrbatches := FNumBatches;
Result.batchcounter := @batchcounter;
end;
end.

125
2.10/Source/RenderST.pas Normal file
View File

@ -0,0 +1,125 @@
unit RenderST;
interface
uses
Windows, Classes, Forms, Graphics, ImageMaker,
Render, RenderTypes, Xform, ControlPoint;
type
TBatchProc = procedure of object;
type
TBaseSTRenderer = class(TBaseRenderer)
protected
PropTable: array[0..SUB_BATCH_SIZE] of TXform;
finalXform: TXform;
UseFinalXform: boolean;
procedure Prepare; override;
procedure SetPixels; override;
procedure IterateBatch; virtual; abstract;
procedure IterateBatchAngle; virtual; abstract;
procedure IterateBatchFX; virtual; abstract;
procedure IterateBatchAngleFX; virtual; abstract;
end;
implementation
uses
Math, Sysutils;
{ TBaseSTRenderer }
///////////////////////////////////////////////////////////////////////////////
procedure TBaseSTRenderer.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 TBaseSTRenderer.SetPixels;
var
i: integer;
nsamples: int64;
IterateBatchProc: procedure of object;
begin
if Assigned(strOutput) then begin
if FNumSlices > 1 then
strOutput.Add(TimeToStr(Now) + Format(' : Rendering slice #%d...', [FSlice + 1]))
else
strOutput.Add(TimeToStr(Now) + ' : Rendering...');
end;
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));
FNumBatches := Round(nsamples / (fcp.nbatches * SUB_BATCH_SIZE));
if FNumBatches = 0 then FNumBatches := 1;
FMinBatches := Round(FNumBatches * FMinDensity / fcp.sample_density);
if FMinBatches = 0 then FMinBatches := 1;
for i := 0 to FNumBatches-1 do begin
if FStop <> 0 then begin
// if (FStop < 0) or (i >= FMinBatches) then begin //?
fcp.actual_density := fcp.actual_density +
fcp.sample_density * i / FNumBatches; // actual quality of incomplete render
FNumBatches := i;
exit;
end;
if ((i and $1F) = 0) then Progress(i / FNumBatches);
IterateBatchProc;
end;
fcp.actual_density := fcp.actual_density + fcp.sample_density;
Progress(1);
end;
end.

90
2.10/Source/RenderTypes.pas Normal file
View File

@ -0,0 +1,90 @@
unit RenderTypes;
interface
type
TOnProgress = procedure(prog: double) of object;
TOnOutput = procedure(s: string) of object;
type
TColorMapColor = Record
Red,
Green,
Blue: integer; //Int64;
// Count: Int64;
end;
PColorMapColor = ^TColorMapColor;
TColorMapArray = array[0..255] of TColorMapColor;
TFloatColor = Record
Red,
Green,
Blue: single;
end;
TBucket64 = Record
Red,
Green,
Blue,
Count: Int64;
end;
PBucket64 = ^TBucket64;
TBucket64Array = array of array of TBucket64;
// PBucket64Array = ^PBucket64Array;
TBucket48 = packed record
rl: longword; rh: word;
gl: longword; gh: word;
bl: longword; bh: word;
cl: longword; ch: word;
end;
PBucket48 = ^TBucket48;
TBucket48Array = array of array of TBucket48;
// PBucket48Array = ^PBucket48Array;
TBucket32f = record
Red,
Green,
Blue,
Count: single;
end;
PBucket32f = ^TBucket32f;
TBucket32fArray = array of array of TBucket32f;
// PBucket32fArray = ^PBucket32fArray;
TBucket32 = Record
Red,
Green,
Blue,
Count: Longword;
end;
PBucket32 = ^TBucket32;
TBucket32Array = array of array of TBucket32;
TBucket64f = Record
Red,
Green,
Blue,
Count: double;
end;
const
MAX_FILTER_WIDTH = 25;
const
BITS_32 = 0;
BITS_32f = 1;
BITS_48 = 2;
BITS_64 = 3;
SizeOfBucket: array[0..3] of byte = (16, 16, 24, 32);
type
TBucketStats = record
MaxR, MaxG, MaxB, MaxA,
TotalA, TotalSamples: int64;
RenderTime: TDateTime;
end;
implementation
end.