Initial commit of 1992 raytracing code
This commit is contained in:
commit
3f46e7dd82
42 changed files with 8483 additions and 0 deletions
272
turbo-pascal/raypic.pas
Normal file
272
turbo-pascal/raypic.pas
Normal file
|
|
@ -0,0 +1,272 @@
|
|||
program mmmmmmmmmmmmm;
|
||||
{$X+}
|
||||
uses Crt,Vga13h,RayTrace;
|
||||
|
||||
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;
|
||||
tff: File absolute tf;
|
||||
|
||||
procedure StartTga(s: String);
|
||||
begin
|
||||
Assign(tf,s);
|
||||
Rewrite(tf);
|
||||
BlockWrite(tff,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;
|
||||
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;
|
||||
|
||||
type
|
||||
GreenSphere = object(Sphere)
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
RedSphere = object(Sphere)
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
WhiteSphere = object(Sphere)
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
Floor = object(Plane)
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
WallA = object(Plane)
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
WallB = object(Plane)
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
Ceiling = object(Plane)
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
|
||||
function Floor.GetColor(aray: RAY; time: real): LongInt;
|
||||
var
|
||||
x,y: Word;
|
||||
begin
|
||||
x := Word(Round(time * aray.dz + aray.oz));
|
||||
y := Word(Round(time * aray.dx + aray.ox));
|
||||
GetColor := GetRgb(0,128+((x mod 2)+(y mod 2))*42,0);
|
||||
end;
|
||||
|
||||
function Ceiling.GetColor(aray: RAY; time: real): LongInt;
|
||||
var
|
||||
x,y: Word;
|
||||
c: Byte;
|
||||
begin
|
||||
x := Word(Round(time * aray.dz + aray.oz));
|
||||
y := Word(Round(time * aray.dx + aray.ox));
|
||||
c := 128+((x mod 2)+(y mod 2))*42;
|
||||
GetColor := GetRgb(c,c,c);
|
||||
end;
|
||||
|
||||
function WallA.GetColor(aray: RAY; time: real): LongInt;
|
||||
var
|
||||
y: Word;
|
||||
c: Byte;
|
||||
begin
|
||||
y := Word(Round(time * aray.dx + aray.ox));
|
||||
c := 128+(y mod 2)*42;
|
||||
GetColor := GetRgb(c,c div 2,0);
|
||||
end;
|
||||
|
||||
function WallB.GetColor(aray: RAY; time: real): LongInt;
|
||||
var
|
||||
x: Word;
|
||||
c: Byte;
|
||||
begin
|
||||
x := Word(Round(time * aray.dz + aray.oz));
|
||||
c := 128+(x mod 2)*42;
|
||||
GetColor := GetRgb(c,c div 2,0);
|
||||
end;
|
||||
|
||||
function GreenSphere.GetColor(aray: Ray; time: Real): LongInt;
|
||||
var
|
||||
r: Ray;
|
||||
c: LongInt;
|
||||
cc: record b,g,r: Byte end absolute c;
|
||||
begin
|
||||
ReflectRay(aray,time,r);
|
||||
c := Owner^.TraceRay(r);
|
||||
cc.r := Integer(cc.r) div 2;
|
||||
cc.g := Integer(cc.g) div 2 + 128;
|
||||
cc.b := Integer(cc.b) div 2;
|
||||
GetColor := c;
|
||||
end;
|
||||
|
||||
function RedSphere.GetColor(aray: Ray; time: Real): LongInt;
|
||||
var
|
||||
r: Ray;
|
||||
c: LongInt;
|
||||
cc: record b,g,r: Byte end absolute c;
|
||||
begin
|
||||
ReflectRay(aray,time,r);
|
||||
c := Owner^.TraceRay(r);
|
||||
cc.r := Integer(cc.r) div 2 + 128;
|
||||
cc.g := Integer(cc.g) div 2;
|
||||
cc.b := Integer(cc.b) div 2;
|
||||
GetColor := c;
|
||||
end;
|
||||
|
||||
function WhiteSphere.GetColor(aray: Ray; time: Real): LongInt;
|
||||
var
|
||||
r: Ray;
|
||||
c: LongInt;
|
||||
cc: record b,g,r: Byte end absolute c;
|
||||
begin
|
||||
ReflectRay(aray,time,r);
|
||||
c := Owner^.TraceRay(r);
|
||||
cc.r := Integer(cc.r) div 2 + 128;
|
||||
cc.g := Integer(cc.g) div 2 + 128;
|
||||
cc.b := Integer(cc.b) div 2 + 128;
|
||||
GetColor := c;
|
||||
end;
|
||||
|
||||
procedure Draw(var u: Universe);
|
||||
var
|
||||
x,y: Integer;
|
||||
c: LongInt;
|
||||
r,g,b: Integer;
|
||||
begin
|
||||
x := 0;
|
||||
for y := 0 to u.Height-1 do
|
||||
for x := 0 to u.Width-1 do begin
|
||||
c := u.TracePoint(x,y);
|
||||
r := (c and $ff0000) shr 16;
|
||||
g := (c and $ff00) shr 8;
|
||||
b := c and $ff;
|
||||
RgbDot(x,u.Height-1-y,r,g,b);
|
||||
TgaDot(r,g,b);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Beep;
|
||||
begin
|
||||
Sound(220); { Beep }
|
||||
Delay(200); { For 200 ms }
|
||||
NoSound; { Relief! }
|
||||
end;
|
||||
|
||||
procedure TraceIt;
|
||||
var
|
||||
u: Universe;
|
||||
s: Sphere;
|
||||
rs: RedSphere;
|
||||
gs: GreenSphere;
|
||||
ws: WhiteSphere;
|
||||
fl: Floor;
|
||||
cl: Ceiling;
|
||||
w1,w4: WallA;
|
||||
w2,w3: WallB;
|
||||
begin
|
||||
u.Init(320,200);
|
||||
|
||||
s.Init(0,-8,30, 5);
|
||||
rs.Init(-10,-8,40, 5);
|
||||
gs.Init(10,-8,40, 5);
|
||||
ws.Init(-3,2,50, 6);
|
||||
|
||||
fl.Init(-8,0,0, 0,1,0.001);
|
||||
cl.Init(8,0,0, 0,-1,0.001);
|
||||
w1.Init(0,0,50, 0,0,-1);
|
||||
w4.Init(0,0,-5, 0,0,1);
|
||||
w2.Init(0,-100,0, 2,0.25,0.001);
|
||||
w3.Init(0,-100,0, 2,-0.25,0.001);
|
||||
u.Insert(@fl);
|
||||
u.Insert(@cl);
|
||||
u.Insert(@w1);
|
||||
u.Insert(@w2);
|
||||
u.Insert(@w3);
|
||||
u.Insert(@w4);
|
||||
u.Insert(@s);
|
||||
u.Insert(@rs);
|
||||
u.Insert(@gs);
|
||||
u.Insert(@ws);
|
||||
Draw(u);
|
||||
Beep;
|
||||
u.Done;
|
||||
end;
|
||||
|
||||
begin
|
||||
Set13h;
|
||||
SetUpRgb;
|
||||
StartTga('brion1.tga');
|
||||
TraceIt;
|
||||
EndTga;
|
||||
ReadKey;
|
||||
BiosMode(3);
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue