535 lines
No EOL
14 KiB
ObjectPascal
535 lines
No EOL
14 KiB
ObjectPascal
{ RAYTRACE.PAS }
|
|
{ Ray-tracing unit, generic. (with shading) }
|
|
|
|
unit RayShade;
|
|
|
|
interface
|
|
uses Objects;
|
|
{ Base objects on Turbo Vision's TObject to make them useable on
|
|
Turbo Vision streams. }
|
|
|
|
type
|
|
VECTOR = object
|
|
dx, dy, dz: real; { Three dimensional vector }
|
|
end;
|
|
RAY = object
|
|
dx, dy, dz: real; { Direction vector }
|
|
ox, oy, oz: real; { Origin }
|
|
constructor Init (x, y, z, vx, vy, vz: real);
|
|
end;
|
|
|
|
PObj3d = ^Obj3d;
|
|
PLightSource = ^LightSource;
|
|
PUniverse = ^Universe;
|
|
|
|
LightSource = object(TObject)
|
|
Owner: PUniverse;
|
|
xp,yp,zp: Real;
|
|
br,bg,bb: Real;
|
|
constructor Init(x,y,z,r,g,b: Real);
|
|
end;
|
|
|
|
Obj3d = object(TObject)
|
|
Owner: PUniverse;
|
|
xp,yp,zp: Real;
|
|
refl: Real;
|
|
constructor Init(x,y,z,r: Real);
|
|
function Intersect(aray: RAY): Real; virtual;
|
|
procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual;
|
|
procedure ReflectRay(aray: Ray; time: Real; var oray: Ray); virtual;
|
|
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
|
function Shade(aray: Ray; time: Real; c: LongInt): LongInt; virtual;
|
|
end;
|
|
PLANE = object(Obj3d)
|
|
nx, ny, nz: real; { Vector normal (perpendicular) to plane }
|
|
constructor Init(x, y, z, vx, vy, vz: real);
|
|
function Intersect(aray: RAY): real; virtual;
|
|
procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual;
|
|
function GetColor(aray: RAY; time: Real): LongInt; virtual;
|
|
end;
|
|
SPHERE = object(Obj3d)
|
|
ra,r2: real; { Radius squared }
|
|
constructor Init(x, y, z, r: real);
|
|
function Intersect(aray: RAY): real; virtual;
|
|
procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual;
|
|
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
|
end;
|
|
|
|
Cylinder = object(Obj3d)
|
|
{ xp,yp,zp = center of bottom circle
|
|
x2,y2,z2 = center of top circle
|
|
ra = radius }
|
|
x2,y2,z2,ra,r2: Real;
|
|
constructor Init(x,y,z,xb,yb,zb,r: Real);
|
|
function Intersect(aray: RAY): real; virtual;
|
|
procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual;
|
|
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
|
end;
|
|
|
|
PlanePnt = object(Plane)
|
|
xb,yb,zb,xc,yc,zc: Real;
|
|
constructor Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Real);
|
|
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
|
end;
|
|
|
|
Universe = object(TObject)
|
|
Width,Height: Integer;
|
|
ar,ag,ab: Real; { Ambient lighting }
|
|
Items,Lights: TCollection;
|
|
constructor Init(aWidth,aHeight: Integer; r,g,b: Real);
|
|
destructor Done; virtual;
|
|
procedure Insert(o: PObj3d);
|
|
procedure Delete(o: PObj3d);
|
|
procedure InsertLight(l: PLightSource);
|
|
procedure DeleteLight(l: PLightSource);
|
|
procedure DeleteAll;
|
|
function RayColor(aray: Ray): LongInt;
|
|
function TraceRay(aray: Ray; var ob: PObj3d): Real;
|
|
function TracePoint(x,y: Integer): LongInt;
|
|
end;
|
|
|
|
|
|
{ LongInt: $00rrggbb }
|
|
procedure SepLong(c: LongInt; var r,g,b: Integer);
|
|
function GetRgb(r,g,b: Integer): LongInt;
|
|
function GetHsv(h,s,v: Integer): LongInt;
|
|
procedure Hsv2Rgb(h,s,v: Integer; var r,g,b: Integer);
|
|
|
|
implementation
|
|
|
|
procedure SepLong(c: LongInt; var r,g,b: Integer);
|
|
begin
|
|
r := (c and $ff0000) shr 16;
|
|
g := (c and $ff00) shr 8;
|
|
b := c and $ff;
|
|
end;
|
|
|
|
procedure Hsv2Rgb(h,s,v: Integer; var r,g,b: Integer);
|
|
var
|
|
rr,gg,bb,f,p1,p2,p3: Integer;
|
|
begin
|
|
while h > 359 do Dec(h,360);
|
|
while h < 0 do Inc(h,360);
|
|
if s < 0 then s := 0;
|
|
if s > 100 then s := 100;
|
|
if v < 0 then v := 0;
|
|
if v > 100 then v := 100;
|
|
|
|
f := (h mod 60) * 5 div 3;
|
|
h := h div 60;
|
|
p1 := v*(100-s) div 625 * 16;
|
|
p2 := v*(100-(s*f div 100)) div 625 * 16;
|
|
p3 := v*(100-(s*(100-f) div 100)) div 625 * 16;
|
|
v := v * 64 div 25;
|
|
case h of
|
|
0: begin r := v; g := p3; b := p1; end;
|
|
1: begin r := p2; g := v; b := p1; end;
|
|
2: begin r := p1; g := v; b := p3; end;
|
|
3: begin r := p1; g := p2; b := v; end;
|
|
4: begin r := p3; g := p1; b := v; end;
|
|
5: begin r := v; g := p1; b := p2; end;
|
|
end;
|
|
end;
|
|
|
|
function GetHsv(h,s,v: Integer): LongInt;
|
|
var r,g,b: Integer;
|
|
begin
|
|
Hsv2Rgb(h,s,v,r,g,b);
|
|
asm
|
|
mov al,byte ptr [b]
|
|
mov byte ptr [@Result],al
|
|
mov al,byte ptr [g]
|
|
mov byte ptr [@Result+1],al
|
|
mov al,byte ptr [r]
|
|
mov byte ptr [@Result+2],al
|
|
mov byte ptr [@Result+3],0
|
|
end;
|
|
end;
|
|
|
|
function GetRgb(r,g,b: Integer): LongInt;
|
|
begin
|
|
if r > 255 then r := 255;
|
|
if r < 0 then r := 0;
|
|
if g > 255 then g := 255;
|
|
if g < 0 then g := 0;
|
|
if b > 255 then b := 255;
|
|
if b < 0 then b := 0;
|
|
asm
|
|
mov al,byte ptr [b]
|
|
mov byte ptr [@Result],al
|
|
mov al,byte ptr [g]
|
|
mov byte ptr [@Result+1],al
|
|
mov al,byte ptr [r]
|
|
mov byte ptr [@Result+2],al
|
|
mov byte ptr [@Result+3],0
|
|
end;
|
|
end;
|
|
|
|
constructor LightSource.Init(x,y,z,r,g,b: Real);
|
|
begin
|
|
TObject.Init;
|
|
xp := x; yp := y; zp := z;
|
|
br := r; bg := g; bb := b;
|
|
end;
|
|
|
|
constructor Obj3d.Init(x,y,z,r: Real);
|
|
begin
|
|
TObject.Init;
|
|
xp := x; yp := y; zp := z; refl := r;
|
|
end;
|
|
|
|
function Obj3d.Intersect(aray: RAY): Real;
|
|
begin
|
|
{ 0 or neg = no intersect }
|
|
Intersect := 0;
|
|
end;
|
|
|
|
procedure Obj3d.SurfNormal(aray: Ray; time: Real; var oray: Ray);
|
|
begin
|
|
{ No intersect, will never get called here }
|
|
end;
|
|
|
|
procedure Obj3d.ReflectRay(aray: RAY; time: real; var oray: RAY);
|
|
var
|
|
normal: Ray; { Used for readability }
|
|
ndotn: real; { Used for readability }
|
|
idotn: real; { Used for readability }
|
|
idotn_div_ndotn_x2: real; { Used for optimization }
|
|
begin
|
|
oray.ox := aray.dx * time + aray.ox; { Find the point of }
|
|
oray.oy := aray.dy * time + aray.oy; { intersection between }
|
|
oray.oz := aray.dz * time + aray.oz; { iray and sphere. }
|
|
SurfNormal(aray,time,normal);
|
|
|
|
ndotn := (normal.dx * normal.dx +
|
|
normal.dy * normal.dy +
|
|
normal.dz * normal.dz);
|
|
idotn := (normal.dx * aray.dx +
|
|
normal.dy * aray.dy +
|
|
normal.dz * aray.dz);
|
|
idotn_div_ndotn_x2 := (2.0 * (idotn) / ndotn);
|
|
|
|
oray.dx := aray.dx - idotn_div_ndotn_x2 * normal.dx;
|
|
oray.dy := aray.dy - idotn_div_ndotn_x2 * normal.dy;
|
|
oray.dz := aray.dz - idotn_div_ndotn_x2 * normal.dz;
|
|
end;
|
|
|
|
function Obj3d.GetColor(aray: Ray; time: Real): LongInt;
|
|
begin
|
|
{ See SurfNormal }
|
|
end;
|
|
|
|
function Obj3d.Shade(aray: Ray; time: Real; c: LongInt): LongInt;
|
|
var
|
|
pl: PLightSource;
|
|
ob: PObj3d;
|
|
costheta,t,d,Ir,Ig,Ib: Real;
|
|
l,n: Ray;
|
|
i: Integer;
|
|
cc: record b,g,r: Byte end absolute c;
|
|
begin
|
|
l.ox := aray.dx*time+aray.ox;
|
|
l.oy := aray.dy*time+aray.oy;
|
|
l.oz := aray.dz*time+aray.oz;
|
|
SurfNormal(aray,time,n);
|
|
d := Sqrt(Sqr(n.dx)+Sqr(n.dy)+Sqr(n.dz));
|
|
if d <> 0 then begin
|
|
n.dx := n.dx / d;
|
|
n.dy := n.dy / d;
|
|
n.dz := n.dz / d;
|
|
end;
|
|
Ir := refl * Owner^.ar;
|
|
Ig := refl * Owner^.ag;
|
|
Ib := refl * Owner^.ab;
|
|
for i := 0 to Owner^.Lights.Count-1 do begin
|
|
pl := PLightSource(Owner^.Lights.At(i));
|
|
l.dx := pl^.xp-(time*aray.dx+aray.ox);
|
|
l.dy := pl^.yp-(time*aray.dy+aray.oy);
|
|
l.dz := pl^.zp-(time*aray.dz+aray.oz);
|
|
d := Sqrt(Sqr(l.dx)+Sqr(l.dy)+Sqr(l.dz));
|
|
if d <> 0 then begin
|
|
l.dx := l.dx / d;
|
|
l.dy := l.dy / d;
|
|
l.dz := l.dz / d;
|
|
end;
|
|
costheta := (n.dx*l.dx + n.dy*l.dy + n.dz*l.dz);
|
|
t := Owner^.TraceRay(l,ob);
|
|
if (costheta > 0) and ((t >= d) or (t < 0.001)) then begin
|
|
Ir := Ir + ((refl * pl^.br) / (d + 0.001)) * costheta;
|
|
Ig := Ig + ((refl * pl^.bg) / (d + 0.001)) * costheta;
|
|
Ib := Ib + ((refl * pl^.bb) / (d + 0.001)) * costheta;
|
|
end;
|
|
end;
|
|
Shade := GetRgb(
|
|
Integer(cc.r)-128+Round(Ir),
|
|
Integer(cc.g)-128+Round(Ig),
|
|
Integer(cc.b)-128+Round(Ib));
|
|
end;
|
|
|
|
|
|
constructor RAY.Init(x, y, z, vx, vy, vz: real);
|
|
begin
|
|
ox := x;
|
|
oy := y;
|
|
oz := z;
|
|
dx := vx;
|
|
dy := vy;
|
|
dz := vz;
|
|
end; { ----- End: RAY::RAY() ----- }
|
|
|
|
constructor SPHERE.Init(x, y, z, r: real);
|
|
begin
|
|
Obj3d.Init(x,y,z,1);
|
|
ra := r;
|
|
r2 := r * r;
|
|
end; { ----- End: SPHERE::SPHERE() ----- }
|
|
|
|
function SPHERE.Intersect(aray: RAY): real;
|
|
var
|
|
a, b, c, t1, t2, t3, close, farther: real;
|
|
begin
|
|
a := aray.dx * aray.dx + aray.dy * aray.dy + aray.dz * aray.dz;
|
|
close := -1.0;
|
|
farther := -1.0;
|
|
if a <> 0 then
|
|
begin
|
|
b := 2.0 * ((aray.ox - xp) * aray.dx
|
|
+ (aray.oy - yp) * aray.dy
|
|
+ (aray.oz - zp) * aray.dz);
|
|
c := (aray.ox - xp) * (aray.ox - xp)
|
|
+ (aray.oy - yp) * (aray.oy - yp)
|
|
+ (aray.oz - zp) * (aray.oz - zp) - r2;
|
|
t1 := b * b - 4.0 * a * c;
|
|
if t1 > 0 then
|
|
begin
|
|
t2 := sqrt(t1);
|
|
t3 := 2.0 * a;
|
|
close := -(b + t2) / t3;
|
|
farther := -(b - t2) / t3;
|
|
end;
|
|
end;
|
|
if close < farther then Intersect := close else Intersect := farther;
|
|
{ Intersect := (double)((close < farther) ? close : farther);}
|
|
end; { ---- End: SPHERE::Intersect() ----- }
|
|
|
|
procedure Sphere.SurfNormal(aray: Ray; time: Real; var oray: Ray);
|
|
begin
|
|
oray.ox := aray.dx * time + aray.ox; { Find the point of }
|
|
oray.oy := aray.dy * time + aray.oy; { intersection between }
|
|
oray.oz := aray.dz * time + aray.oz; { aray and sphere. }
|
|
oray.dx := oray.ox - xp; { Find the ray normal }
|
|
oray.dy := oray.oy - yp; { to the sphere at the }
|
|
oray.dz := oray.oz - zp; { intersection point. }
|
|
end;
|
|
|
|
function Sphere.GetColor(aray: Ray; time: Real): LongInt;
|
|
var
|
|
r: Ray;
|
|
c,c2: LongInt;
|
|
cc: record b,g,r: Byte end absolute c;
|
|
cc2: record b,g,r: Byte end absolute c2;
|
|
begin
|
|
ReflectRay(aray,time,r);
|
|
c := Owner^.RayColor(r);
|
|
c2 := Shade(aray,time,GetRgb(0,0,128));
|
|
cc.r := cc.r div 2 + cc2.r;
|
|
cc.g := cc.g div 2 + cc2.g;
|
|
cc.b := cc.b div 2 + cc2.b;
|
|
GetColor := c;
|
|
end;
|
|
|
|
constructor PLANE.Init(x, y, z, vx, vy, vz: real);
|
|
begin
|
|
Obj3d.Init(x,y,z,0.9);
|
|
nx := vx;
|
|
ny := vy;
|
|
nz := vz;
|
|
end; { ----- End: PLANE::PLANE() ----- }
|
|
|
|
function PlanePattern(x, y: word): LongInt;
|
|
var
|
|
r,g,b: Integer;
|
|
begin
|
|
r := (((x+y) mod 8))*32;
|
|
g := ((x mod 8) xor (y mod 8))*32;
|
|
b := (((x * x + y * y) mod 8))*32;
|
|
PlanePattern := GetRgb(r,g,b);
|
|
end; { ----- End: PlanePattern() ----- }
|
|
|
|
|
|
function PLANE.GetColor(aray: RAY; time: real): LongInt;
|
|
begin
|
|
GetColor := Shade(aray,time,
|
|
PlanePattern(Round(time * aray.dz + aray.oz),
|
|
Round(time * aray.dx + aray.ox)));
|
|
end; { ----- End: PLANE::Pattern() ----- }
|
|
|
|
function PLANE.Intersect(aray: RAY): real;
|
|
var
|
|
p1, p2, p3: real;
|
|
begin
|
|
p1 := xp * nx + yp * ny + zp * nz;
|
|
p2 := aray.ox * nx + aray.oy * ny + aray.oz * nz;
|
|
p3 := aray.dx * nx + aray.dy * ny + aray.dz * nz;
|
|
if p3 = 0 then p3 := 0.001;
|
|
Intersect := (p1-p2)/p3;
|
|
end; { ----- End: PLANE::Intersect() ----- }
|
|
|
|
procedure Plane.SurfNormal(aray: Ray; time: Real; var oray: Ray);
|
|
begin
|
|
oray.dx := nx; oray.dy := ny; oray.dz := nz;
|
|
end;
|
|
|
|
constructor Cylinder.Init(x,y,z,xb,yb,zb,r: Real);
|
|
begin
|
|
Obj3d.Init(x,y,z,0.9);
|
|
x2 := xb; y2 := yb; z2 := zb;
|
|
ra := r; r2 := Sqr(r);
|
|
end;
|
|
|
|
function Cylinder.Intersect(aray: RAY): real;
|
|
begin
|
|
Intersect := 0;
|
|
end;
|
|
|
|
procedure Cylinder.SurfNormal(aray: Ray; time: Real; var oray: Ray);
|
|
begin
|
|
end;
|
|
|
|
function Cylinder.GetColor(aray: Ray; time: Real): LongInt;
|
|
begin
|
|
GetColor := Shade(aray,time,$c0c0c0);
|
|
end;
|
|
|
|
constructor PlanePnt.Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Real);
|
|
var
|
|
a,b,c,d: Real;
|
|
begin
|
|
a := y1*(z2-z3)+y2*(z3-z1)+y3*(z1-z2);
|
|
b := z1*(x2-x3)+z2*(x3-x1)+z3*(x1-x2);
|
|
c := x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2);
|
|
d := -x1*(y2*z3-y3*z2)-x2*(y3*z1-y1*z3)-x3*(y1*z2-y2*z1);
|
|
Plane.Init(x1,y1,z1,a,b,c);
|
|
xb := x2; yb := y2; zb := z2;
|
|
xc := x3; yc := y3; zc := z3;
|
|
end;
|
|
|
|
function PlanePnt.GetColor(aray: Ray; time: Real): LongInt;
|
|
var
|
|
d: Real;
|
|
c: Integer;
|
|
begin
|
|
{d := Sqrt(
|
|
Sqr(time * aray.dx + aray.ox - xp) +
|
|
Sqr(time * aray.dy + aray.oy - yp) +
|
|
Sqr(time * aray.dz + aray.oz - zp));
|
|
if d > 255.0 then d := 255.0;
|
|
c := 255-Round(d);
|
|
if c < 96 then c := 96;}
|
|
GetColor := Shade(aray,time,$c0c0c0);{GetRgb(c,c,c)};
|
|
end;
|
|
|
|
|
|
constructor Universe.Init(aWidth,aHeight: Integer; r,g,b: Real);
|
|
begin
|
|
TObject.Init;
|
|
Width := aWidth; Height := aHeight;
|
|
ar := r; ag := g; ab := b;
|
|
Items.Init(5,5);
|
|
Lights.Init(3,3);
|
|
end;
|
|
|
|
destructor Universe.Done;
|
|
begin
|
|
Items.Done;
|
|
Lights.Done;
|
|
TObject.Done;
|
|
end;
|
|
|
|
procedure Universe.Insert(o: PObj3d);
|
|
begin
|
|
Items.Insert(o);
|
|
o^.Owner := @Self;
|
|
end;
|
|
|
|
procedure Universe.Delete(o: PObj3d);
|
|
begin
|
|
Items.Delete(o);
|
|
o^.Owner := nil;
|
|
end;
|
|
|
|
procedure Universe.InsertLight(l: PLightSource);
|
|
begin
|
|
Lights.Insert(l);
|
|
l^.Owner := @Self;
|
|
end;
|
|
|
|
procedure Universe.DeleteLight(l: PLightSource);
|
|
begin
|
|
Lights.Delete(l);
|
|
l^.Owner := nil;
|
|
end;
|
|
|
|
procedure Universe.DeleteAll;
|
|
begin
|
|
Items.DeleteAll;
|
|
Lights.DeleteAll;
|
|
end;
|
|
|
|
function Universe.RayColor(aray: Ray): LongInt;
|
|
var
|
|
t: Real;
|
|
o: PObj3d;
|
|
begin
|
|
t := TraceRay(aray,o);
|
|
if o = nil then
|
|
RayColor := 0
|
|
else
|
|
RayColor := o^.GetColor(aray,t);
|
|
end;
|
|
|
|
function Universe.TraceRay(aray: Ray; var ob: PObj3d): Real;
|
|
type
|
|
arr = array[0..1000] of Real;
|
|
parr = ^arr;
|
|
var
|
|
times: parr;
|
|
i,j: Integer;
|
|
max: Real;
|
|
procedure TraceOne(o: PObj3d); far;
|
|
begin
|
|
times^[i] := o^.Intersect(aray);
|
|
Inc(i);
|
|
end;
|
|
begin
|
|
GetMem(times,Items.Count*SizeOf(Real));
|
|
i := 0;
|
|
Items.ForEach(@TraceOne);
|
|
max := 1.7e38; { darn big }
|
|
j := -1;
|
|
for i := 0 to Items.Count-1 do
|
|
if (times^[i] < max) and (times^[i] > 0.001) then begin
|
|
max := times^[i]; j := i;
|
|
end;
|
|
if j <> -1 then begin
|
|
ob := Items.At(j);
|
|
TraceRay := max;
|
|
end else begin
|
|
ob := nil;
|
|
TraceRay := 0;
|
|
end;
|
|
FreeMem(Times,Items.Count*SizeOf(Real));
|
|
end;
|
|
|
|
function Universe.TracePoint(x,y: Integer): LongInt;
|
|
var
|
|
r: Ray;
|
|
begin
|
|
r.ox := 0; r.oy := 0; r.oz := 0;
|
|
r.dx := (x - (Width / 2)) / Width;
|
|
r.dy := (y - (Height / 2)) / Height * 0.75;
|
|
r.dz := 1;
|
|
TracePoint := RayColor(r);
|
|
end;
|
|
|
|
end. |