Initial commit of 1992 raytracing code
This commit is contained in:
commit
3f46e7dd82
42 changed files with 8483 additions and 0 deletions
535
turbo-pascal/rayshade.pas
Normal file
535
turbo-pascal/rayshade.pas
Normal file
|
|
@ -0,0 +1,535 @@
|
|||
{ 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.
|
||||
Loading…
Add table
Add a link
Reference in a new issue