Initial commit of 1992 raytracing code

.gitignore

@@ -0,0 +1 @@
+.DS_Store

turbo-pascal/ray.pas

@@ -0,0 +1,259 @@
+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;
+
+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
+  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;
+
+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;
+  GetColor := c;
+end;
+
+procedure TraceIt;
+var
+  u: Universe;
+  p: Pplane;
+  pp,p1: Plane;
+  r,g,b,w: ColorSphere;
+begin
+  u.Init(320,200);
+  p.Init (-8.0, 0.0, 0.0,  0.0, 1.0, 0.001);
+  pp.Init (8.0, 0.0, 0.0,  1.0, 1.0, 0.001);
+  p1.Init (8.0, 30.0, 0.0,  -1.0, 1.0, 0.001);
+  r.Init(-15,-3,50,5, 128,0,0);
+  g.Init(-10,-3,45,5, 0,128,0);
+  b.Init(-5,-3,50,5, 0,0,128);
+  w.Init(-10,2,47.5,5, 128,128,128);
+  u.Insert(@p);
+  u.Insert(@pp);
+  u.Insert(@p1);
+  u.Insert(@r);
+  u.Insert(@g);
+  u.Insert(@b);
+  u.Insert(@w);
+  {Save(u,'brion2.tga');}
+  Beep;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray10.pas

@@ -0,0 +1,271 @@
+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;
+
+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
+  PlanePnt = object(Obj3d)
+    nx,ny,nz,xb,yb,zb,xc,yc,zc: Real;
+    constructor Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: 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;
+
+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);
+  Obj3d.Init(x1,y1,z1);
+  xb := x2; yb := y2; zb := z2;
+  xc := x3; yc := y3; zc := z3;
+  nx := a; ny := b; nz := c;
+end;
+
+function PlanePnt.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;
+
+procedure PlanePnt.SurfNormal(aray: Ray; time: Real; var oray: Ray);
+begin
+  oray.dx := nx; oray.dy := ny; oray.dz := nz;
+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 := GetRgb(c,c,c);
+end;
+
+procedure TraceIt;
+const
+  MaxS = 7; MaxP = 3;
+var
+  u: Universe;
+  i: Integer;
+  s: array[1..MaxS] of Sphere;
+  p: array[1..MaxP] of PlanePnt;
+begin
+  u.Init(320,200);
+  s[1].Init(-5,-5,50,1);
+  s[2].Init(-6,-5,45,1);
+  s[3].Init(5,-8,50,1);
+  s[4].Init(-7,0,50,1);
+  s[5].Init(20,0,50,1);
+  s[6].Init(18,0,55,1);
+  s[7].Init(18,10,55,1);
+  p[1].Init(-5,-5,50, -6,-5,45, 5,-8,50);
+  p[2].Init(-5,-5,50, -6,-5,45, -7,0,50);
+  p[3].Init(20,0,50, 18,0,55, 18,10,55);
+  for i := 1 to MaxS do
+    u.Insert(@s[i]);
+  for i := 1 to MaxP do
+    u.Insert(@p[i]);
+  Draw(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray11.pas

@@ -0,0 +1,262 @@
+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;
+
+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
+  pplane = object(Plane)
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  end;
+  BlankSphere = object(Sphere)
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  end;
+
+const
+  AmbientInt = 10;
+  PointInt = 100;
+  LightX = 15;
+  LightY = 5;
+  LightZ = 100;
+  CoeffReflect = 0.85;
+
+function pplane.GetColor(aray: Ray; time: Real): LongInt;
+var
+  costheta,d,x,y,z,I: Real;
+  N,L: Ray;
+  c: Integer;
+begin
+  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;
+  x := LightX - (time * aray.dx + aray.ox);
+  y := LightY - (time * aray.dy + aray.oy);
+  z := LightZ - (time * aray.dz + aray.oz);
+  d := Sqrt(Sqr(x)+Sqr(y)+Sqr(z));
+  if d <> 0 then begin
+    x := x / d;
+    y := y / d;
+    z := z / d;
+  end;
+  costheta :=
+    (n.dx*x+n.dx*y+n.dx*z+
+     n.dy*x+n.dy*y+n.dy*z+
+     n.dz*x+n.dz*y+n.dz*z);
+  if costheta < 0 then costheta := 0;
+  I := (CoeffReflect * AmbientInt) +
+    ((CoeffReflect * PointInt) / (d + 0.001)) * costheta;
+  c := Round(I*15);
+  GetColor := GetRgb(c,c,c);
+end;
+
+function BlankSphere.GetColor(aray: Ray; time: Real): LongInt;
+begin
+  GetColor := $ffffff;
+end;
+
+procedure TraceIt;
+var
+  u: Universe;
+  p,p2,p3: Pplane;
+  s: BlankSphere;
+begin
+  u.Init(320,200);
+  s.Init(LightX,LightY,LightZ,1); {15,5,100}
+  p.Init(0,-8,0, 0.25,1,0);
+  p2.Init(0,0,150, 0,0,-1);
+  p3.Init(-20,0,0, 1,0,0);
+  u.Insert(@p);
+  u.Insert(@p2);
+  u.Insert(@p3);
+  u.Insert(@s);
+  Zoom(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray12.pas

@@ -0,0 +1,291 @@
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Vga13h,RayShade;
+
+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
+  Plane1 = object(Plane)
+    cr,cg,cb: Integer;
+    constructor Init(x, y, z, vx, vy, vz: real; r,g,b: Integer);
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  end;
+  Sphere1 = object(Sphere)
+    cr,cg,cb: Integer;
+    constructor Init(x, y, z, r: real; rr,g,b: Integer);
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  end;
+  Sphere2 = object(Sphere)
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  end;
+
+
+function Sphere2.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(64,64,64));
+  GetColor := GetRgb(cc.r-64+cc2.r,cc.g-64+cc2.g,cc.b-64+cc2.b);
+end;
+
+constructor Sphere1.Init(x, y, z, r: real; rr,g,b: Integer);
+begin
+  Sphere.Init(x,y,z,r);
+  cr := rr; cg := g; cb := b;
+end;
+
+function Sphere1.GetColor(aray: Ray; time: Real): LongInt;
+begin
+  GetColor := Shade(aray,time,GetRgb(cr,cg,cb));
+end;
+
+constructor Plane1.Init(x, y, z, vx, vy, vz: real; r,g,b: Integer);
+begin
+  Plane.Init(x,y,z,vx,vy,vz);
+  cr := r; cg := g; cb := b;
+end;
+
+function Plane1.GetColor(aray: Ray; time: Real): LongInt;
+begin
+  GetColor := Shade(aray,time,GetRgb(cr,cg,cb));
+end;
+
+procedure TraceIt;
+var
+  u: Universe;
+  l1,l2,l3,l4,l5,l6: LightSource;
+  p1,p2,p3,p4,p5,p6: Plane1;
+  s1,s2,s3,s4,s5,s6: Sphere1;
+  ss1,ss2: Sphere2;
+begin
+  u.Init(320,200, 32,32,32);
+  l1.Init(14.9,7.9,49.9, 1024,1024,1024);
+  l2.Init(-14.9,7.9,49.9, 1024,1024,1024);
+  l3.Init(0,7.9,49.9, 1024,1024,1024);
+  l4.Init(-14.9,7.9,35, 1024,1024,1024);
+  l5.Init(14.9,7.9,35, 1024,1024,1024);
+  l6.Init(0,7.9,35, 1024,1024,1024);
+  p1.Init(0,-8,0, 0,1,0, 192,192,192);
+  p2.Init(0,8,0, 0,-1,0, 192,192,192);
+  p3.Init(0,0,50, 0,0,-1, 192,0,0);
+  p4.Init(0,0,-10, 0,0,1, 192,0,0);
+  p5.Init(-15,0,0, 1,0,0, 0,192,0);
+  p6.Init(15,0,0, -1,0,0, 0,192,0);
+  s1.Init(-8,-6,40,2, 192,0,0);
+  s2.Init(-4,-6,40,2, 0,192,0);
+  s3.Init(-6,-6,36.4,2, 0,0,192);
+  s4.Init(-6,-2.8,38.8,2, 192,192,192);
+  ss1.Init(-15,-8,50,5);
+  ss2.Init(15,-8,50,5);
+  u.Insert(@ss1);
+  u.Insert(@ss2);
+  u.Insert(@s1);
+  u.Insert(@s2);
+  u.Insert(@s3);
+  u.Insert(@s4);
+  u.Insert(@p1);
+  u.Insert(@p2);
+  u.Insert(@p3);
+  u.Insert(@p4);
+  u.Insert(@p5);
+  u.Insert(@p6);
+  u.InsertLight(@l1);
+  u.InsertLight(@l2);
+  u.InsertLight(@l3);
+  u.InsertLight(@l4);
+  u.InsertLight(@l5);
+  u.InsertLight(@l6);
+  {Zoom(u);}
+  Save(u,'brion6.tga');
+  Beep;
+  u.DeleteAll;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray13.pas

@@ -0,0 +1,254 @@
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Vga13h,RayShade;
+
+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
+  Sky = object(Plane)
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  end;
+  Sea = object(Plane)
+    constructor Init(x,y,z,vx,vy,vz: Real);
+    procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual;
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  end;
+
+function Sky.GetColor(aray: Ray; time: Real): LongInt;
+begin
+  GetColor := GetRgb(64,128,192);
+end;
+
+constructor Sea.Init(x,y,z,vx,vy,vz: Real);
+begin
+  Plane.Init(x,y,z,vx,vy,vz);
+  Refl := 1;
+end;
+
+procedure Sea.SurfNormal(aray: Ray; time: Real; var oray: Ray);
+const
+  Waves = 3;
+  WavePnt: array[1..Waves] of record x,y: Real end = (
+    (x: 10; y: 30),
+    (x: -15; y: 21),
+    (x: 3; y: 89));
+var
+  x,y,d,s: Real;
+  i: Integer;
+begin
+  x := aray.dx*time+aray.ox;
+  y := aray.dz*time+aray.oz;
+  d := 0;
+  for i := 1 to Waves do
+    d := d + Sqrt(Sqr(WavePnt[i].x-x)+Sqr(WavePnt[i].y-y));
+  s := sin(d);
+  oray.dx := s; oray.dy := ny; oray.dz := s;
+end;
+
+function Sea.GetColor(aray: Ray; time: Real): LongInt;
+begin
+  GetColor := Shade(aray,time,GetRgb(0,128,255));
+end;
+
+procedure TraceIt;
+var
+  u: Universe;
+  TheSun: LightSource;
+  TheSea: Sea;
+  TheSky: Sky;
+begin
+  u.Init(320,200, 32,32,32);
+  TheSun.Init(100,500,-1000, 30000,30000,30000);
+  TheSea.Init(0,-10,0, 0,1,0);
+  TheSky.Init(0,501,0, 0,-1,0);
+  u.InsertLight(@TheSun);
+  u.Insert(@TheSea);
+  u.Insert(@TheSky);
+  Zoom(u);
+  Beep;
+  u.DeleteAll;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray2.pas

@@ -0,0 +1,204 @@
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Modex,RayTrace;
+
+{ 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;
+
+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;
+begin
+  x := 0;
+  while (x < 320) and (not KeyPressed) do begin
+    for y := 0 to 239 do begin
+      c := u.TracePoint(x,239-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 Quick(var u: Universe);
+var
+  x,y: Integer;
+  c: LongInt;
+  r,g,b: Byte;
+begin
+  x := 0;
+  while (x < 160) and (not KeyPressed) do begin
+    for y := 0 to 119 do begin
+      c := u.TracePoint(x*2,239-(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 < 80) and (not KeyPressed) do begin
+    for y := 0 to 59 do begin
+      c := u.TracePoint(x*4,239-(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;
+
+procedure TraceIt;
+var
+  u: Universe;
+  p: Plane;
+  s: Sphere;
+  rs: RedSphere;
+  gs: GreenSphere;
+  ws: WhiteSphere;
+begin
+  u.Init(320,240);
+  p.Init (0.0, -8.0, 0.0,  0.0, 1.0, 0.0);
+  {rs.Init(-2,0,6, 1);
+  gs.Init(0,-0.5,5, 1);
+  s.Init(2,0,6, 1);}
+  s.Init(0,-8,30, 5);
+  rs.Init(-10,-8,40, 5);
+  gs.Init(10,-8,40, 5);
+  ws.Init(-3,2,50, 6);
+  u.Insert(@p);
+  u.Insert(@s);
+  u.Insert(@rs);
+  u.Insert(@gs);
+  u.Insert(@ws);
+  Zoom(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  SetModeX;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray3.pas

@@ -0,0 +1,205 @@
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Modex,RayTrace;
+
+{ 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;
+
+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;
+begin
+  x := 0;
+  while (x < 320) and (not KeyPressed) do begin
+    for y := 0 to 239 do begin
+      c := u.TracePoint(x,239-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 Quick(var u: Universe);
+var
+  x,y: Integer;
+  c: LongInt;
+  r,g,b: Byte;
+begin
+  x := 0;
+  while (x < 160) and (not KeyPressed) do begin
+    for y := 0 to 119 do begin
+      c := u.TracePoint(x*2,239-(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 < 80) and (not KeyPressed) do begin
+    for y := 0 to 59 do begin
+      c := u.TracePoint(x*4,239-(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;
+
+procedure TraceIt;
+var
+  u: Universe;
+  p: {Plane}WhiteSphere;
+  s: Sphere;
+  rs: RedSphere;
+  gs: GreenSphere;
+  ws: WhiteSphere;
+begin
+  u.Init(320,240);
+  {p.Init (-8.0, 0.0, 0.0,  0.0, 1.0, 0.001);}
+  p.Init(0,-1008,0, 1000);
+  {rs.Init(-2,0,6, 1);
+  gs.Init(0,-0.5,5, 1);
+  s.Init(2,0,6, 1);}
+  s.Init(0,-8,30, 5);
+  rs.Init(-10,-8,40, 5);
+  gs.Init(10,-8,40, 5);
+  ws.Init(-3,2,50, 6);
+  u.Insert(@p);
+  u.Insert(@s);
+  u.Insert(@rs);
+  u.Insert(@gs);
+  u.Insert(@ws);
+  Draw(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  SetModeX;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray4.pas

@@ -0,0 +1,269 @@
+(* Update! *)
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Modex,RayTrace;
+
+{ 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;
+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,239-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,239-(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,239-(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;
+
+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,240);
+
+  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);
+  Zoom(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  SetModeX;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray4b.pas

@@ -0,0 +1,268 @@
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Vga13h,RayTrace;
+
+{ 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;
+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;
+
+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;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray5.pas

@@ -0,0 +1,187 @@
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Vga13h,RayTrace;
+
+{ 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
+  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;
+  Sky = object(Plane)
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  end;
+
+function Sky.GetColor(aray: Ray; time: Real): LongInt;
+var
+  x,y: Real;
+  r,g,b: Integer;
+begin
+  x := (time * aray.dz + aray.oz);
+  y := (time * aray.dx + aray.ox);
+
+  GetColor := GetRgb(r,g,b);
+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;
+
+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;
+
+procedure TraceIt;
+var
+  u: Universe;
+  cs: array[0..7] of ColorSphere;
+  s: Sky;
+  i,j,k: Integer;
+begin
+  u.Init(320,200);
+  s.Init(0,8,0, 0,1,0);
+  u.Insert(@s);
+  for i := 0 to 1 do
+    for j := 0 to 3 do begin
+      k := i*4+j;
+      cs[k].Init(j*2-3,i*2-1,10,1,
+        (k and 1) * 128,((k and 2) shr 1) * 128,
+        ((k and 4) shr 2) * 128);
+      u.Insert(@cs[k]);
+    end;
+  Zoom(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray6.pas

@@ -0,0 +1,194 @@
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Modex,RayTrace;
+
+{ 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
+  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;
+
+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;
+  GetColor := c;
+end;
+
+procedure Draw(var u: Universe);
+var
+  x,y: Integer;
+  c: LongInt;
+begin
+  x := 0;
+  while (x < 320) and (not KeyPressed) do begin
+    for y := 0 to 239 do begin
+      c := u.TracePoint(x,239-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 Quick(var u: Universe);
+var
+  x,y: Integer;
+  c: LongInt;
+  r,g,b: Byte;
+begin
+  x := 0;
+  while (x < 160) and (not KeyPressed) do begin
+    for y := 0 to 119 do begin
+      c := u.TracePoint(x*2,239-(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 < 80) and (not KeyPressed) do begin
+    for y := 0 to 59 do begin
+      c := u.TracePoint(x*4,239-(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;
+
+procedure TraceIt;
+var
+  u: Universe;
+  p: Pplane;
+  pp,p1: Plane;
+  r,g,b,w: ColorSphere;
+begin
+  u.Init(320,240);
+  p.Init (0.0, -8.0, 0.0,  0.0, 1.0, 0.0);
+  pp.Init (8.0, 0.0, 0.0,  1.0, 1.0, 0.0);
+  p1.Init (8.0, 30.0, 0.0,  -1.0, 1.0, 0.0);
+  r.Init(-15,-3,50,5, 128,0,0);
+  g.Init(-10,-3,45,5, 0,128,0);
+  b.Init(-5,-3,50,5, 0,0,128);
+  w.Init(-10,2,47.5,5, 128,128,128);
+  u.Insert(@p);
+  u.Insert(@pp);
+  u.Insert(@p1);
+  u.Insert(@r);
+  u.Insert(@g);
+  u.Insert(@b);
+  u.Insert(@w);
+  Zoom(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  SetModeX;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray6b.pas

@@ -0,0 +1,194 @@
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Vga13h,RayTrace;
+
+{ 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
+  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;
+
+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;
+  GetColor := c;
+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;
+
+procedure TraceIt;
+var
+  u: Universe;
+  p: Pplane;
+  pp,p1: Plane;
+  r,g,b,w: ColorSphere;
+begin
+  u.Init(320,200);
+  p.Init (-8.0, 0.0, 0.0,  0.0, 1.0, 0.001);
+  pp.Init (8.0, 0.0, 0.0,  1.0, 1.0, 0.001);
+  p1.Init (8.0, 30.0, 0.0,  -1.0, 1.0, 0.001);
+  r.Init(-15,-3,50,5, 128,0,0);
+  g.Init(-10,-3,45,5, 0,128,0);
+  b.Init(-5,-3,50,5, 0,0,128);
+  w.Init(-10,2,47.5,5, 128,128,128);
+  u.Insert(@p);
+  u.Insert(@pp);
+  u.Insert(@p1);
+  u.Insert(@r);
+  u.Insert(@g);
+  u.Insert(@b);
+  u.Insert(@w);
+  Zoom(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray6p.pas

@@ -0,0 +1,259 @@
+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;
+
+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
+  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;
+
+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;
+  GetColor := c;
+end;
+
+procedure TraceIt;
+var
+  u: Universe;
+  p: Pplane;
+  pp,p1: Plane;
+  r,g,b,w: ColorSphere;
+begin
+  u.Init(320,200);
+  p.Init (-8.0, 0.0, 0.0,  0.0, 1.0, 0.001);
+  pp.Init (8.0, 0.0, 0.0,  1.0, 1.0, 0.001);
+  p1.Init (8.0, 30.0, 0.0,  -1.0, 1.0, 0.001);
+  r.Init(-15,-3,50,5, 128,0,0);
+  g.Init(-10,-3,45,5, 0,128,0);
+  b.Init(-5,-3,50,5, 0,0,128);
+  w.Init(-10,2,47.5,5, 128,128,128);
+  u.Insert(@p);
+  u.Insert(@pp);
+  u.Insert(@p1);
+  u.Insert(@r);
+  u.Insert(@g);
+  u.Insert(@b);
+  u.Insert(@w);
+  Save(u,'brion2.tga');
+  Beep;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray7.pas

@@ -0,0 +1,265 @@
+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;
+
+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
+  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;
+  Mandel = object(Plane)
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  end;
+
+function Mandel.GetColor(aray: Ray; time: Real): LongInt;
+const
+  k = 200;
+var
+  x,y,cRe,cIm: Real;
+  zRe,zIm,zx: Real;
+  Zsize: Real;
+  Count: integer;
+begin
+  y := (time * aray.dz + aray.oz)-50;
+  x := (time * aray.dx + aray.ox);
+  cRe := x/10; cIm := y/10;
+  zRe := 0; zIm := 0; zSize := 0;
+  Count := 0;
+  while (Count < k) and (Zsize < 2.0) do begin
+    zx  := zRe * zRe - zIm * zIm;
+    zIm := zRe * zIm - zIm * zRe;
+    zRe := zx;
+    zRe := zRe + cRe;
+    zIm := zIm + cIm;
+    Zsize := sqr(ZRe) + sqr(ZIm);
+    Inc(Count);
+  end;
+  if Count = k then
+    GetColor := $404040
+  else begin
+    Count := LongInt(Count)*360 div (k div 2);
+    GetColor := GetHsv(Count,100,100);
+  end;
+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;
+
+procedure TraceIt;
+var
+  u: Universe;
+  m: Mandel;
+  p: Plane;
+begin
+  u.Init(320,200);
+  m.Init(0,-8,0, 0,1,0);
+  p.Init(0,-8,0, 0,1,0);
+  u.Insert(@m);
+  {Save(u,'brion3.tga');}
+  Qwik(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray8.pas

@@ -0,0 +1,280 @@
+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;
+
+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
+  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;
+  WeirdSphere = object(Sphere)
+    function GetColor(aray: Ray; time: Real): LongInt; virtual;
+  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 WeirdSphere.GetColor(aray: Ray; time: Real): LongInt;
+var
+  r: Ray;
+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);
+  (*GetColor := GetHsv(Round(r.oy*359),Round(r.ox*100),100{Round(r.oz*100)});*)
+  GetColor := GetHsv(Round(r.oy*359),100,100);
+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;
+  GetColor := c;
+end;
+
+procedure TraceIt;
+var
+  u: Universe;
+  p: ColorSphere;
+  r,g,b,w: ColorSphere;
+  ws: WeirdSphere;
+  ss: array[0..17] of ColorSphere;
+  i,j,k,l,m: Integer;
+begin
+  u.Init(320,200);
+  p.Init(100,-1004,0, 1000, 128,128,0);
+  r.Init(-15,-3,50,5, 128,0,0);
+  g.Init(-10,-3,41,5, 0,128,0);
+  b.Init(-5,-3,50,5, 0,0,128);
+  w.Init(-10,4,47,5, 128,128,128);
+  ws.Init(15,6,100, 15);
+  for i := 0 to 17 do begin
+    Hsv2Rgb(i*20,100,100,j,k,l);
+    ss[i].Init(15+(sin(i*pi/9)*20),6,100+(cos(i*pi/9)*20),2, j div 2,k div 2,l div 2);
+  end;
+  u.Insert(@ws);
+  u.Insert(@p);
+  u.Insert(@r);
+  u.Insert(@g);
+  u.Insert(@b);
+  u.Insert(@w);
+  for i := 0 to 17 do
+    u.Insert(@ss[i]);
+  Save(u,'brion4.tga');
+  {Zoom(u);}
+  Beep;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/ray9.pas

@@ -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.

turbo-pascal/raypic.pas

@@ -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.

turbo-pascal/rays.pas

@@ -0,0 +1,201 @@
+program mmmmmmmmmmmmm;
+{$X+}
+uses Crt,Vga13h,RayShade;
+
+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;
+
+
+
+procedure TraceIt;
+var
+  u: Universe;
+begin
+  u.Init(320,200, 32,32,32);
+  Zoom(u);
+  Beep;
+  u.DeleteAll;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/rayshade.pas

@@ -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.

turbo-pascal/rayt.pas

@@ -0,0 +1,203 @@
+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;
+
+
+
+procedure TraceIt;
+var
+  u: TUniverse;
+begin
+  u.Init(320,200,10, 0,0,0, 0,0,1, 0,1,0, 1, 40,30, 0.2,0.2,0.2, 0,0,0);
+
+  Zoom(u);
+  Beep;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/rayt1.pas

@@ -0,0 +1,240 @@
+program RayTracingWithUltraRayTr;
+{$X+,N+}
+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
+  TSphere2 = object(TSphere)
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+
+procedure TSphere2.GetInfo(Ray: TRay; var Inf: TRayInfo);
+begin
+  TSphere.GetInfo(Ray,Inf);
+  MakeTrip(0.5,0.5,0.5,Inf.Opacity);
+  if not Inf.GoingIn then
+    MakeTrip(0,0,0,Inf.Reflectivity)
+  else
+    MakeTrip(0.05,0.05,0.05,Inf.Reflectivity);
+end;
+
+procedure TraceIt;
+var
+  u: TUniverse;
+  l1,l2,l3,l4: TLightSource;
+  s1,s3: TSphere;
+  s2: TSphere2;
+  p1: TPlane;
+begin
+  u.Init(320,200,10, 0,0,0, 0,0,1, 0,1,0, 1, 40,30, 0.2,0.2,0.2, 0,0,0);
+  u.Specular := False;
+  u.ScaleBase := True;
+
+  l1.Init(20,20,-200, 100,100,100);
+  l2.Init(-20,10,-150, 100,100,100);
+  l3.Init(3,100,60, 100,100,100);
+  u.InsertLight(@l1);
+  u.InsertLight(@l2);
+  u.InsertLight(@l3);
+
+  s1.Init(-5,3,20,5);
+  s2.Init(5,1,25,4);
+  s3.Init(9.5,1.5,30,3);
+  p1.Init(0,-8,0, 0,1,0);
+  u.Insert(@s1);
+  u.Insert(@s2);
+  u.Insert(@s3);
+  u.Insert(@p1);
+
+  {Save(u,'brion7.tga');}
+  Zoom(u);
+  Beep;
+  u.DeleteAll;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/rayt2.pas

@@ -0,0 +1,255 @@
+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
+  TPlane1 = object(TPlane)
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+
+  TransSphere = object(TSphere)
+    Col: RgbTriple;
+    constructor Init(x,y,z,rr,cr,cg,cb: Real);
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+
+procedure TPlane1.GetInfo(Ray: TRay; var Inf: TRayInfo);
+begin
+  TPlane.GetInfo(Ray,Inf);
+  MakeTrip(0,0,0,Inf.Reflectivity);
+end;
+
+constructor TransSphere.Init(x,y,z,rr,cr,cg,cb: Real);
+begin
+  TSphere.Init(x,y,z,rr);
+  MakeTrip(cr,cg,cb,Col);
+end;
+
+procedure TransSphere.GetInfo(Ray: TRay; var Inf: TRayInfo);
+begin
+  TSphere.GetInfo(Ray,Inf);
+  MakeTrip(0,0,0,Inf.Reflectivity);
+  MakeTrip(1-Col.r,1-Col.g,1-Col.b,Inf.Opacity);
+  Inf.Color := Col;
+end;
+
+procedure TraceIt;
+var
+  u: TUniverse;
+  p1,p2: TPlane1;
+  l1,l2,l3: TLightSource;
+  s1,s2,s3: TransSphere;
+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);
+
+  l1.Init(-8.5,3,50, 20,20,20);
+  l2.Init(0,3,65, 20,20,20);
+  l3.Init(8.5,3,50, 20,20,20);
+  u.InsertLight(@l1);
+  u.InsertLight(@l2);
+  u.InsertLight(@l3);
+
+  s1.Init(-8.5,3,50,2, 1,0,0);
+  s2.Init(0,3,65,2,   0,1,0);
+  s3.Init(8.5,3,50,2,  0,0,1);
+  p1.Init(0,-8,0, 0,1,0);
+  p2.Init(0,15,0, 0,-1,0);
+  u.Insert(@p1);
+  u.Insert(@p2);
+  u.Insert(@s1);
+  u.Insert(@s2);
+  u.Insert(@s3);
+
+  Save(u,'brion8.tga');
+  {Zoom(u);}
+  Beep;
+  u.DeleteAll;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/rayt3.pas

@@ -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.

turbo-pascal/rayt4.pas

@@ -0,0 +1,302 @@
+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
+  TSphere2 = object(TSphere)
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+  TPlane2 = object(TPlane)
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+
+procedure TSphere2.GetInfo(Ray: TRay; var Inf: TRayInfo);
+var
+  a, b, c, t1, t2, t3, close, farther: real;
+  p1,p2: TPoint3d;
+begin
+  a := ray.d.x * ray.d.x + ray.d.y * ray.d.y + ray.d.z * ray.d.z;
+  close := -1.0;
+  farther := -1.0;
+  if a <> 0 then begin
+    b := 2.0 * ((ray.o.x - Pos.x) * ray.d.x
+        + (ray.o.y - Pos.y) * ray.d.y
+        + (ray.o.z - Pos.z) * ray.d.z);
+    c := (ray.o.x - Pos.x) * (ray.o.x - Pos.x)
+        + (ray.o.y - Pos.y) * (ray.o.y - Pos.y)
+        + (ray.o.z - Pos.z) * (ray.o.z - Pos.z) - 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;
+  p1.SetTo(
+    ray.o.x+ray.d.x*close,
+    ray.o.y+ray.d.y*close,
+    ray.o.z+ray.d.z*close);
+  p2.SetTo(
+    ray.o.x+ray.d.x*farther,
+    ray.o.y+ray.d.y*farther,
+    ray.o.z+ray.d.z*farther);
+  if (p1.z-Pos.z) < -(r * 0.85) then close := -1;
+  if (p2.z-Pos.z) < -(r * 0.85) then farther := -1;
+  if (close <= 0.001) and (farther > 0.001) then begin
+    Inf.Time := farther; Inf.GoingIn := False;
+  end else
+    if (close > 0.001) and (farther <= 0.001) then begin
+      Inf.Time := close; Inf.GoingIn := False;
+    end else begin
+      Inf.GoingIn := True;
+      if close < farther then
+        Inf.Time := close
+      else
+        Inf.Time := farther;
+    end;
+  Inf.Hit := (Inf.Time > 0.001);
+  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);
+  Inf.Normal := Inf.Pos;
+  Inf.Normal.Sub(Pos);
+  if not Inf.GoingIn then Inf.Normal.Scale(-1);
+  Inf.Brightness := 1;
+  Inf.IndexRefraction := 0.95;
+  MakeTrip(1,1,1,Inf.Opacity);
+  MakeTrip(0,0,0,Inf.Reflectivity);
+  Inf.SpecularN := 200;
+  MakeTrip(0.8,0.8,0.8,Inf.Color);
+end;
+
+procedure TPlane2.GetInfo(Ray: TRay; var Inf: TRayInfo);
+begin
+  TPlane.GetInfo(Ray,Inf);
+  MakeTrip(0,0,0,Inf.Reflectivity);
+  Inf.SpecularN := 1;
+  MakeTrip(0.9,0.9,0.9,Inf.Color);
+end;
+
+procedure TraceIt;
+var
+  u: TUniverse;
+  l1,l2: TLightSource;
+  p1: TPlane2;
+  s1: TSphere2;
+  s2,s3,s4: TSphere;
+begin
+  u.Init(320,200,10, 0,1,0, 0,0,1, 0,1,0, 1, 40,30, 0.2,0.2,0.2, 0,0,0);
+  u.Specular := False;
+
+  l1.Init(0,-1.7,25, 500,500,500);
+  l2.Init(20,60,20, 30,30,30);
+  u.InsertLight(@l1);
+  u.InsertLight(@l2);
+
+  p1.Init(0,-2,0, 0,1,0);
+  s1.Init(0,2,25,10);
+  s2.Init(0,-1,15,1);
+  s3.Init(-2.25,-1,15.5,1);
+  s4.Init(2.25,-1,15.5,1);
+  u.Insert(@p1);
+  u.Insert(@s1);
+  u.Insert(@s2);
+  u.Insert(@s3);
+  u.Insert(@s4);
+
+  {Zoom(u);}
+  Save(u,'brion9.tga');
+  Beep;
+  u.DeleteAll;
+  u.Done;
+end;
+
+begin
+  Set13h;
+  SetUpRgb;
+  TraceIt;
+  ReadKey;
+  BiosMode(3);
+end.

turbo-pascal/rayt5.pas

@@ -0,0 +1,413 @@
+program RayTracingWithUltraRayTr;
+{$X+}
+uses Crt,Vga13h,RayTr,Dos;
+
+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;
+
+var
+  Hour1,Minute1,Second1,Sec1001,
+  Hour2,Minute2,Second2,Sec1002: Word;
+
+procedure StartTime;
+begin
+  GetTime(Hour1, Minute1, Second1, Sec1001);
+end;
+
+procedure EndTime;
+begin
+  GetTime(Hour2, Minute2, Second2, Sec1002);
+end;
+
+function LeadingZero(w : Word) : String;
+var
+  s : String;
+begin
+  Str(w:0,s);
+  if Length(s) = 1 then
+    s := '0' + s;
+  LeadingZero := s;
+end;
+
+procedure ShowTime;
+var
+  time1,time2,time3: Word;
+begin
+  Writeln('Starting time: ',Hour1,':',LeadingZero(Minute1));
+  Writeln('Ending time: ',Hour2,':',LeadingZero(Minute2));
+  time1 := Hour1*60+Minute1;
+  time2 := Hour2*60+Minute2;
+  time3 := time2-time1;
+  Writeln('Total time: ',time3 div 60,':',LeadingZero(time3 mod 60));
+end;
+
+type
+  PPillar = ^TCylinder;
+  PFloor = ^TFloor;
+  PCeiling = ^TCeiling;
+  PMirrorSphere = ^TMirrorSphere;
+  PPitInside = ^TPitInside;
+  PBonfire = ^TBonfire;
+  PFireCyl = ^TFireCyl;
+
+  TPitInside = object(TCylinder)
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+  TFloor = object(TPlane)
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+  TCeiling = object(TPlane)
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+  TMirrorSphere = object(TObject3d)
+    Pos: TPoint3d;
+    r: Float;
+    constructor Init(x,y,z,ra: Float);
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+  TBonfire = object(TSphere)
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+  TFireCyl = object(TCylinder)
+    procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual;
+  end;
+
+procedure TFloor.GetInfo(Ray: TRay; var Inf: TRayInfo);
+var
+  d1,d2,d3: Float;
+begin
+  TPlane.GetInfo(Ray,Inf);
+  if not Inf.Hit then Exit;
+  d1 := Sqrt(Sqr(Inf.Pos.x)+Sqr(Inf.Pos.y)+Sqr(Inf.Pos.z-4));
+  d2 := Sqrt(Sqr(Inf.Pos.x-3)+Sqr(Inf.Pos.y)+Sqr(Inf.Pos.z+7));
+  d3 := Sqrt(Sqr(Inf.Pos.x+3)+Sqr(Inf.Pos.y)+Sqr(Inf.Pos.z+7));
+  if ((d1 > 3) and (d1 < 5) and
+    ((Inf.Pos.z > 4) or ((Inf.Pos.x < -1) or (Inf.Pos.x > 1)))) or
+    (d2 < 2) or (d3 < 2) then
+    Inf.Hit := False;
+  MakeTrip(0,0,0,Inf.Reflectivity);
+end;
+
+procedure TCeiling.GetInfo(Ray: TRay; var Inf: TRayInfo);
+begin
+  TPlane.GetInfo(Ray,Inf);
+  MakeTrip(0,0,0,Inf.Reflectivity);
+  if (Inf.Pos.x < -9) or (Inf.Pos.x > 9) or
+    (Inf.Pos.z < -10) or (Inf.Pos.z > 10) then
+    Inf.Hit := False;
+end;
+
+constructor TMirrorSphere.Init(x,y,z,ra: Float);
+begin
+  TObject3d.Init;
+  Pos.SetTo(x,y,z);
+  r := ra;
+end;
+
+procedure TMirrorSphere.GetInfo(Ray: TRay; var Inf: TRayInfo);
+var
+  c,f: Float;
+  p1,p2: TPoint3d;
+begin
+  GetSphereInfo(Ray,Pos,r,c,f);
+  p1.SetTo(
+    Ray.o.x+Ray.d.x*c,
+    Ray.o.y+Ray.d.y*c,
+    Ray.o.z+Ray.d.z*c);
+  p2.SetTo(
+    Ray.o.x+Ray.d.x*f,
+    Ray.o.y+Ray.d.y*f,
+    Ray.o.z+Ray.d.z*f);
+  if (p1.z < Pos.z) or (p1.y < Pos.y) then c := -1;
+  if (p2.z < Pos.z) or (p2.y < Pos.y) then f := -1;
+  Inf.Hit := (c > 0.001) or (f > 0.001);
+  if not Inf.Hit then Exit;
+  Inf.Time := MaxReal;
+  if c > 0.001 then Inf.Time := c;
+  if (f < Inf.Time) and (f > 0.001) then Inf.Time := f;
+  if Inf.Time = c then Inf.Pos := p1 else Inf.Pos := p2;
+  Inf.Normal := Inf.Pos;
+  Inf.Normal.Sub(Pos);
+  Inf.GoingIn := (Inf.Normal.Dot(Ray.d)) < 0;
+  if not Inf.GoingIn then begin
+    Inf.Normal.Scale(-1);
+    MakeTrip(0.75,0.75,0.75,Inf.Reflectivity);
+    MakeTrip(0.25,0.25,0.25,Inf.Color);
+    Inf.SpecularN := 200;
+  end else begin
+    MakeTrip(0,0,0,Inf.Reflectivity);
+    MakeTrip(0.5,0.5,0.5,Inf.Color);
+    Inf.SpecularN := 1;
+  end;
+  Inf.Brightness := 1;
+  MakeTrip(1,1,1,Inf.Opacity);
+end;
+
+procedure TBonfire.GetInfo(Ray: TRay; var Inf: TRayInfo);
+var
+  z: Float;
+begin
+  TSphere.GetInfo(Ray,Inf);
+  if not Inf.Hit then Exit;
+  MakeTrip(0,0,0,Inf.Reflectivity);
+  Inf.SpecularN := 50;
+  if Inf.Pos.y < Pos.y then begin
+    MakeTrip(1,1,1,Inf.Opacity);
+    MakeTrip(0.8,0.8,0.8,Inf.Color);
+    Inf.Brightness := 1;
+  end else begin
+    MakeTrip(0,0,0,Inf.Opacity);
+    z := 1-((Inf.Pos.y-Pos.y)/r);
+    MakeTrip(z,z*0.667,0,Inf.Color);
+    Inf.Brightness := 0.3;
+  end;
+  Inf.IndexRefraction := 1;
+end;
+
+procedure TFireCyl.GetInfo(Ray: TRay; var Inf: TRayInfo);
+var
+  t,z: Float;
+  r1: TRay;
+begin
+  TCylinder.GetInfo(Ray,Inf);
+  if not Inf.Hit then Exit;
+  Inf.Hit := ((Inf.Pos.z > 4) or ((Inf.Pos.x < -1) or (Inf.Pos.x > 1)));
+  if not Inf.Hit then begin
+    r1.o := Inf.Pos;
+    r1.d := Ray.d;
+    t := Inf.Time;
+    GetInfo(r1,Inf);
+    Inf.Time := Inf.Time + t;
+  end else begin
+    MakeTrip(0,0,0,Inf.Opacity);
+    z := 1-((Inf.Pos.y-Pos.y)/h);