old/PAS/RayTracing/TGA.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;

type

  PTGATrace = ^TGATrace;
  TGATrace = object (TTracer)
    outF   : FILE;
    ver    : longint;
    Constructor Init(OutPut : string);
    Procedure GetReflPointColor(var aC:RGB;aRay:TRay;Num:word);
    {
      � ¡®â îâ ®âà ¦¥­¨ï !!!!
      Num - £«ã¡¨­  ४ãàᨨ (¤«ï ¯¥à¢®£® § ¯ã᪠ - 1)
    }
    Procedure Trace(ResX,ResY:word);
    Destructor Done;virtual;
  end;
{TGATrace}
    Constructor TGATrace.Init(OutPut : string);
    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;
    end;
{-------------------------}
    Procedure   TGATrace.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);
{      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   TGATrace.Trace;
    var
     Ray    : tRay;
     i,j    : longint;
     ColP   : LongInt;
     DX,DY  : tVec;
     C      : tVec;
     T,cur  : float;
     Col    : RGB;
    begin
     BlockWrite(outF,ResX,2);
     BlockWrite(outF,ResY,2);
     i:=24;
     BlockWrite(outF,i,2);

     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);  {Try This Stuff (It's work!)}
{         GetPointColor2(Col,Ray);}
{         GetPointColor(Col,Ray);}
         ColP:=Pack24(Col);
         BlockWrite(outF,ColP,3);
         VLinear(C,C,DX,1,1);
       end;
       VLinear(C,C,DX,1,-ResX);
       VLinear(C,C,DY,1,1);
       Write(#13'Line: ',ResY-i,'/',ResY,'  ');
     end;
    end;{TGATrace.Trace}
{-------------------------}
  Destructor TGATrace.Done;
  begin
    Close(outF);
    Inherited Done;
  end;
{-------------------------}

Var
  TGA : TGATrace;
  fIn,fOut : String;
  ResX,ResY,res : Integer;
  hb,mb,sb,ssb  : word;
  he,me,se,sse  : word;
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);
  TGA.Load(fIn);

  GetTime(hb,mb,sb,ssb);
  TGA.Trace(resX,resY);
  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;
end.