http://www.mrio-software.com/2k_raytracer.php
Anybody game enough to translate this to delphi?
-d
"Dennis Landi" <none[at]none.com> wrote in message
news:3f0c...@newsgroups.borland.com...
I just looked at the source code. I don't think it's a good idea to
translate this 1:1 to Delphi. It's not much more difficult to rewrite it,
and I guess it would result in a much more readable structure. And I noticed
it can only handle spheres (what's the most simple case of an object in
space). But adding polygons is not too difficult (you simply need a formula
for recognizing the intersection of a line and a plane, and a formula to
check whether this point is inside the polygon, what can be done by
calculating the angles to its corners, well, probably it's even easier if
you only use triangles). I really think it's much better to do it the OOP
way than to put all the code into 2KB.
Jens
I remember I've seen a simple retracer written in Turbo Pascal many years
ago (it was published in a German computer magazine called "DOS EXTRA"). I
think I still have the source code somewhere (but it might be a copyright
problem to use it). Damn, I really would like to write such a thing one day.
Jens
No, perhaps not 1:1 but a valid well-formed Delphi translation would be
illustrative. Up for it?
I don't have any time at the moment. But if you start such a project I'd
like to join next month.
Jens
i don't think it is quite working right, as i cannot light up the front of a
sphere.
Someone else look at it, and see if it looks okay.
i have a headache.
Here's the unit that now contains the TTinyRayTracer class
unit TracerEngine;
interface
(* Sample Usage
var
RayTracer: TTinyRayTracer;
Scene: TBitmap;
begin
RayTracer := TTinyRayTracer.Create;
try
RayTracer.Width := 320;
RayTracer.Height := 200;
Scene := RayTracer.RenderTestScene;
finally
RayTracer.Free;
end;
Scene.SaveToFile('TinyRayTracerScene.bmp');
Scene.Free;
end;
*)
// Tiny raytracer
// ----------------
// Gabriel Gambetta, 2003
// gab...@mrio-software.com
//
// A tiny (2048 bytes) raytracer with antialiasing, reflection and shadows
from
// multiple point lights.
// Only spheres are supported.
//
// <Reflection coefficient 0 <= r <= 1, 0 = opaque, 1 = fully reflective>
//
// The camera is fixed at (0,0,CZ) pointing towards positive Z. The viewport
// size and frustrum are somewhat hardcoded.
//
// The lighting model is too basic. Adding some specular highlight shouldn't
be
// too hard.
//
uses
Graphics;
// Point structure (also used to store colors, rgb maps to xyz)
type
TPt = record
x, y, z: Real;
end;
// Sphere structure
TSphere = record
C: TPt; // Center
r: Real; // Radius
l: TPt; // Color
f: Real; // Reflection coeffient
end;
TTinyRayTracer = class(TObject)
private
FLights: array of TPt;
FSpheres: array of TSphere;
FCameraZ: Integer;
FWidth: Integer;
FHeight: Integer;
procedure TraceRay(const p, q: TPt; var cl: TPt; bi: Integer=0);
procedure CalculateIllumination(ob: TPt; ip: TPt; nm: TPt; var c: TPt; f:
Real; bi: Integer);
public
function AddLight(const x, y, z: Real): Integer;
function AddSphere(
const CenterX, CenterY, CenterZ: Real;
const Radius: Real;
const ColorR, ColorG, ColorB: Integer;
const ReflectionCoefficient: Real): Integer;
function RenderScene: Graphics.TBitmap;
function RenderTestScene: Graphics.TBitmap;
constructor Create;
property Width: Integer read FWidth write FWidth;
property Height: Integer read FHeight write FHeight;
end;
const
CAMERA_Z = -20; // Camera Z
EPSILON = 0.01; // Epsilon
INVALID_T_COEFFICIENT = 9999; // Invalid t coefficient (no object hit by
ray)
AL = 0.25; // Ambient light. 1-AL is contributed by light sources
implementation
uses
SysUtils, Windows;
const
PixelCountMax = 32768;
type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..PixelCountMax-1] of TRGBTriple;
// The math library ;)
function DP(const p, q: TPt): Real;
// Dot product
begin
Result :=
P.x*Q.x +
P.y*Q.y +
P.z*Q.z;
end;
procedure SV(var R: TPt; const V, W: TPt);
// R = V-W
begin
R.x := V.x-W.x;
R.y := V.y-W.y;
R.z := V.z-W.z;
end;
procedure AV(var R: TPt; const V, W: TPt);
// R = V+W
begin
R.x := V.x+W.x;
R.y := V.y+W.y;
R.z := V.z+W.z;
end;
procedure CV(var V: TPt; const W: TPt);
// V = W
begin
V.x := W.x;
V.y := W.y;
V.z := W.z;
end;
procedure MV(var V: TPt; s: Real);
// V := V * s
begin
V.x := V.x*s;
V.y := V.y*s;
V.z := V.z*s;
end;
function IsZero(const V: TPt): Boolean;
// Vector is null?
begin
Result :=
(V.x = 0) and
(V.y = 0) and
(V.z = 0);
end;
function VN(const V: TPt): Real;
// Vector length
begin
Result := Sqrt(DP(V,V));
end;
procedure NV(var V: TPt);
// Normalize vector
var
aux: Real;
begin
aux := VN(V);
MV(V, 1/aux);
end;
{Trace a ray from p to q, return the color cl.
bi is the recursion index, to control whether non-primary
rays spawn shadow and reflection rays.}
procedure TTinyRayTracer.TraceRay(const p, q: TPt; var cl: TPt; bi:
Integer=0);
var
t: Real;
A,B,C,d,h: Real;
i: Integer;
df,oc,nm,ip: TPt;
begin
t := INVALID_T_COEFFICIENT; // Init t at Invalid (no object hit)
// Default is black
cl.x := 0;
cl.y := 0;
cl.z := 0;
// Ray direction vector
SV(df, q, p);{df = Q-P}
for i := Low(FSpheres) to High(FSpheres) do
begin
// Vector from sphere center to ray base
SV(oc, p, FSpheres[i].c); {oc = P-.C}
// Quadratic equation coefficients for intersection between ray and
// sphere. The variable is t.
A := DP(df,df);
B := 2.0*DP(df,oc);
C := DP(oc,oc)-Sqr(FSpheres[i].r);
// See if an intersection exists
d := Sqr(B)-4*A*C;
if d>0 then
begin
d := Sqrt(d);
// Test both intersections
h := (-B+d)/(2*A);
if (h > EPSILON) and (h < t) then
begin
t := h;
CV(cl, FSpheres[i].l);
// Calculate normal at intersection point
CV(ip, df);
MV(ip, t);
AV(ip, ip, p);
SV(nm, ip, FSpheres[i].c);
CalculateIllumination(p, ip, nm, cl, FSpheres[i].f, bi);
end;
h := (-B-d)/(2*A);
if (h > EPSILON) and (h < t) then
begin
t := h;
CV(cl, FSpheres[i].l);
// Calculate normal at intersection point
CV(ip, df);
MV(ip, t);
AV(ip, ip, p);
SV(nm,ip, FSpheres[i].c);
CalculateIllumination(p, ip, nm, cl, FSpheres[i].f, bi);
end;
end;
end;
end;
// Calculate illumination. This spawns secondary rays, calculates shadows,
etc
// ob is the observer (base of the ray), ip is the intersection point with
the
// ray with some surface, nm is the normal of the surface at that point, c
is
// the returned color, f is the reflection factor, and bi is the recursion
index.
procedure TTinyRayTracer.CalculateIllumination(ob: TPt; ip: TPt; nm: TPt;
var c: TPt; f: Real; bi: Integer);
var
il, dn: Real;
i: Integer;
d,r,o: TPt;
begin
if bi <= 0 then
Exit; // Stop recursion
il := 0;
for i := Low(FLights) to High(FLights) do // For each light
begin
TraceRay(ip, FLights[i], d, 0); // Trace to light
if IsZero(d) then // If not blocked
begin
SV(d, FLights[i], ip); // Calculate cosine of normal, point to light
dn := VN(nm) * VN(d);
if dn > 0 then
il := il + DP(nm,d)/(dn*Length(FLights));
end;
end;
// Reflection
SV(o,ob,ip); // Point to observer
NV(nm); // Normalize them
NV(o);
// Calculate reflected vector
CV(r,nm);
MV(r,2*DP(nm,o));
SV(r,r,o);
AV(r,ip,r);
// Spawn secondary reflection ray
TraceRay(ip, r, o, bi-1);
// Modify color according to reflection color and coefficient
MV(o,f);
MV(c,1-f);
AV(c,c,o);
// Apply lighting
MV(c,(1-AL)*il+AL);
end;
function TTinyRayTracer.RenderScene: Graphics.TBitmap;
var
x, y: Integer;
CameraPosition: TPt;
TargetPoint: TPt;
RayColor: TPt;
bmScene: Graphics.TBitmap;
Row: PRGBTripleArray;
begin
{Setup the camera position}
CameraPosition.x := 0;
CameraPosition.y := 0;
CameraPosition.z := CAMERA_Z;
TargetPoint.x := 0;
TargetPoint.y := 0;
TargetPoint.z := 0;
{Bitmap to hold the scene}
bmScene := Graphics.TBitmap.Create;
bmScene.PixelFormat := pf24bit;
bmScene.Width := FWidth;
bmScene.Height := FHeight;
for y := 0 to 2*FHeight-1 do // Supersample 2x for antialiasing
begin
TargetPoint.y := (FHeight-y)/20;
Row := bmScene.ScanLine[y div 2];
for x := 0 to 2*FWidth-1 do
begin
TargetPoint.x :=(x-FWidth)/20;
{ Don't you mean FWidth-x instead of x-FWidth,
like when you assign TargetPoint.y?
otherwise q.x goes negative.
-- Ian Boyd, 7/12/2003}
// Spawn primary ray
TraceRay(CameraPosition, TargetPoint, RayColor, 2);
// Accumulate 1/4 of the color (this is the antialiasing code!)
MV(RayColor, 0.25); //Multiply Vector by scalar
Row[x div 2].rgbtRed := Round(RayColor.x);
Row[x div 2].rgbtGreen := Round(RayColor.y);
Row[x div 2].rgbtBlue := Round(RayColor.z);
end;
end;
// Output the result
Result := bmScene;
end;
function TTinyRayTracer.AddLight(const x, y, z: Real): Integer;
var
i: Integer;
begin
SetLength(FLights, Length(FLights)+1); //increase lights array size
i := High(FLights);
FLights[i].x := x; //add the light
FLights[i].y := y;
FLights[i].z := z;
Result := Length(FLights); //return # of lights
end;
function TTinyRayTracer.AddSphere(const CenterX, CenterY, CenterZ,
Radius: Real; const ColorR, ColorG, ColorB: Integer;
const ReflectionCoefficient: Real): Integer;
var
i: Integer;
begin
SetLength(FSpheres, Length(FSpheres)+1); //increase spheres array size
i := High(FSpheres);
FSpheres[i].c.x := CenterX;
FSpheres[i].c.y := CenterY;
FSpheres[i].c.z := CenterZ;
FSpheres[i].r := Radius; // Radius
FSpheres[i].l.x := ColorR; //Color (x=R, y=G, z=B)
FSpheres[i].l.y := ColorG;
FSpheres[i].l.z := ColorB;
FSpheres[i].f := ReflectionCoefficient; // Reflection coefficient
Result := Length(FLights); //return # of lights
end;
function TTinyRayTracer.RenderTestScene: Graphics.TBitmap;
begin
{Add 2 lights}
Self.AddLight(-5, 5, 0);
Self.AddLight(2, 15, 11);
{Add 3 spheres}
Self.AddSphere(0, 0, 0, 5, 255, 0, 0, 0.6);
Self.AddSphere(-7, 3, 6, 3, 0, 255, 0, 0);
Self.AddSphere(0, -1000, 0, 995, 255, 192, 128, 0);
Result := Self.RenderScene;
end;
constructor TTinyRayTracer.Create;
begin
inherited Create;
FWidth := 320;
FHeight := 200;
end;
end.
-d
// Spawn primary ray
TraceRay(CameraPosition, TargetPoint, RayColor, 2);
// Accumulate 1/4 of the color (this is the antialiasing code!)
// MV(RayColor, 0.25); //Multiply Vector by scalar
{ ^^^^ Comment this out, i don't know how it works anyway}
Row[x div 2].rgbtRed := Round(RayColor.x);
Row[x div 2].rgbtGreen := Round(RayColor.y);
Row[x div 2].rgbtBlue := Round(RayColor.z);
"Dennis Landi" <none[at]none.com> wrote in message
news:3f0c...@newsgroups.borland.com...