Initial commit of 1992 raytracing code
This commit is contained in:
commit
3f46e7dd82
42 changed files with 8483 additions and 0 deletions
451
turbo-pascal/ray9.pas
Normal file
451
turbo-pascal/ray9.pas
Normal file
|
|
@ -0,0 +1,451 @@
|
|||
program mmmmmmmmmmmmm;
|
||||
{$X+}
|
||||
uses Crt,Vga13h,RayTrace,Dos;
|
||||
{$I BufrFile.Inc}
|
||||
|
||||
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;
|
||||
|
||||
procedure Save(var u: Universe; st: String);
|
||||
var
|
||||
x,y: Integer;
|
||||
c: LongInt;
|
||||
r,g,b: Integer;
|
||||
begin
|
||||
StartTga(st);
|
||||
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;
|
||||
EndTga;
|
||||
end;
|
||||
|
||||
procedure Draw(var u: Universe);
|
||||
var
|
||||
x,y: Integer;
|
||||
c: LongInt;
|
||||
begin
|
||||
x := 0;
|
||||
while (x < u.Width) and (not KeyPressed) do begin
|
||||
for y := 0 to u.Height-1 do begin
|
||||
c := u.TracePoint(x,u.Height-1-y);
|
||||
if c <> 0 then
|
||||
RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff);
|
||||
end;
|
||||
Inc(x);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Qwik(var u: Universe);
|
||||
var
|
||||
x,y: Integer;
|
||||
c: LongInt;
|
||||
r,g,b: Byte;
|
||||
begin
|
||||
x := 0;
|
||||
while (x < (u.Width div 2)) and (not KeyPressed) do begin
|
||||
for y := 0 to (u.Height div 2)-1 do begin
|
||||
c := u.TracePoint(x*2,u.Height-1-(y*2));
|
||||
if c <> 0 then begin
|
||||
r := (c and $ff0000) shr 16;
|
||||
g := (c and $ff00) shr 8;
|
||||
b := c and $ff;
|
||||
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;
|
||||
end;
|
||||
Inc(x);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Zoom(var u: Universe);
|
||||
var
|
||||
x,y,i,j: Integer;
|
||||
c: LongInt;
|
||||
r,g,b: Byte;
|
||||
begin
|
||||
x := 0;
|
||||
while (x < (u.Width div 4)) and (not KeyPressed) do begin
|
||||
for y := 0 to (u.Height div 4)-1 do begin
|
||||
c := u.TracePoint(x*4,u.Height-1-(y*4));
|
||||
if c <> 0 then begin
|
||||
r := (c and $ff0000) shr 16;
|
||||
g := (c and $ff00) shr 8;
|
||||
b := c and $ff;
|
||||
for i := 0 to 3 do
|
||||
for j := 0 to 3 do
|
||||
RgbDot(x*4+i,y*4+j,r,g,b);
|
||||
end;
|
||||
end;
|
||||
Inc(x);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Beep;
|
||||
begin
|
||||
Sound(220); { Beep }
|
||||
Delay(200); { For 200 ms }
|
||||
NoSound; { Relief! }
|
||||
end;
|
||||
|
||||
type
|
||||
{ Definition of the PCX file header }
|
||||
PCX_header = record
|
||||
pcx_id : byte; { Always $0A for PCX files }
|
||||
version : byte; { Version of the PCX format }
|
||||
encoding : byte; { 1 = RLE (RLL) compression }
|
||||
bpp : byte; { Number of bits per pixel }
|
||||
upleftx, uplefty : word; { position of upper left corner }
|
||||
lorightx, lorighty : word; { lower right corner (inclusive) }
|
||||
display_xres, display_yres : word; { resolution in dpi of display }
|
||||
palette : array [0..47] of byte; { palette data if it fits }
|
||||
reserved : byte;
|
||||
nplanes : byte; { number of bit planes of data }
|
||||
bytesperline : word; { # bytes in an uncompressed line }
|
||||
palletteinfo : word;
|
||||
reserved2 : array [0..57] of byte;
|
||||
end;
|
||||
pplane = object(Plane)
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
ColorSphere = object(Sphere)
|
||||
rc,gc,bc: Byte;
|
||||
constructor Init(x,y,z,r: Real; cr,cg,cb: Byte);
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
arr_byte = array[0..65520] of byte;
|
||||
parr_byte = ^arr_byte;
|
||||
WoodSphere = object(Sphere)
|
||||
IsLoaded: Boolean;
|
||||
Width,Height: Integer;
|
||||
Buf: parr_byte;
|
||||
function GetPixel(x,y: Integer): Byte;
|
||||
constructor Init(x,y,z,r: Real; s: String);
|
||||
destructor Done; virtual;
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
GraySphere = object(WoodSphere)
|
||||
function GetColor(aray: Ray; time: Real): LongInt; virtual;
|
||||
end;
|
||||
|
||||
const
|
||||
{ These two definitions are used to decompress data in the PCX file.
|
||||
(The compressed count byte has the top two bits set). }
|
||||
|
||||
PCX_COMPRESSED = $C0;
|
||||
PCX_MASK = $3F;
|
||||
|
||||
Bits : array [0..7] of byte = (1, 2, 4, 8, 16, 32, 64, 128);
|
||||
|
||||
{ Read header of indicated PCX file. Returns TRUE if OK, FALSE if error }
|
||||
|
||||
function pcx_read_header (var hdr : PCX_header; var f : buffered_file) : boolean;
|
||||
var
|
||||
count : word;
|
||||
hdr_array : array [0..1] of char absolute hdr;
|
||||
begin
|
||||
count := 0;
|
||||
while count < SizeOf(PCX_header) do
|
||||
begin
|
||||
hdr_array [count] := NextCharRead (f);
|
||||
Inc (count)
|
||||
end;
|
||||
pcx_read_header := (f.more_data) and (hdr.pcx_id = $0A);
|
||||
end {pcx_read_header};
|
||||
|
||||
{ Read next line from PCX file into indicated array, up to indicated limit.
|
||||
Returns TRUE if data acquired, FALSE if error occurred.
|
||||
Note: call pcx_read_header () first to begin reading file. }
|
||||
|
||||
function pcx_next_line (var hdr : PCX_header; var f : buffered_file;
|
||||
var line1; linesize : integer; var count : word) : boolean;
|
||||
var
|
||||
line : array [0..1] of byte absolute line1;
|
||||
c : byte;
|
||||
len, len1 : integer;
|
||||
i, linebytes, b : word;
|
||||
begin
|
||||
{ initialize return value }
|
||||
pcx_next_line := FALSE;
|
||||
{ determine number of bytes to acquire }
|
||||
linebytes := hdr.nplanes * hdr.bytesperline;
|
||||
{ point to start of return data }
|
||||
count := 0;
|
||||
i := 0;
|
||||
while i < linebytes do
|
||||
begin
|
||||
{ acquire next block of data }
|
||||
c := Ord (NextCharRead (f));
|
||||
if Not f.more_data
|
||||
then Exit;
|
||||
if (c AND PCX_COMPRESSED) = PCX_COMPRESSED
|
||||
then { acquire run-length encoded data }
|
||||
begin
|
||||
len := c AND PCX_MASK;
|
||||
c := Ord (NextCharRead (f));
|
||||
if Not f.more_data
|
||||
then Exit;
|
||||
end
|
||||
else { acquire single byte }
|
||||
len := 1;
|
||||
{ store block of data in array }
|
||||
len1 := len;
|
||||
if count + len1 > linesize
|
||||
then len1 := linesize - count;
|
||||
if count < linesize
|
||||
then begin
|
||||
FillChar (line [count], len1, c);
|
||||
Inc (count, len1);
|
||||
end;
|
||||
Inc (i, len);
|
||||
end;
|
||||
pcx_next_line := TRUE;
|
||||
end {pcx_next_line};
|
||||
|
||||
constructor WoodSphere.Init(x,y,z,r: Real; s: String);
|
||||
var
|
||||
PCXFile : buffered_file;
|
||||
PCXBuf : DiskFileBuffer;
|
||||
PCXLine : array [0..2048] of byte;
|
||||
PCXHdr : PCX_header;
|
||||
PCXWidth : word;
|
||||
pixel_width: word;
|
||||
I, J : integer;
|
||||
X1, Y1 : integer;
|
||||
found : boolean;
|
||||
line_count : integer;
|
||||
clr : byte;
|
||||
numlines: integer;
|
||||
begin
|
||||
Sphere.Init(x,y,z,r);
|
||||
|
||||
IsLoaded := False;
|
||||
if length(s) = 0 then Exit;
|
||||
{ attempt to open file }
|
||||
AssignBufferedFile(PCXFile, s, @PCXBuf);
|
||||
OpenForBufferedRead(PCXFile, I);
|
||||
if I <> 0 then Exit;
|
||||
{ read descriptive header }
|
||||
found := pcx_read_header (PCXHdr, PCXFile);
|
||||
if Not found then begin
|
||||
CloseForBufferedRead (PCXFile, I);
|
||||
Exit;
|
||||
end;
|
||||
IsLoaded := True;
|
||||
{ display data }
|
||||
numlines := PCXHdr.lorighty - PCXHdr.uplefty + 1;
|
||||
pixel_width := PCXHdr.lorightx - PCXHdr.upleftx + 1;
|
||||
Width := pixel_width;
|
||||
Height := numlines;
|
||||
GetMem(Buf,Width*Height);
|
||||
line_count := 0;
|
||||
repeat
|
||||
found := pcx_next_line (PCXHdr, PCXFile,
|
||||
PCXLine, SizeOf(PCXLine), PCXWidth);
|
||||
if found then begin
|
||||
for X1 := 0 to PCXWidth-1 do
|
||||
Buf^[(Height-1-line_count)*Width+X1] := PCXLine[X1];
|
||||
Inc (line_count);
|
||||
end;
|
||||
until (Not found) or (line_count = numlines);
|
||||
CloseForBufferedRead (PCXFile, I);
|
||||
end;
|
||||
|
||||
destructor WoodSphere.Done;
|
||||
begin
|
||||
if IsLoaded then
|
||||
FreeMem(Buf,Width*Height);
|
||||
Sphere.Done;
|
||||
end;
|
||||
|
||||
function WoodSphere.GetPixel(x,y: Integer): Byte;
|
||||
begin
|
||||
if IsLoaded and (x > 0) and (y > 0) and
|
||||
(x < Width) and (y < Height) then
|
||||
GetPixel := Buf^[y*Width+x]
|
||||
else
|
||||
GetPixel := 0;
|
||||
end;
|
||||
|
||||
function WoodSphere.GetColor(aray: Ray; time: Real): LongInt;
|
||||
var
|
||||
r: Ray;
|
||||
c: Integer;
|
||||
begin
|
||||
r.ox := (aray.dx * time + aray.ox - xp + ra) / (ra*2);
|
||||
r.oy := (aray.dy * time + aray.oy - yp + ra) / (ra*2);
|
||||
r.oz := (aray.dz * time + aray.oz - zp + ra) / (ra*2);
|
||||
c := GetPixel(Round(r.ox*(Width-1)),Round(r.oy*(Height-1)));
|
||||
GetColor := GetRgb(c,c * 5 div 8,0);
|
||||
end;
|
||||
|
||||
function GraySphere.GetColor(aray: Ray; time: Real): LongInt;
|
||||
var
|
||||
r: Ray;
|
||||
c: Byte;
|
||||
begin
|
||||
r.ox := (aray.dx * time + aray.ox - xp + ra) / (ra*2);
|
||||
r.oy := (aray.dy * time + aray.oy - yp + ra) / (ra*2);
|
||||
r.oz := (aray.dz * time + aray.oz - zp + ra) / (ra*2);
|
||||
c := GetPixel(Round(r.ox*(Width-1)),Round(r.oy*(Height-1)));
|
||||
GetColor := GetRgb(c,c,c);
|
||||
end;
|
||||
|
||||
constructor ColorSphere.Init(x,y,z,r: Real; cr,cg,cb: Byte);
|
||||
begin
|
||||
Sphere.Init(x,y,z,r);
|
||||
rc := cr; gc := cg; bc := cb;
|
||||
end;
|
||||
|
||||
function ColorSphere.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 + rc;
|
||||
cc.g := Integer(cc.g) div 2 + gc;
|
||||
cc.b := Integer(cc.b) div 2 + bc;
|
||||
GetColor := c;
|
||||
end;
|
||||
|
||||
function pplane.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 TraceIt;
|
||||
var
|
||||
u: Universe;
|
||||
p: Pplane;
|
||||
wood: WoodSphere;
|
||||
mimas,earth: GraySphere;
|
||||
begin
|
||||
u.Init(320,200);
|
||||
p.Init (0,-8,0, 0,1,0);
|
||||
wood.Init(-16,0,54,8, 'c:\brion\vga\wood2.pcx');
|
||||
mimas.Init(0,0,50,8, 'c:\brion\vga\mimas2.pcx');
|
||||
Earth.Init(16,0,54,8, 'c:\brion\vga\earth2.pcx');
|
||||
u.Insert(@wood);
|
||||
u.Insert(@mimas);
|
||||
u.Insert(@Earth);
|
||||
u.Insert(@p);
|
||||
Save(u,'brion5.tga');
|
||||
{Zoom(u);}
|
||||
Beep;
|
||||
wood.Done;
|
||||
Mimas.Done;
|
||||
Earth.Done;
|
||||
u.Done;
|
||||
end;
|
||||
|
||||
begin
|
||||
Set13h;
|
||||
SetUpRgb;
|
||||
TraceIt;
|
||||
ReadKey;
|
||||
BiosMode(3);
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue