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.