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.