old/PAS/RayTracing/PROTGA.PAS

Uses UVector, ObjTrace, Gtypes,Objects, Dos;
CONST
  TGAHeader  : array [1..12] of byte = (0,0,2,0, 0,0,0,0, 0,0,0,0);
  MAXRecur   = 5;
  HeadSize   = 18;
  PlanesDist = 320;
  PlanesFOV  = 60;

type

  PProTGATrace = ^ProTGATrace;
  ProTGATrace = object (TTracer)
    outF   : FILE;
    ver    : longint;
    Constructor Init(OutPut : string;ResX,ResY:word);
    Procedure GetPointColor(var aC:RGB;aRay:TRay);
    Procedure GetPointColor2(var aC:RGB;aRay:TRay);
     { Использование более "честной" с точки зрения физики формулы
       рассчета освещенности (делим коэффициенты на квадрат расстояния)
       Требуются источники в 5000-20000 раз мощнее
     }
    Procedure GetReflPointColor(var aC:RGB;aRay:TRay;Num:word);
    {
      Работают отражения !!!!
      Num - глубина рекурсии (для первого запуска - 1)
    }
    Procedure Trace(ResX,ResY:longint;BegSet,Increase:longint);
    Destructor Done;virtual;
  end;
{TGATrace}
    Constructor ProTGATrace.Init(OutPut : string;ResX,ResY:word);
    var res:word;
    begin
      Inherited Init;
      Ver := CurVer;
      Assign(outF,OutPut);
      Rewrite(outF,1);
      BlockWrite(outF,TGAHeader,12,Res);
      if Res <> 12 then
       begin
         WriteLn('Writing to ',OutPut,' error!');
         Halt(255);
       end;
     ResX:=ResX*2;
     ResY:=ResY*2;
     BlockWrite(outF,ResX,2);
     BlockWrite(outF,ResY,2);
     res:=24;
     BlockWrite(outF,res,2);
    end;
    Procedure   ProTGATrace.GetPointColor(var aC:RGB;aRay:TRay);
    var
      Lt : POmni;
      Ob : PSurfObj;
      oC : RGB;
      Norm, Intr,R : tVec;
      LRay : TRay;
      Dest,tmp : float;
      i  : word;
    begin
      SetColor(aC,0,0,0);
      oB := PSurfObj(FindISect(aRay,Dest));
      if oB = nil then exit;

      aC := Ambient;
      aRay.GetPoint(Intr,Dest);
      oB^.GetNormal(Norm,Intr);

      for i := 1 to LightCount do
        if Pos('OMNI',Lights^[i]^.OType) <> 0 then
        begin
          Lt := POmni(Lights^[i]);
          LRay.Init(Intr,Intr);
          VLinear(LRay.Dir,Lt^.Pos,Intr,1,-1);
          if (FindISect(LRay,tmp) = nil) or (tmp>1.0)  then
          begin
            tmp := Vcos(Norm,LRay.Dir) * oB^.Surface^.Kd;
            CAddMul(aC,Lt^.Color,tmp);

            VLinear(R,Norm,LRay.Dir,-2*VDot(Norm,LRay.Dir),1);
            tmp := Pow(VCos(R,aRay.Dir),Ob^.Surface^.Ns)*Ob^.Surface^.Ks;
            CAddMul(aC,Lt^.Color,tmp);
          end;
 	       end;

      Ob^.GetColor(oC,Intr);

      aC.R := aC.R * OC.R;
      aC.G := aC.G * OC.G;
      aC.B := aC.B * OC.B;
    end;{TGATrace.GetPointColor}
{-------------------------}
    Procedure   ProTGATrace.GetPointColor2(var aC:RGB;aRay:TRay);
    var
      Lt : POmni;
      Ob : PSurfObj;
      OC : RGB;
      Norm, Intr,R : tVec;
      LRay : TRay;
      Dest,tmp : float;
      i  : word;
    begin
      SetColor(aC,0,0,0);
      oB := PSurfObj(FindISect(aRay,Dest));
      if oB = nil then exit;

      aC := Ambient;
      aRay.GetPoint(Intr,Dest);
      oB^.GetNormal(Norm,Intr);

      for i := 1 to LightCount do
        if Pos('OMNI',Lights^[i]^.OType) <> 0 then
        begin
          Lt := POmni(Lights^[i]);
          LRay.Init(Intr,Intr);
          VLinear(LRay.Dir,Lt^.Pos,Intr,1,-1);
          if (FindISect(LRay,tmp) = nil) or (tmp>1.0)  then
          begin
	    tmp := Vcos(Norm,LRay.Dir) * oB^.Surface^.Kd
{New 2 Prev}    / VDot(LRay.Dir,LRay.Dir); {Делим на квадрат расстояния
		    				до источника}
            CAddMul(aC,Lt^.Color,tmp);

            VLinear(R,Norm,LRay.Dir,-2*VDot(Norm,LRay.Dir),1);
            tmp := Pow(VCos(R,aRay.Dir),Ob^.Surface^.Ns)*Ob^.Surface^.Ks
{New}            	   / VDot(LRay.Dir,LRay.Dir); {Делим на квадрат расстояния
		    				до источника}
            CAddMul(aC,Lt^.Color,tmp);
          end;
 	end;
      Ob^.GetColor(oC,Intr);

      aC.R := aC.R * OC.R;
      aC.G := aC.G * OC.G;
      aC.B := aC.B * OC.B;
    end;{TGATrace.GetPointColor}
{-------------------------}
    Procedure   ProTGATrace.GetReflPointColor(var aC:RGB;aRay:TRay;Num:word);
    var
      Lt : POmni;
      Ob : PSurfObj;
      oC : RGB;
      N,P,R : tVec;
      ReflCol : RGB;
      L,Refl : TRay;
      Pd,tmp : float;
      i  : word;
    begin
      SetColor(aC,0,0,0);
      if Num >= MAXRecur then Exit;
      oB := PSurfObj(FindISect(aRay,Pd));
      if oB = nil then exit;

      aC := Ambient;
      aRay.GetPoint(P,Pd);
      oB^.GetNormal(N,P);

      for i := 1 to LightCount do
        if Pos('OMNI',Lights^[i]^.OType) <> 0 then
        begin
          Lt := POmni(Lights^[i]);
          L.Init(P,P);
          VLinear(L.Dir,Lt^.Pos,P,1,-1);
          if (FindISect(L,tmp) = nil) or (tmp>1.0)  then
          begin
            if OB^.ID in [F_OBJ_SURF_PLANE,F_TRI,F_QUAD] then
      	      tmp := aCos(N,L.Dir) * oB^.Surface^.Kd / VDot(L.Dir,L.Dir)
            else
              tmp := Vcos(N,L.Dir) * oB^.Surface^.Kd / VDot(L.Dir,L.Dir);

            CAddMul(aC,Lt^.Color,tmp);

            VLinear(R,N,L.Dir,-2*VDot(N,L.Dir),1);
            if OB^.ID in [F_OBJ_SURF_PLANE,F_TRI,F_QUAD] then
              tmp := Pow(aCos(R,aRay.Dir),Ob^.Surface^.Ns)*Ob^.Surface^.Ks
                         / VDot(L.Dir,L.Dir)
            else
              tmp := Pow(VCos(R,aRay.Dir),Ob^.Surface^.Ns)*Ob^.Surface^.Ks
{New}              / VDot(L.Dir,L.Dir); {Делим на квадрат расстояния
		    				до источника}
            CAddMul(aC,Lt^.Color,tmp);
          end;
 	end;
{Calculate Reflection vec}
      Refl.Init(P,P);
      VLinear(Refl.Dir,N,aRay.Dir,-2*VDot(N,aRay.Dir),1);
      VNorm(Refl.Dir,1);
      GetReflPointColor(ReflCol,Refl,Num+1);
      if Pd > VisRange then tmp := VisRange / Pd
      else tmp := 1;
      CAddMul(aC,ReflCol,Ob^.Surface^.Ks*tmp);
{      CAddMul(aC,ReflCol,1);}

      Ob^.GetColor(oC,P);

      aC.R := aC.R * OC.R;
      aC.G := aC.G * OC.G;
      aC.B := aC.B * OC.B;
    end;{TGATrace.GetPointColor}
{-------------------------}
    Procedure   ProTGATrace.Trace;
    var
     Ray    : tRay;
     i,j    : longint;
     ColP   : LongInt;
     DX,DY  : tVec;
     C      : tVec;
     T,cur  : float;
     Col    : RGB;
    begin
     Seek(outF,BegSet);

     C := View.LLPos;
     VLinear(DX,View.Right,DX,1/ResX,0); {Расчет вектора прироста по X & Y}
     VLinear(DY,View.Up,   DY,1/ResY,0); {}

     for i := ResY-1 downto 0 do
     begin
       for j:= 0 to ResX-1 do
       begin
         Ray.Init(View.CamPos,View.CamPos);
         VLinear(Ray.Dir,C,View.CamPos,1,-1);
         VNorm(Ray.Dir,1);
         GetReflPointColor(Col,Ray,1); 
{         GetPointColor2(Col,Ray);}
{         GetPointColor(Col,Ray);}
         ColP:=Pack24(Col);
         BlockWrite(outF,ColP,3);
         VLinear(C,C,DX,1,1);
       end;
       Seek(outF,FilePos(outF)+Increase);
       VLinear(C,C,DX,1,-ResX);
       VLinear(C,C,DY,1,1);
       Write(#13'Line: ',ResY-i,'/',ResY,'  ');
     end;
    end;{TGATrace.Trace}
{-------------------------}
  Destructor ProTGATrace.Done;
  begin
    Close(outF);
    Inherited Done;
  end;
{-------------------------}

Var
  TGA : ProTGATrace;
  fIn,fOut : String;
  ResX,ResY     : LongInt;
  res           : integer;
  hb,mb,sb,ssb  : word;
  he,me,se,sse  : word;
  org,targ      : tVec;

begin
  if ParamCount < 3 then
   begin
     WriteLn('Usage: TGA.exe <scene.tra> <ResX> <ResY> [out.tga]');
     Halt(255);
   end;
  fIn := ParamStr(1);
  if ParamStr(4) <> '' then fOut := ParamStr(4)
  else fOut := Copy(fIn,1,Length(fIn)-3)+'tga';
  Val(ParamStr(2),ResX,res);
  Val(ParamStr(3),ResY,res);

  TGA.Init(fOut,ResX,ResY);
  TGA.Load(fIn);

  GetTime(hb,mb,sb,ssb);
  TGA.Trace(resX,resY,ResX*3+HEADsize,ResX*3); {Our Picture}
  VSet(org,0,Planesdist,0);VSet(targ,0,0,0);
  TGA.SetCamera(org,targ,0,PlanesFOV,ResX/ResY); {Top projection}
  TGA.Trace(resX,ResY,2*ResX*ResY*3+HEADsize,ResX*3);
  VSet(org,-Planesdist,0,0);
  TGA.SetCamera(org,targ,0,PlanesFOV,ResX/ResY); {Left projection}
  TGA.Trace(resX,ResY,(2*ResX*ResY+ResX)*3+HEADsize,ResX*3);
  VSet(org,0,0,-Planesdist);
  TGA.SetCamera(org,targ,0,PlanesFOV,ResX/ResY); {Forward projection}
  TGA.Trace(resX,ResY,HEADsize,ResX*3);

  GetTime(he,me,se,sse);

  if (sse<ssb) then
   begin
     dec(se);
     Inc(sse,100-ssb);
   end
  else Dec(sse,ssb);

  if (se<sb) then
   begin
     dec(me);
     Inc(se,60-sb);
   end
  else Dec(se,sb);

  if (me<mb) then
   begin
     dec(he);
     Inc(me,60-mb);
   end
  else Dec(me,mb);
  Dec(he,hb);
  WriteLn(#13'Elapsed ',he,' hours, ',me,' minutes, ',se,' seconds, ',
          sse,' 100th second');
  TGA.Done;

{  TGA.Load('cool.tra');}

{  TGA.Load('planes.tra');}

{  TGA.Save('cool.tra',true);}

end.