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 [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