Initial commit of 1992 raytracing code
This commit is contained in:
commit
3f46e7dd82
42 changed files with 8483 additions and 0 deletions
350
turbo-pascal/rayt3.pas
Normal file
350
turbo-pascal/rayt3.pas
Normal file
|
|
@ -0,0 +1,350 @@
|
|||
program RayTracingWithUltraRayTr;
|
||||
{$X+}
|
||||
uses Crt,Vga13h,RayTr;
|
||||
|
||||
type
|
||||
TgaHeader = record { 18 bytes total }
|
||||
who_knows: array[1..12] of Byte;
|
||||
Width: Word;
|
||||
Height: Word;
|
||||
BitsPerPixel: Byte;
|
||||
who_knows2: Byte;
|
||||
end;
|
||||
|
||||
const
|
||||
DefaultHeader: TgaHeader = (
|
||||
who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0);
|
||||
Width: 320;
|
||||
Height: 200;
|
||||
BitsPerPixel: 24;
|
||||
who_knows2: 32
|
||||
);
|
||||
|
||||
var
|
||||
tf: File of byte;
|
||||
ttf: File absolute tf;
|
||||
|
||||
procedure StartTga(s: String);
|
||||
begin
|
||||
Assign(tf,s);
|
||||
Rewrite(tf);
|
||||
BlockWrite(ttf,DefaultHeader,18);
|
||||
end;
|
||||
|
||||
procedure EndTga;
|
||||
begin
|
||||
Close(tf);
|
||||
end;
|
||||
|
||||
procedure TgaDot(r,g,b: Integer);
|
||||
begin
|
||||
if r > 255 then r := 255;
|
||||
if g > 255 then g := 255;
|
||||
if b > 255 then b := 255;
|
||||
if r < 0 then r := 0;
|
||||
if g < 0 then g := 0;
|
||||
if b < 0 then b := 0;
|
||||
Write(tf,Byte(b),Byte(g),Byte(r));
|
||||
end;
|
||||
|
||||
{ r,g,b:0-255 }
|
||||
function Rgb(r,g,b: Integer): Integer;
|
||||
begin
|
||||
if r > 255 then r := 255;
|
||||
if g > 255 then g := 255;
|
||||
if b > 255 then b := 255;
|
||||
if r < 0 then r := 0;
|
||||
if g < 0 then g := 0;
|
||||
if b < 0 then b := 0;
|
||||
Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0);
|
||||
end;
|
||||
|
||||
procedure RgbDot(x,y,r,g,b: Integer);
|
||||
var
|
||||
r1,g1,b1,r2,g2,b2,c1,c2: Integer;
|
||||
begin
|
||||
if r > 255 then r := 255;
|
||||
if g > 255 then g := 255;
|
||||
if b > 255 then b := 255;
|
||||
if r < 0 then r := 0;
|
||||
if g < 0 then g := 0;
|
||||
if b < 0 then b := 0;
|
||||
r1 := r and $e0; g1 := g and $e0; b1 := b and $c0;
|
||||
r2 := r1 + (r mod 32)+16;
|
||||
g2 := g1 + (g mod 32)+16;
|
||||
b2 := b1 + (b mod 64)+32;
|
||||
c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2);
|
||||
if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2);
|
||||
end;
|
||||
|
||||
procedure SetUpRgb;
|
||||
var
|
||||
Clrs: array[0..255,0..2] of Byte;
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to 255 do begin
|
||||
Clrs[i,0] := (i and $e0) shr 2;
|
||||
Clrs[i,1] := (i and $1c) shl 1;
|
||||
Clrs[i,2] := (i and 3) shl 4;
|
||||
case Clrs[i,2] of
|
||||
15..31: Inc(Clrs[i,2],4);
|
||||
32..63: Inc(Clrs[i,2],8);
|
||||
end;
|
||||
end;
|
||||
SetColorBlock(0,256,Clrs);
|
||||
end;
|
||||
|
||||
procedure Save(var u: TUniverse; st: String);
|
||||
var
|
||||
x,y: Integer;
|
||||
c: RgbTriple;
|
||||
r,g,b: Integer;
|
||||
begin
|
||||
StartTga(st);
|
||||
x := 0;
|
||||
for y := 0 to u.ScrHeight-1 do
|
||||
for x := 0 to u.ScrWidth-1 do begin
|
||||
u.TracePoint(x,y,c);
|
||||
r := Trunc(c.r*255);
|
||||
g := Trunc(c.g*255);
|
||||
b := Trunc(c.b*255);
|
||||
RgbDot(x,u.ScrHeight-1-y,r,g,b);
|
||||
TgaDot(r,g,b);
|
||||
end;
|
||||
EndTga;
|
||||
end;
|
||||
|
||||
procedure Draw(var u: TUniverse);
|
||||
var
|
||||
x,y: Integer;
|
||||
c: RgbTriple;
|
||||
r,g,b: Integer;
|
||||
begin
|
||||
x := 0;
|
||||
while (x < u.ScrWidth) and (not KeyPressed) do begin
|
||||
for y := 0 to u.ScrHeight-1 do begin
|
||||
u.TracePoint(x,u.ScrHeight-1-y,c);
|
||||
r := Trunc(c.r*255);
|
||||
g := Trunc(c.g*255);
|
||||
b := Trunc(c.b*255);
|
||||
RgbDot(x,y,r,g,b);
|
||||
end;
|
||||
Inc(x);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Qwik(var u: TUniverse);
|
||||
var
|
||||
x,y: Integer;
|
||||
c: RgbTriple;
|
||||
r,g,b: Integer;
|
||||
begin
|
||||
x := 0;
|
||||
while (x < (u.ScrWidth div 2)) and (not KeyPressed) do begin
|
||||
for y := 0 to (u.ScrHeight div 2)-1 do begin
|
||||
u.TracePoint(x*2,u.ScrHeight-1-(y*2),c);
|
||||
r := Trunc(c.r*255);
|
||||
g := Trunc(c.g*255);
|
||||
b := Trunc(c.b*255);
|
||||
RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b);
|
||||
RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b);
|
||||
end;
|
||||
Inc(x);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Zoom(var u: TUniverse);
|
||||
var
|
||||
x,y,i,j: Integer;
|
||||
c: RgbTriple;
|
||||
r,g,b: Integer;
|
||||
begin
|
||||
x := 0;
|
||||
while (x < (u.ScrWidth div 4)) and (not KeyPressed) do begin
|
||||
for y := 0 to (u.ScrHeight div 4)-1 do begin
|
||||
u.TracePoint(x*4,u.ScrHeight-1-(y*4),c);
|
||||
r := Trunc(c.r*255);
|
||||
g := Trunc(c.g*255);
|
||||
b := Trunc(c.b*255);
|
||||
for i := 0 to 3 do
|
||||
for j := 0 to 3 do
|
||||
RgbDot(x*4+i,y*4+j,r,g,b);
|
||||
end;
|
||||
Inc(x);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Beep;
|
||||
begin
|
||||
Sound(220); { Beep }
|
||||
Delay(200); { For 200 ms }
|
||||
NoSound; { Relief! }
|
||||
end;
|
||||
|
||||
type
|
||||
TStraw = object(TCylinder)
|
||||
procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
|
||||
end;
|
||||
TOrange = object(TSphere)
|
||||
procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
|
||||
end;
|
||||
TJuiceBox = object(TObject3d)
|
||||
Pos,Normal,Size: TPoint3d;
|
||||
constructor Init(xa,ya,za,vx,vy,vz,sx,sy,sz: Real);
|
||||
procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
|
||||
end;
|
||||
|
||||
constructor TJuiceBox.Init(xa,ya,za,vx,vy,vz,sx,sy,sz: Real);
|
||||
begin
|
||||
TObject3d.Init;
|
||||
Pos.SetTo(xa,ya,za);
|
||||
Normal.SetTo(vx,vy,vz);
|
||||
Normal.MakeUnit;
|
||||
Size.SetTo(sx,sy,sz);
|
||||
end;
|
||||
|
||||
procedure TJuiceBox.GetInfo(Ray: TRay; var Inf: TRayInfo);
|
||||
var
|
||||
r1: TRay;
|
||||
times: array[1..8] of Real; { 6 more later }
|
||||
ps: array[1..8] of TPoint3d;
|
||||
p1,p2,p3: Real;
|
||||
i,j: Integer;
|
||||
begin
|
||||
r1 := Ray;
|
||||
r1.o.Sub(Pos);
|
||||
r1.o.RotateFrom(Normal);
|
||||
r1.d.RotateFrom(Normal);
|
||||
{
|
||||
p1 := Pos.x * Normal.x + Pos.y * Normal.y + Pos.z * Normal.z;
|
||||
p2 := ray.o.x * Normal.x + ray.o.y * Normal.y + ray.o.z * Normal.z;
|
||||
p3 := ray.d.x * Normal.x + ray.d.y * Normal.y + ray.d.z * Normal.z;
|
||||
if p3 = 0 then p3 := 0.001;
|
||||
Inf.Time := (p1-p2)/p3;
|
||||
}
|
||||
if r1.d.x = 0 then r1.d.x := 0.001;
|
||||
times[1] := -r1.o.x/r1.d.x;
|
||||
times[2] := -r1.o.y/r1.d.y;
|
||||
times[3] := (Size.x-r1.o.x)/r1.d.x;
|
||||
times[4] := (Size.y-r1.o.y)/r1.d.y;
|
||||
times[5] := -r1.o.z/r1.d.z;
|
||||
times[6] := -1;
|
||||
times[7] := -1;
|
||||
times[8] := ((Size.x/2)-r1.o.x)/r1.d.x;
|
||||
for i := 1 to 8 do
|
||||
ps[i].SetTo(
|
||||
r1.o.x+r1.d.x*times[i],
|
||||
r1.o.y+r1.d.y*times[i],
|
||||
r1.o.z+r1.d.z*times[i]);
|
||||
if (ps[1].y < 0) or (ps[1].y > Size.y) or
|
||||
(ps[1].z < 0) or (ps[1].z > Size.z) then times[1] := -1;
|
||||
if (ps[2].x < 0) or (ps[2].x > Size.x) or
|
||||
(ps[2].z < 0) or (ps[2].z > Size.z) then times[2] := -1;
|
||||
if (ps[3].y < 0) or (ps[1].y > Size.y) or
|
||||
(ps[3].z < 0) or (ps[3].z > Size.z) then times[3] := -1;
|
||||
if (ps[4].x < 0) or (ps[4].y > Size.x) or
|
||||
(ps[4].z < 0) or (ps[4].z > Size.z) then times[4] := -1;
|
||||
if (ps[5].x < 0) or (ps[5].x > Size.x) or
|
||||
(ps[5].y < 0) or (ps[5].y > Size.y) then times[5] := -1;
|
||||
if (ps[8].y < 0) or (ps[8].y > Size.y) or
|
||||
(ps[8].z < (Size.z*0.95)) or (ps[8].z > Size.z) then times[8] := -1;
|
||||
Inf.Time := MaxReal;
|
||||
j := -1;
|
||||
for i := 1 to 8 do
|
||||
if (times[i] < Inf.Time) and (times[i] > 0.001) then begin
|
||||
Inf.Time := times[i];
|
||||
j := i;
|
||||
end;
|
||||
Inf.Hit := (j <> -1);
|
||||
if not Inf.Hit then Exit;
|
||||
Inf.Pos.SetTo(
|
||||
Ray.o.x+Ray.d.x*Inf.Time,
|
||||
Ray.o.y+Ray.d.y*Inf.Time,
|
||||
Ray.o.z+Ray.d.z*Inf.Time);
|
||||
case j of
|
||||
1: Inf.Normal.SetTo(-1,0,0);
|
||||
2: Inf.Normal.SetTo(0,-1,0);
|
||||
3: Inf.Normal.SetTo(1,0,0);
|
||||
4: Inf.Normal.SetTo(0,1,0);
|
||||
5: Inf.Normal.SetTo(0,0,-1);
|
||||
6: ;
|
||||
7: ;
|
||||
8: if r1.d.x > 0 then
|
||||
Inf.Normal.SetTo(-1,0,0)
|
||||
else
|
||||
Inf.Normal.SetTo(1,0,0);
|
||||
end;
|
||||
Inf.Normal.RotateTo(Normal);
|
||||
MakeTrip(0.6,0.6,0.6,Inf.Color);
|
||||
MakeTrip(1,1,1,Inf.Opacity);
|
||||
MakeTrip(0,0,0,Inf.Reflectivity);
|
||||
Inf.SpecularN := 50;
|
||||
Inf.Brightness := 1;
|
||||
Inf.GoingIn := True;
|
||||
Inf.IndexRefraction := 0.95;
|
||||
end;
|
||||
|
||||
procedure TStraw.GetInfo(Ray: TRay; var Inf: TRayInfo);
|
||||
begin
|
||||
TCylinder.GetInfo(Ray,Inf);
|
||||
if not Inf.Hit then Exit;
|
||||
MakeTrip(0.9,0.9,0.9,Inf.Color);
|
||||
end;
|
||||
|
||||
procedure TOrange.GetInfo(Ray: TRay; var Inf: TRayInfo);
|
||||
var
|
||||
p1: TPoint3d;
|
||||
begin
|
||||
TSphere.GetInfo(Ray,Inf);
|
||||
if not Inf.Hit then Exit;
|
||||
MakeTrip(0,0,0,Inf.Reflectivity);
|
||||
MakeTrip(0.9,0.6,0,Inf.Color);
|
||||
p1 := Inf.Pos; p1.Sub(Pos);
|
||||
RandSeed :=
|
||||
(Word(Round(ArcTan(p1.x/p1.y)*255/pi)) shl 8) or
|
||||
Round(ArcTan(p1.z/p1.y)*255/pi);
|
||||
with Inf.Normal do begin
|
||||
x := x + ((Random(200)-100)/100000);
|
||||
y := y + ((Random(200)-100)/100000);
|
||||
z := z + ((Random(200)-100)/100000);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TraceIt;
|
||||
var
|
||||
u: TUniverse;
|
||||
l1: TLightSource;
|
||||
p1: TPlane;
|
||||
c1: TStraw;
|
||||
s1: TOrange;
|
||||
b1: TJuiceBox;
|
||||
begin
|
||||
u.Init(320,200,10, 0,0,0, 0,0,1, 0,1,0, 1, 40,30, 0.5,0.5,0.5, 0,0,0);
|
||||
u.Reflection := False;
|
||||
u.Shading := False;
|
||||
|
||||
l1.Init(20,20,-50, 50,50,50);
|
||||
u.InsertLight(@l1);
|
||||
|
||||
p1.Init(0,-8,0, 0,1,0);
|
||||
s1.Init(4,-1,30, 7);
|
||||
c1.Init(4,-1,30, 0.75,1,-1.25, 0.75,12,0);
|
||||
b1.Init(-20,-8,40, 0,1,0, 10,10,20);
|
||||
u.Insert(@p1);
|
||||
u.Insert(@s1);
|
||||
u.Insert(@c1);
|
||||
u.Insert(@b1);
|
||||
|
||||
Zoom(u);
|
||||
Beep;
|
||||
u.DeleteAll;
|
||||
u.Done;
|
||||
end;
|
||||
|
||||
begin
|
||||
Set13h;
|
||||
SetUpRgb;
|
||||
TraceIt;
|
||||
ReadKey;
|
||||
BiosMode(3);
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue