old/PAS/RayTracing/OBJTRACE.PAS

unit ObjTrace;

                INTERFACE
Uses UVector,Matrices,GTypes,Objects;
CONST
  MaxDeep   = 2500;
  VisRange  = 100;
  TRAHeader : string [11] = 'Rod''sTracer';
  CurVer    : longint     = $00010001;

{------------- [TRACER] ---------------}
CONST
  MAXOBJS = 3000;
  MAXTEXTURES = 10;
TYPE
  PObjectArray  = ^TObjectArray;
  TObjectArray  = array [1..MAXOBJS] of PObject;
  PTextureArray = ^TTextureArray;
  TTextureArray = array [1..MAXTEXTURES] of PTexture;

  PViewPlane = ^TViewPlane;
  TViewPlane = record
    LLpos : tVec;
    Up    : tVec;
    Right : tVec;
    CamPos : TVec;
  end;

  PTracer = ^TTracer;
  TTracer = object
    ObjectCount         : Word;
    Objects             : PObjectArray;
    LightCount          : Word;
    Lights              : PObjectArray;
    TextureCount       : Word;
    Textures            : PTextureArray;
    Ambient             : RGB;
    View                : TViewPlane;
    Constructor Init;
    Procedure SetPlane(aLLPos,aUp,aRight : tVec);
    Procedure SetCamera(aOrg,aTarg:tVec;aRoll,aFov,aXtoY:float);
    Procedure LoadCamera(var F:FILE);
    Procedure Load(Inp:string);
    Procedure Save(Out:string;aView:Boolean);
    Procedure AddObject(aNew : PColObj);virtual;
    Procedure AddLight(aNew : PLight);virtual;
    Procedure AddTexture(aNew : PTexture);virtual;
    Function  GetObject(Index:word):PColObj;virtual;
    Function  GetLight(Index:word):PLight;virtual;
    Procedure Trace;
    Function FindISect(aRay:TRay;var oT:float):PObject;
    Destructor Done;virtual;
  end;

{--------------------  MODIFICATIONS ----------------}
   Procedure SetRotate(Pivot,Axis:tVec;Ang:float;var ob : PObject);
   Procedure SetTranslate(v:tVec;var ob : PObject);
   Procedure SetScale(Pivot, V : tVec;var ob : PObject);

                IMPLEMENTATION
{TTracer}
    Constructor TTracer.Init;
    begin
      ObjectCount := 0;
      New(Objects);
      FillChar(Objects^,MAXOBJS*sizeof(Pointer),0);
      LightCount := 0;
      New(Lights);
      FillChar(Lights^,MAXOBJS*sizeof(Pointer),0);
      TextureCount := 0;
      New(Textures);
      FillChar(Textures^,MAXTEXTURES*sizeof(Pointer),0);
    end;
    Procedure TTracer.AddObject(aNew : PColObj);
    begin
      If ObjectCount = MaxObjs then
       begin
        Write('Object array overflow! :(');
        exit;
       end;
      Inc(ObjectCount);
      Objects^[ObjectCount] := aNew;
    end;
    Procedure TTracer.AddTexture(aNew : PTexture);
    begin
      If TextureCount = MaxTextures then
       begin
        Write('Texture array overflow! :(');
        exit;
       end;
      Inc(TextureCount);
      Textures^[TextureCount] := aNew;
    end;
    Procedure TTracer.AddLight(aNew : PLight);
    begin
      If LightCount = MaxObjs then
       begin
        Write('Object array overflow! :(');
        exit;
       end;
      Inc(LightCount);
      Lights^[LightCount] := aNew;
    end;
    Function  TTracer.GetObject(Index:word):PColObj;
    begin
     if Index > ObjectCount then GetObject := nil
     else GetObject := PColObj(Objects^[Index]);
    end;
    Function  TTracer.GetLight(Index:word):PLight;
    begin
      if Index > LightCount then getLight := nil
      else GetLight := PLight(Lights^[Index]);
    end;
    Procedure TTracer.Trace;
    begin
    end;
    Procedure   TTracer.SetPlane(aLLPos,aUp,aRight : tVec);
    begin
      with View do begin LLPos := aLLPos; Up:=aUp;Right:=aRight;end;
    end;

    Procedure   TTracer.SetCamera;
    var
      Dist,Ds,Ds2             : tVec;
      D,Len                   : float;
      aSx,aCx,aSy,aCy,aSz,aCz : float;
      Trans                   : TTRANSFORM;

    begin
      VLinear(Dist,aTarg,aOrg,1,-1);
      View.CamPos := aOrg;
      D := sqrt(VDot(Dist,Dist));
      View.LLpos := aTarg;
      if (Dist.X = 0) and (Dist.Z=0) then VSet(View.Right,0,0,1)
      else VSet(View.Right,Dist.Z,0,-Dist.X);

      Compute_Axis_Rotation_Transform(trans,Dist,M_PI_180*aRoll);
      MTransPoint(View.Right,View.Right,Trans);


      VCross(View.Up,Dist,View.Right);
      VNorm(View.Right,D*TAN(PI*aFov/360));
      VNorm(View.Up,D*TAN(PI*aFov/360)/aXtoY);

      VLinear(View.LLpos,View.LLpos,View.up,1,-1);
      VLinear(View.LLpos,View.LLpos,View.Right,1,-1);
      VLinear(View.up,View.up,View.up,1,1);
      VLinear(View.Right,View.Right,View.Right,1,1);

    end;
    Procedure   TTracer.Load(Inp:string);
    var
      Header     : string;
      ID         : ObjID;
      m_PSph     : PSphere;
      m_PPl      : PSurfPlane;
      m_Tri      : PTriangle;
      m_PLight   : POmni;
      m_Quad     : PQuad;
      m_Texture  : PTexture;
      m_PInterS  : PInterS;
      m_Cone     : PCone;
      tName      : string[13];
      Rad,Len    : float;
      NeedAdd    : boolean;
      F          : File;
      Cur        : LongInt;
      Ls         : longint;
      Pivot,Axis : tVec;
      Ang        : float;
    begin
      Assign(F,Inp);
      {$I-}
      Reset(F,1);
      if IOResult <> 0 then
       begin
         WriteLn('Error opening ',Inp);
         Halt(250);
       end;
      BlockRead(F,Header,12);
      if Header <> TRAHeader then
      begin
        WriteLn('Not Our format');
        Halt(240);
      end;
      BlockRead(F,Cur,4);
      if Cur <> curver then
      begin
        WriteLn('Not current version');
        Halt(230);
      end;
      while Not EOF(F) do
       begin
         BlockRead(F,ID,sizeof(ObjID));
         case ID of
          F_ROTATE:
           begin
            BlockRead(F,Ls,sizeof(LongInt));
            BlockRead(F,Pivot,vecsize);
            BlockRead(F,Axis,vecsize);
            BlockRead(F,Ang,sizeof(float));
            Ls := ObjectCount+1 - Ls;
            if Ls>=0 then for Cur := ObjectCount downto Ls do
              SetRotate(Pivot,Axis,Ang,Objects^[Cur]);
           end;
          F_TRANSLATE:
           begin
            BlockRead(F,Ls,sizeof(LongInt));
            BlockRead(F,Pivot,vecsize);
            Ls := ObjectCount+1 - Ls;
            if Ls>=0 then for Cur := ObjectCount downto Ls do
              SetTranslate(Pivot,Objects^[Cur]);
           end;
          F_SCALE:
           begin
            BlockRead(F,Ls,sizeof(LongInt));
            BlockRead(F,Pivot,vecsize);
            BlockRead(F,Axis,vecsize);
            Ls := ObjectCount+1 - Ls;
            if Ls>=0 then for Cur := ObjectCount downto Ls do
              SetScale(Pivot,Axis,Objects^[Cur]);
           end;
          F_TEXTURE:
           begin
             BlockRead(F,Ls,sizeof(LongInt));
             BlockRead(F,TName,13);
             BlockRead(F,rad,sizeof(float));
             BlockRead(F,Len,sizeof(float));
             for cur := 1 to TextureCount do
              if Textures^[cur]^.Name = TName then break;
             if  Textures^[cur]^.Name = TName then m_Texture :=Textures^[cur]
             else
              begin
                New(m_Texture,Init(1,1));
                m_Texture^.LoadTGA(TName);
                AddTexture(m_Texture);
              end;
             Ls := ObjectCount+1 - Ls;
             if Ls>=0 then for Cur := ObjectCount downto Ls do
              PSurfObj(Objects^[Cur])^.SetTexture(m_Texture,rad,len);
           end;
          F_INTER_SPHERE:
           begin
            New(m_PInterS,Load(F));
            AddObject(m_PInterS);
           end;
          F_CONE:
           begin
            New(m_Cone,Load(F));
            AddObject(m_Cone);
           end;
          F_OBJ_SPHERE:
           begin
            New(m_PSph,Load(F));
            AddObject(m_PSph);
           end;
          F_OBJ_SURF_PLANE:
           begin
            New(m_PPl,Load(F));
            AddObject(m_PPl);
           end;
          F_TRI_PLANE:
           begin
            New(m_PPl,TriLoad(F));
            AddObject(m_PPl);
           end;
          F_TRI:
           begin
            New(m_Tri,Load(F));
            AddObject(m_Tri);
           end;
          F_QUAD:
           begin
            New(m_Quad,Load(F));
            AddObject(m_Quad);
           end;
          F_LIGHT_OMNI:
           begin
            New(m_PLight,Load(F));
            AddLight(m_PLight);
           end;
          F_VIEWPORT:
           begin
             BlockRead(F,View.CamPos,vecsize);
             BlockRead(F,View.LLPos,vecsize);
             BlockRead(F,View.Up,vecsize);
             BlockRead(F,View.Right,vecsize);
           end;
          F_AMBIENT: LoadRGB(F,Ambient);
          F_CAMERA : LoadCamera(F);
         end;
       end;
       Close(F);
    end;
    Procedure   TTracer.LoadCamera;
    var
     org,targ : tVec;
     roll, fov, xtoy : float;
    begin
      BlockRead(F,org,vecsize);
      BlockRead(F,targ,vecsize);
      BlockRead(F,roll,sizeof(float));
      BlockRead(F,fov,sizeof(float));
      BlockRead(F,xtoy,sizeof(float));
      SetCamera(org,targ,roll,fov, xtoy);
    end;
    Procedure   TTracer.Save;
    var
     F:FILE;
     i:word;
    begin
      Assign(F,Out);
      Rewrite(F,1);
      BlockWrite(F,TRAHeader,12);
      BlockWrite(F,CurVer,sizeof(LongInt));
      if aView then
        begin
          I:=Ord(F_VIEWPORT);BlockWrite(F,I,1);
          BlockWrite(F,View.CamPos,vecsize);
          BlockWrite(F,View.LLPos,vecsize);
          BlockWrite(F,View.Up,vecsize);
          BlockWrite(F,View.Right,vecsize);
        end;
      I:=Ord(F_AMBIENT);BlockWrite(F,I,1);SaveRGB(F,Ambient);
      for i := 1 to ObjectCount do if Objects^[i] <> nil then
         if Pos('_FILE_',Objects^[i]^.OType) <> 0 then
           PFileObj(Objects^[i])^.Save(F);
      for i := 1 to LightCount do if Lights^[i] <> nil then
       begin
         if Pos('_FILE_',Lights^[i]^.OType) <> 0 then
           PLight(Lights^[i])^.Save(F);
       end;
      Close(F);
    end;
    Function    TTracer.FindISect(aRay:TRay;var oT:float):PObject;
    var
       Cur : float;
       i : integer;
    begin
      FindISect:=nil;
      oT:=INF;
      for i := 1 to ObjectCount do
       begin
         Cur := Objects^[i]^.ISect(@aRay);
         if (Cur < oT) and (Cur > EPS) and (Cur < MaxDeep) then
          begin
            FindISect := Objects^[i];
            oT := Cur;
          end;
       end;
    end;{TGATrace.FindISect}
    Destructor TTracer.Done;
    var
     i : word;
    begin
      for i := 1 to ObjectCount do Dispose(Objects^[i],Done);
      for i := 1 to LightCount do Dispose(Lights^[i],Done);
      for i := 1 to TextureCount do Dispose(Textures^[i],Done);
      Dispose(Objects);
      Dispose(Lights);
      Dispose(Textures);
    end;
{----------------------------------------------------}
Procedure SetRotate(Pivot,Axis:tVec;Ang:float;var ob : PObject);
var
  p_inv : tVec;
  TR,tr2 : TTRANSFORM;
begin
  if ob = nil then exit;
  if Pos('_SURF_',ob^.OType) = 0 then exit;

  VLinear(p_inv,pivot,pivot,0,-1);
  Compute_Translation_Transform(TR,p_inv);

  Compute_Axis_Rotation_Transform(TR2,axis,ang*M_PI_180);
  Compose_Transforms(tr,tr2);

  Compute_Translation_Transform(TR2,pivot);
  Compose_Transforms(tr,tr2);

  PSurfObj(ob)^.Transform(tr);
end;{LoadRotate}
{----------------------------------------------------}
Procedure SetTranslate(v:tVec;var ob : PObject);
var
  TR   : TTRANSFORM;
begin
  if ob = nil then exit;
  if Pos('_SURF_',ob^.OType) = 0 then exit;
  Compute_Translation_Transform(TR,v);
  PSurfObj(ob)^.Transform(tr);
end;{LoadTranslate}
{----------------------------------------------------}
Procedure SetScale(Pivot, V : tVec;var ob : PObject);
var
  p_inv : tVec;
  TR,tr2  : TTRANSFORM;

begin
  if ob = nil then exit;
  if Pos('_SURF_',ob^.OType) = 0 then exit;

  VLinear(p_inv,pivot,pivot,0,-1);

  Compute_Translation_Transform(TR,p_inv);
  Compute_Scaling_Transform(TR2,v);
  Compose_Transforms(tr,tr2);

  Compute_Translation_Transform(TR2,pivot);
  Compose_Transforms(tr,tr2);

  PSurfObj(ob)^.Transform(tr);
end;{LoadScale}
{----------------------------------------------------}

END.