old/PAS/RayTracing/OBJECTS.PAS

Unit Objects;
Interface
{$DEFINE Bilinear}
Uses Matrices,UVector,GTypes;
TYPE
{-----------  [OBJECTS]  --------------}
  PObject = ^TObject;
  TObject = object
    Pos  : tVec;
    ID   : ObjID;
    OType : string;
    Constructor Init;
    Function  ISect(aRay : PRay):float;virtual;
    Procedure GetNormal(var Norm:TVec;aPos : TVec);virtual;
    Destructor Done;virtual;
  end;


  PFileObj = ^TFileObj;
  TFileObj = object (TObject)
   Constructor Init;
   Constructor Load(var F:FILE);
   Procedure   Save(var F:FILE);virtual;
  end;

  PColObj = ^TColObj;
  TColObj = object (TFileObj)
    Color : RGB;
    Constructor Init;
  end;

  PSurfObj = ^TSurfObj;
  TSurfObj = object (TColObj)
    Surface     : PSurfDesc;
    Texture     : PTexture;
    TexTrans    : TTransform;
    Procedure   SetSurf(aKd,aKs,aNs:float);
    Constructor Init;
    Destructor  Done;virtual;
    Procedure   Transform(tr:TTRANSFORM);virtual;
    Procedure   SetTexture(aPT:PTexture;aR,aLen:real);virtual;
    Procedure   GetColor(var aC : RGB;aV:tVec);virtual;
  end;

  CONE_INTER_TYPE = (SIDE_HIT,BASE_HIT,CAP_HIT);
  tConeInters = array [0..3] of record
   d  : float;
   t  : CONE_INTER_TYPE;
  end;
  PCone   = ^TCone;
  TCone   = object (TSurfObj)
    trans,pt               : TTRANSFORM;
    apex,base              : tVec;
    apex_rad,base_rad,dist : float;
    FlagCyl                : boolean;
    LastInter              : CONE_INTER_TYPE;
    Constructor Init(aApex,aBase:tVec;aBaseRad,aApexRad : float; aCol:RGB);
    Constructor Load(var F:FILE);
    Procedure   Save(var F:FILE);virtual;
    Procedure   Transform(tr:TTRANSFORM);virtual;
    Function    ISect(aRay : PRay):float;virtual;
    Function    Inside(aP:tVec):boolean;
    Procedure   GetNormal(var Norm:TVec;aPos : TVec);virtual;
   private
    Procedure   ComputeConeData;
    Procedure   ComputeCylData;
    Function    ISectCone(aRay:tRay;var aI:tConeInters):INTEGER;
  end;

  PSphere = ^TSphere;
  TSphere = object (TSurfObj)
    Radius : float;
    Constructor Init(ax,ay,az,arad : float; aCol:RGB);
    Constructor Load(var F:FILE);
    Procedure   Save(var F:FILE);virtual;
    Procedure   Transform(tr:TTRANSFORM);virtual;
    Function    ISect(aRay : PRay):float;virtual;
    Function    Inside(aP:tVec):boolean;
    Procedure   GetNormal(var Norm:TVec;aPos : TVec);virtual;
  end;

  PSurfPlane = ^TSurfPlane;
  TSurfPLane = object (TSurfObj)
    Pl : TPlane;
    Procedure   Transform(tr:TTRANSFORM);virtual;
    Constructor Init(av1,av2,av3 : tVec; aCol:RGB);
    Constructor Load(var F:FILE);
    Constructor TriLoad(var F:FILE);
    Procedure   Save(var F:FILE);virtual;
    Function    ISect(aRay:PRay):float;virtual;
    Function    Inside(aP:tVec):boolean;
    Procedure   SetTexture(aPT:PTexture;aR,aLen:real);virtual;
    Procedure   GetNormal(var Norm:TVec; aPos:TVec);virtual;
  end;


  PTriangle = ^TTriangle;
  TTriangle = object (TSurfObj)
    v1, v2, v3 : tVec;
    pl         : TPlane;
    Constructor Init(av1,av2,av3 : tVec; aCol:RGB);
    Constructor Load(var F:FILE);
    Procedure   Save(var F:FILE);virtual;
    Procedure   Transform(tr:TTRANSFORM);virtual;
    Function    ISect(aRay:PRay):float;virtual;
    Procedure   GetNormal(var Norm:TVec; aPos:TVec);virtual;
    Procedure   SetTexture(aPT:PTexture;aR,aLen:real);virtual;
  end;

  PQuad = ^TQuad;
  TQuad = object (TSurfObj)
    v1, v2, v3, v4 : tVec;
    pl             : TPlane;
    Constructor Init(av1,av2,av3,aV4 : tVec; aCol:RGB);
    Procedure   Transform(tr:TTRANSFORM);virtual;
    Constructor Load(var F:FILE);
    Procedure   Save(var F:FILE);virtual;
    Function    ISect(aRay:PRay):float;virtual;
    Procedure   GetNormal(var Norm:TVec; aPos:TVec);virtual;
    Procedure   SetTexture(aPT:PTexture;aR,aLen:real);virtual;
  end;

  PInterS = ^TInterS;
  TInterS = object (TSurfObj)
    Sp    : PSphere;
    Pl    : PSurfPlane;
    Inv   : float;
    Constructor Load(var F:FILE);
    Procedure   Save(var F:FILE);virtual;
    Function    ISect(aRay:PRay):float;virtual;
    Procedure   GetNormal(var Norm:TVec; aPos:TVec);virtual;
    Procedure   Transform(tr:TTRANSFORM);virtual;
  end;

{-------------  [LIGHT]  -----------------}
  PLight = ^TLight;
  TLight = object (TFileObj)
    Constructor Init;
  end;
  POmni = ^TOmni;
  TOmni = object (TLight)
    Color : RGB;
    Constructor Load(var F:FILE);
    Procedure   Save(var F:FILE);virtual;
    Constructor Init(ax,ay,az:float;aCol:RGB);
  end;

  PSpot = ^TSpot;
  TSpot = object (TLight)
    Target : tVec;
    FOV    : float;
    Color  : RGB;
    Constructor Load(var F:FILE);
    Procedure   Save(var F:FILE);virtual;
    Constructor Init(ax,ay,az,axo,ayo,azo,aFov:float;aCol:RGB);
  end;

IMPLEMENTATION
{TObject}
  Constructor TObject.Init;
  begin
    Pos := ZeroVec;
    OType := 'OBJ';
  end;{TObject.Init}
  Function  TObject.ISect;
  begin
    ISect := INF;
  end;{TObject.ISect}
  Procedure TObject.GetNormal;
  begin
  end;{TObject.GetNormal}
  Destructor TObject.Done;
  begin
  end;{TObject.Done}
{TFileObject}
  Constructor TFileObj.Init;
  begin
   Inherited Init;
   ID := F_NULL;
   OType:=OType+'_FILE';
  end;
   Constructor TFileObj.Load(var F:FILE);
   begin
   end;
   Procedure   TFileObj.Save(var F:FILE);
   begin;
   end;
{TColObj}
  Constructor TColObj.Init;
  begin
    Inherited Init;
    OType := OType + '_COL';
  end;
{TSurfObj}
  Constructor TSurfObj.Init;
  begin
    Inherited Init;
    Texture := Nil;
    OType := OType+'_SURF';
    New(Surface);
    With Surface^ do begin
      Ks := 0; Kd := 0; Ns := 0;
    end;
  end;
  Procedure TSurfObj.SetSurf(aKd,aKs,aNs:float);
  begin
    with Surface^ do begin
      Ks := aKs; Kd := aKd; Ns := aNs;
    end;
  end;
  Procedure TSurfObj.GetColor;
  var
   v2:tVec;
   sx,sy,x,y : word;
   fx,fy          : float;
   cc,cc1,cc2,cc3 : BRGB;
   A,B            : RGB;
  begin
    if Texture = nil then
     begin
       aC := Color;
     end
    else
     begin
      MInvTransPoint(v2,av,TexTrans);
      sx := Texture^.SizeX; sy:=Texture^.SizeY;
      while v2.X < 0 do v2.X := v2.X + SX;
      while v2.Y < 0 do v2.Y := v2.Y + SY;
     {$IFNDEF Bilinear}
      x:=round(v2.X);y:=round(v2.Y);
      CC := Texture^.Bits^[(SY-1-(Y mod SY)) * SX + (X mod SX)];
      aC.R := cc.R / 255 * Color.R;
      aC.G := cc.G / 255 * Color.G;
      aC.B := cc.B / 255 * Color.B;
     {$ELSE}
      fx  := frac(v2.X);fy:=frac(v2.y);x:=trunc(v2.X);y:=trunc(v2.Y);
      CC  := Texture^.Bits^[(SY-1-(Y mod SY)) * SX + (X mod SX)];
      CC1 := Texture^.Bits^[(SY-1-(Y mod SY)) * SX + ((X+1) mod SX)];
      CC2 := Texture^.Bits^[(SY-1-((Y+1) mod SY)) * SX + (X mod SX)];
      CC3 := Texture^.Bits^[(SY-1-((Y+1) mod SY)) * SX + ((X+1) mod SX)];
      A.R := (CC.R + (CC2.R-CC.R)*fy)/255;
      A.G := (CC.G + (CC2.G-CC.G)*fy)/255;
      A.B := (CC.B + (CC2.B-CC.B)*fy)/255;
      B.R := (CC1.R + (CC3.R-CC1.R)*fy)/255;
      B.G := (CC1.G + (CC3.G-CC1.G)*fy)/255;
      B.B := (CC1.B + (CC3.B-CC1.B)*fy)/255;
      aC.R := (A.R + (B.R-A.R)*fx)*Color.R;
      aC.G := (A.G + (B.G-A.G)*fx)*Color.G;
      aC.B := (A.B + (B.B-A.B)*fx)*Color.B;
     {$ENDIF}
     end;
  end;
  Procedure TSurfObj.Transform;
  begin
    MTransPoint(Pos,Pos,tr);
    Compose_Transforms(TexTrans,tr);
  end;
  Procedure TSurfObj.SetTexture;
  begin
    Texture := aPT;
  end;
  Destructor TSurfObj.Done;
  begin
    Dispose(Surface);
    Inherited Done;
  end;
{-------------------------------------------------------------}
{-------------------------------------------------------------}
{--------------------- REAL OBJECTS --------------------------}
{-------------------------------------------------------------}
{-------------------------------------------------------------}
{TCone}
  Constructor TCone.Init;
  begin
    Inherited Init;
    OType := OType + '_CONE';
    ID := F_CONE;
    Apex := aApex;Base:=aBase;
    Apex_Rad := aApexRad;Base_Rad:=aBaseRad;
    Color := aCol;
    ComputeConeData;
  end;
  Constructor TCone.Load;
  begin
    Inherited Init;
    OType := OType + '_CONE';
    ID := F_CONE;
    BlockRead(F,Apex,vecsize);
    BlockRead(F,Base,vecsize);
    BlockRead(F,Apex_Rad,sizeof(float));
    BlockRead(F,Base_Rad,sizeof(float));
    LoadRGB(F,Color);
    BlockRead(F,Surface^,vecsize);
    ComputeConeData;
  end;
  Procedure  TCone.Save;
  begin
    BlockWrite(F,ID,1);
    BlockWrite(F,Apex,vecsize);
    BlockWrite(F,Base,vecsize);
    BlockWrite(F,Apex_Rad,sizeof(float));
    BlockWrite(F,Base_Rad,sizeof(float));
    SaveRGB(F,Color);
    BlockWrite(F,Surface^,vecsize);
  end;
  Procedure  TCone.ComputeConeData;
  var
   tlen,len,tmpf:float;
   axis,tmpv,origin:tVec;
  begin
    if abs(Apex_Rad-Base_Rad)<EPS then
     begin  FlagCyl := true; ComputeCylData; exit;
     end;
    FlagCyl := False;
    if Apex_rad < Base_Rad then
     begin
      tmpv := Apex;tmpf:=Apex_rad;
      Apex := Base;Apex_Rad:=Base_Rad;
      Base := tmpv;Base_Rad:=tmpf;
     end;
    VLinear(axis,Apex,Base,1,-1);
    len := VLength(axis);
    if len < EPS then
     begin WriteLn('Sucked cone!');Halt(101);end
    else VNorm(Axis,1);
    tmpf := Base_Rad*Len / (Apex_Rad-Base_Rad);
    VLinear(Origin,Axis,axis,tmpf,0);
    VLinear(Origin,Base,Origin,1,-1);
    tlen := tmpf + len;
    Dist := tmpf /tlen;
    Compute_Coordinate_Transform(Trans,origin,axis,Apex_Rad,tLen);
  end;{ComputeConeData}
  Procedure  TCone.ComputeCylData;
  var
   tmpf:float;
   tr2:TTRANSFORM;
   ax2:tVec;
   axis:tVec;
  begin
    VLinear(axis,Apex,Base,1,-1);
    tmpf:=VLength(axis);
    if tmpf<EPS then
     begin WriteLn('Sucked cylinder!');Halt(101);end;
    VNorm(Axis,1);
    Compute_Coordinate_Transform(Trans,Base,axis,Apex_Rad,tmpf);
    Dist:=0.0;
  end;
  Procedure TCone.Transform;
  begin
    Compose_TransForms(trans,tr);
  end;
  Function TCone.ISect;
  var
   i,count  : integer;
   IS : tConeInters;
   min : integer;
  begin
    ISect:=INF;
    count := ISectCone(aRay^,IS);
    if count = 0 then exit;
    min := 0;
    for i := 1 to count-1 do if abs(IS[i].d) < abs(IS[min].d) then min:=i;
    ISect := IS[min].d;
    LastInter:=IS[MIN].t;
  end;
  function TCone.ISectCone;
  var
   i : integer;
   a,b,c,z,t1,t2,len:float;
   d,tmpf:float;
   P,Dir : tVec;
  begin
   i:=0;
   MInvTransPoint(P,aRay.Org,trans);
   MInvTransDirection(Dir,aRay.Dir,trans);
   len := VLength(Dir);
   VNorm(Dir,1);
   if FlagCyl then
    begin {Calculate cylinder equations}
     a := dir.x*dir.x+dir.y*dir.y;
     if a > EPS then begin
       b := p.x*dir.x+p.y*dir.y;
       c := p.x*p.x+p.y*p.y-1;
       d := b*b-a*c;
       if d >= 0 then
        begin
         d := sqrt(d);
         t1 := (-b+d)/a;
         t2 := (-b-d)/a;
         z := p.z + t1*dir.z;
         if (Z>=0) and (z<=1) and (t1>=0) then
          begin
            aI[i].d:=t1/len;
            aI[i].t:=SIDE_HIT;
            inc(i);
          end;
         z := p.z + t2*dir.z;
         if (Z>=0) and (z<=1) and (t2>=0) then
          begin
            aI[i].d:=t2/len;
            aI[i].t:=SIDE_HIT;
            inc(i);
          end;
        end;
     end;
    end
   else {Solve cone intersections}
    begin
     a:=dir.x*dir.x+dir.y*dir.y-dir.z*dir.z;
     b:=dir.x*p.x+dir.y*p.y-dir.z*p.z;
     c:=p.x*p.x+p.y*p.y-p.z*p.z;
     if abs(a) < EPS then
      begin
        if abs(b) > EPS then
         begin
          t1 := 0.5*c/b;
          z := p.z + t1*dir.z;
          if (t1>=0) and (z>=Dist) and (Z<=1) then
           begin
            aI[i].d:=t1/len;
            aI[i].t:=SIDE_HIT;
            inc(i);
           end;
         end;
      end
     else
      begin
        d := b*b-a*c;
        if d>=0 then
        begin
         d:=sqrt(d);
         t1 := (-b+d)/a;
         t2 := (-b-d)/a;
         z := p.z + t1*dir.z;
         if (Z>=Dist) and (z<=1) and (t1>=0) then
          begin
            aI[i].d:=t1/len;
            aI[i].t:=SIDE_HIT;
            inc(i);
          end;
         z := p.z + t2*dir.z;
         if (Z>=Dist) and (z<=1) and (t2>=0) then
          begin
            aI[i].d:=t2/len;
            aI[i].t:=SIDE_HIT;
            inc(i);
          end;
        end;
      end;
    end;
    if abs(Dir.Z) > EPS then
     begin
      d:=(1-p.z)/dir.z;
      a:=p.x+d*dir.x;
      b:=p.y+d*dir.y;
      if  ((sqr(a)+sqr(b)) <= 1) and (D>=0) then
       begin
        aI[i].d:=d/len;
        aI[i].t:=CAP_HIT;
        inc(i);
       end;
      d := (Dist - p.z)/dir.z;
      a := p.x+d*dir.x;
      b := p.y+d*dir.y;
      if FlagCyl then tmpf:=1 else tmpf := sqr(Dist);
      if  ((sqr(a)+sqr(b)) <= tmpf) and (D>=0) then
       begin
        aI[i].d:=d/len;
        aI[i].t:=BASE_HIT;
       end;
     end;
    ISectCone:=i;
  end; {ISectCone}
  Procedure   TCone.GetNormal;
  begin
    MInvTransPoint(Norm,aPos,Trans);
    case LastInter of
      SIDE_HIT: if FlagCyl then Norm.z := 0
                 else Norm.Z := -Norm.Z;
      BASE_HIT: VSet(Norm,0,0,-1);
      CAP_HIT:  VSet(Norm,0,0,1);
    end;
    MTransNormal(Norm,Norm,Trans);
    VNorm(Norm,1);
  end;
  Function TCone.Inside;
  var
   NP : tVec;
   w2,z2:float;
  begin
   MInvTransPoint(NP,aP,Trans);
   w2 := NP.x*NP.x +NP.y*NP.y;
   if FlagCyl then
    begin
      if (w2 > 1+EPS) or (NP.Z<0-EPS) or (NP.Z > 1 + EPS) then
       begin Inside := false;exit;end
      else
       begin Inside := true;exit;end;
    end
   else
    begin
     z2 := np.z*np.z;
      if (w2 > z2+EPS) or (NP.Z<Dist-EPS) or (NP.Z > 1 + EPS) then
       begin Inside := false;exit;end
      else
       begin Inside := true;exit;end;
    end;
  end;
{TSphere}
  Constructor TSphere.Init(ax,ay,az,arad : float; aCol:RGB);
  begin
    Inherited Init;
    OType := OType + '_SPHERE';
    ID := F_OBJ_SPHERE;
    VSet(Pos,ax,ay,az);
    Radius := aRad;
    Color := aCol;
  end;{TSphere.Init}
  Procedure TSphere.Transform;
  var
   vr : tVec;
  begin
    vr := Pos;
    vr.Y := vr.Y + radius;
    Inherited Transform(tr);
    MTransPoint(vr,vr,tr);
    VLinear(vr,vr,Pos,1,-1);
    Radius := sqrt(VDot(vr,vr));
  end;
  Procedure TSphere.Save;
  begin
    BlockWrite(F,ID,sizeof(ObjID));
    BlockWrite(F,Pos,sizeof(float)*3);
    BlockWrite(F,Radius,sizeof(float));
    SaveRGB(F,Color);
    BlockWrite(F,Surface^,vecsize);
  end;
  Constructor TSphere.Load;
  begin
    Inherited Init;
    OType := OType + '_SPHERE';
    ID := F_OBJ_SPHERE;
    BlockRead(F,Pos,sizeof(float)*3);
    BlockRead(F,Radius,sizeof(float));
    LoadRGB(F,Color);
    BlockRead(F,Surface^,vecsize);
  end;
  Function TSphere.ISect(aRay : PRay):float;
  var
    a,b,c,d,t1,t2 : float;
    tmp : tvec;
  begin
    ISect := INF;
    a := VDot(aRay^.Dir,aRay^.Dir);
    VLinear(tmp,aRay^.Org,Pos,1,-1);
    b := 2*VDot(aRay^.Dir,tmp);
    c := VDot(tmp,tmp) - Radius*Radius;
    d := b*b-4*a*c;
    if d < 0 then exit;
    d := sqrt(d);
    t1 := (-b-d) / (2*a);
    t2 := (-b+d) / (2*a);
    if t2 < 0 then Exit;
    if t1 > 0 then ISect:=t1 else Isect:=t2;
  end;{TSphere.ISect}
  Function TSphere.Inside;
  begin
    VLinear(aP,aP,Pos,1,-1);
    Inside := VDot(aP,aP) <= Radius*Radius;
  end;
  Procedure TSphere.GetNormal(var Norm:TVec;aPos : TVec);
  begin
    VLinear(Norm,aPos,Pos,1,-1);
    VNorm(Norm,1);
  end;{TSphere.GetNormal}
{TTRiangle}
  Constructor TTriangle.Init;
  begin
   Inherited Init;
   OType := OType + '_TRI';
   ID := F_TRI;
   v1 := aV1;
   v2 := aV2;
   v3 := aV3;
   SetPlane(Pl,v1,v2,v3);
   Color := aCol;
  end;
  Procedure TTriangle.Transform;
  begin
    Inherited Transform(tr);
    MTransPoint(v1,v1,tr);
    MTransPoint(v2,v2,tr);
    MTransPoint(v3,v3,tr);
    SetPlane(Pl,v1,v2,v3);
  end;
  Procedure  TTriangle.SetTexture(aPT:PTexture;aR,aLen:real);
  begin
    Inherited SetTexture(aPT,aR,aLen);
    CalcTransform(TexTrans,V1,V2,V3,aR,aLen);
  end;
  Procedure  TTriangle.GetNormal;
  begin
    Norm := Pl.N;
  end;
  Function  TTriangle.ISect;
  var
   del, delit : float;
   P : tVec;
   p1,p2,p3 : TPlane;
  begin
    del := -(VDot(Pl.N,aRay^.Org)+Pl.D);
    delit := VDot(Pl.N,aRay^.Dir);
    if abs(del)<EPS then DEL := +0;
    if (abs(delit) < EPS) or (del*delit<0) then exit;
    VLinear(P,aRay^.Org,aRay^.Dir,1,del/delit);
    SetPlane(p1,v1,aRay^.Org,v2);
    SetPlane(p2,v2,aRay^.Org,v3);
    SetPlane(p3,v3,aRay^.Org,v1);

    ISect := del/delit;
    if (
        (VDot(p1.N,p)>-p1.D) and (VDot(p2.N,p)>-p2.D) and (VDot(p3.N,p)>-p3.D)
       ) or
       (
        (VDot(p1.N,p)<-p1.D) and (VDot(p2.N,p)<-p2.D) and (VDot(p3.N,p)<-p3.D)
       )
       then Exit;
    ISect := INF;
  end;
  Constructor TTriangle.Load;
  begin
    BlockRead(F,v1,vecsize);
    BlockRead(F,v2,vecsize);
    BlockRead(F,v3,vecsize);
    LoadRGB(F,Color);
    Init(v1,v2,v3,Color);
    BlockRead(F,Surface^,vecsize);
  end;
  Procedure TTriangle.Save;
  begin
    BlockWrite(F,ID,1);
    BlockWrite(F,v1,vecsize);
    BlockWrite(F,v2,vecsize);
    BlockWrite(F,v3,vecsize);
    SaveRGB(F,Color);
    BlockWrite(F,Surface^,vecsize);
  end;
{TQuad}
  Constructor TQuad.Init;
  begin
   Inherited Init;
   OType := OType + '_Quad';
   ID := F_QUAD;
   v1 := aV1;
   v2 := aV2;
   v3 := aV3;
   v4 := aV4;
   SetPlane(Pl,v1,v2,v3);
   Color := aCol;
  end;
  Procedure  TQuad.SetTexture(aPT:PTexture;aR,aLen:real);
  begin
    Inherited SetTexture(aPT,aR,aLen);
    CalcTransform(TexTrans,V1,V2,V3,aR,aLen);
  end;
  Procedure  TQuad.Transform;
  begin
    Inherited Transform(tr);
    MTransPoint(v1,v1,tr);
    MTransPoint(v2,v2,tr);
    MTransPoint(v3,v3,tr);
    MTransPoint(v4,v4,tr);
    SetPlane(Pl,v1,v2,v3);
  end;
  Procedure  TQuad.GetNormal;
  begin
    Norm := Pl.N;
  end;
  Function  TQuad.ISect;
  var
   del, delit : float;
   P : tVec;
   p1,p2,p3,p4 : TPlane;
  begin
    del := -(VDot(Pl.N,aRay^.Org)+Pl.D);
    delit := VDot(Pl.N,aRay^.Dir);
    if (abs(delit) < EPS) or (del*delit<0) then exit;
    ISect := del/delit;
    VLinear(P,aRay^.Org,aRay^.Dir,1,del/delit);
    SetPlane(p1,v1,aRay^.Org,v2);
    SetPlane(p2,v2,aRay^.Org,v3);
    SetPlane(p3,v3,aRay^.Org,v4);
    SetPlane(p4,v4,aRay^.Org,v1);
    if ((VDot(p1.N,p)>-p1.D) and (VDot(p2.N,p)>-p2.D) and (VDot(p3.N,p)>-p3.D) and (VDot(p4.N,p)>-p4.D))
       or ((VDot(p1.N,p)<-p1.D) and (VDot(p2.N,p)<-p2.D) and (VDot(p3.N,p)<-p3.D) and (VDot(p4.N,p)<-p4.D))
         then Exit;
    ISect := INF;
  end;
  Constructor TQuad.Load;
  begin
    BlockRead(F,v1,vecsize);
    BlockRead(F,v2,vecsize);
    BlockRead(F,v3,vecsize);
    BlockRead(F,v4,vecsize);
    LoadRGB(F,Color);
    Init(v1,v2,v3,v4,Color);
    BlockRead(F,Surface^,vecsize);
  end;
  Procedure TQuad.Save;
  begin
    BlockWrite(F,ID,1);
    BlockWrite(F,v1,vecsize);
    BlockWrite(F,v2,vecsize);
    BlockWrite(F,v3,vecsize);
    BlockWrite(F,v4,vecsize);
    SaveRGB(F,Color);
    BlockWrite(F,Surface^,vecsize);
  end;
{TSurfPlane}
  Constructor TSurfPlane.Init;
  begin
   Inherited Init;
   OType := OType + '_PLANE';
   ID := F_OBJ_SURF_PLANE;
   SetPlane(Pl,aV1,AV2,aV3);
   Color := aCol;
  end;{TSurfPlane.Init}
  Procedure TSurfPlane.Transform;
  var
   v1:tVec;
  begin
   if Pl.N.Y <> 0 then
    VSet(v1,0,-Pl.D/Pl.N.Y,0)
   else
   if Pl.N.Z <> 0 then
    VSet(v1,0,0,-Pl.D/Pl.N.Z)
   else VSet(v1,-Pl.D/Pl.N.X,0,0);
   MTransPoint(v1,v1,tr);
   MTransDirection(Pl.N,Pl.N,tr);
   Pl.D := -VDot(PL.N,v1);
  end;
  Procedure TSurfPlane.Save;
  begin
    BlockWrite(F,ID,1);
    BlockWrite(F,Pl.N,vecsize);
    BlockWrite(F,Pl.D,sizeof(float));
    SaveRGB(F,Color);
    BlockWrite(F,Surface^,vecsize);
  end;{TFilePlane.Save}
  Constructor TSurfPlane.Load;
  begin
    Inherited Init;
    ID := F_OBJ_SURF_PLANE;
    OType := OType+ '_PLANE';
    BlockRead(F,Pl.N,vecsize);
    BlockRead(F,Pl.D,sizeof(float));
    LoadRGB(F,Color);
    BlockRead(F,Surface^,vecsize);
  end;{TSurfPlane.Load}
  Constructor TSurfPlane.TriLoad;
  var
   v1,v2,v3 : tVec;
   ac       : RGB;
  begin
    BlockRead(F,v1,vecsize);
    BlockRead(F,v2,vecsize);
    BlockRead(F,v3,vecsize);
    LoadRGB(F,aC);
    Init(v1,v2,v3,aC);
    BlockRead(F,Surface^,vecsize);
  end;
  Function   TSurfPlane.Inside;
  begin
    Inside := abs(VDot(Pl.N,aP)+Pl.D) < EPS;
  end;
  Procedure  TSurfPlane.SetTexture(aPT:PTexture;aR,aLen:real);
  var
   v1,v2,v3 : tVec;
  begin
    Inherited SetTexture(aPT,aR,aLen);
    if Pl.N.Y <> 0 then
     VSet(v1,0,-Pl.D/Pl.N.Y,0)
    else
    if Pl.N.Z <> 0 then
     VSet(v1,0,0,-Pl.D/Pl.N.Z)
    else VSet(v1,-Pl.D/Pl.N.X,0,0);
    Compute_Coordinate_Transform(TexTrans,V1,Pl.N,aR,aLen);
  end;
  Function TSurfPlane.ISect;
  var
   del, delit : float;
  begin
    ISect := INF;
    del := -(VDot(Pl.N,aRay^.Org)+Pl.D);
    delit := VDot(Pl.N,aRay^.Dir);
    if (abs(delit) < EPS) or (del*delit<0) then exit;
    ISect := del/delit;
  end;{TSurfPlane.ISect}
  Procedure TSurfPlane.GetNormal;
  begin
    Norm := Pl.N;
  end;{TSurfPlane.GetNormal}
{----------------------}
{TInterS}
  Constructor TInterS.Load;
  var
   m_ID : OBjID;
  begin
    Inherited Init;
    ID := F_INTER_SPHERE;
    OType := OType+ '_INTERSPHERE';
    BlockRead(F,Inv,sizeof(float));
    LoadRGB(F,Color);
    BlockRead(F,Surface^,vecsize);
    BlockRead(F,m_ID,1);
    if m_ID = F_OBJ_SPHERE then
     begin
       New(Sp,Load(F));
       BlockRead(F,m_ID,1);
       if m_ID = F_TRI_PLANE then New(Pl,TriLoad(F))
       else New(Pl,Load(F))
     end
    else
     begin
       if m_ID = F_TRI_PLANE then New(Pl,TriLoad(F))
       else New(Pl,Load(F));
       BlockRead(F,m_ID,1);
       New(Sp,Load(F));
     end;
  end;{TInterS.Load}
{-=-=-=-=-=-=-=-=-=-=-=-}
  Procedure TInterS.Save;
  begin
    BlockWrite(F,ID,1);
    BlockWrite(F,Inv,sizeof(float));
    SaveRGB(F,Color);
    BlockWrite(F,Surface^,vecsize);
    Sp^.Save(F);
    Pl^.Save(F);
  end;{TInterS.Save}
{-=-=-=-=-=-=-=-=-=-=-=-}
  Function TInterS.ISect;
  var
   T : float;
   P : tVec;
  begin
    ISect:=INF;
    T := Sp^.ISect(aRay);
    if abs(T-INF) < EPS then
      exit;
    aRay^.GetPoint(P,T);
    if (VDot(PL^.Pl.N,P)+PL^.Pl.D)*Inv >= 0 then
     ISect := T
    else
     begin
      T := Pl^.ISect(aRay);
      aRay^.GetPoint(P,T);
      if Sp^.Inside(P) then ISect := T;
     end;
  end;
{-=-=-=-=-=-=-=-=-=-=-=-}
  Procedure TInterS.GetNormal;
  begin
    if Not Pl^.Inside(aPos) then
     Sp^.GetNormal(Norm,aPos)
    else
    if Inv > 0 then
     VLinear(Norm,Pl^.Pl.N,Pl^.Pl.N,0,-1)
    else
     Norm := Pl^.Pl.N;
  end;
{-=-=-=-=-=-=-=-=-=-=-=-}
  Procedure TInterS.Transform;
  begin
    Sp^.Transform(tr);
    Pl^.Transform(tr);
  end;
{----------------------  LIGHTS -----------------------}
{TLight}
  Constructor TLight.Init;
  begin
    Inherited Init;
    OType := OType + '_LIGHT';
  end;
{TOmni}
  Constructor TOmni.Init;
  begin
    Inherited Init;
    OType := Otype + '_OMNI';
    ID := F_LIGHT_OMNI;
    VSet(Pos,ax,ay,az);
    Color := aCol;
  end;
  Constructor TOmni.Load;
  begin
    Inherited Init;
    ID := F_LIGHT_OMNI;
    OType := Otype + '_OMNI';
    BlockRead(F,Pos,sizeof(float)*3);
    LoadRGB(F,Color);
  end;
  Procedure TOmni.Save;
  begin
    BlockWrite(F,ID,SizeOf(OBjID));
    BlockWrite(F,Pos,sizeof(float)*3);
    SaveRGB(F,Color);
  end;
{---------------------}
{TSpot}
  Constructor TSpot.Init;
  begin
    Inherited Init;
    OType := Otype + '_SPOT';
    ID := F_SPOTLIGHT;
    FOV := aFov;
    VSet(Target,ax,ay,az);
    VSet(Pos,axo,ayo,azo);
    Color := aCol;
  end;
  Constructor TSpot.Load;
  begin
    Inherited Init;
    ID := F_LIGHT_OMNI;
    OType := Otype + '_SPOT';
    BlockRead(F,Pos,sizeof(float)*3);
    BlockRead(F,Target,sizeof(float)*3);
    BlockRead(F,FOV,sizeof(float));
    LoadRGB(F,Color);
  end;
  Procedure TSpot.Save;
  begin
    BlockWrite(F,ID,SizeOf(OBjID));
    BlockWrite(F,Pos,sizeof(float)*3);
    BlockWrite(F,Target,sizeof(float)*3);
    BlockWrite(F,FOV,sizeof(float));
    SaveRGB(F,Color);
  end;
END.