Uses UVector, ObjTrace, Gtypes,Objects, Dos; CONST CANJITTER = [F_OBJ_SPHERE,F_TRI_PLANE]; IfJitter = TRUE; JitterConst = 0.05; 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; N,P,R : tVec; ReflCol,oC : 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); {NEW 25.06.01} {Added jitter feature} if IfJitter and (oB^.ID in CanJitter) then begin VRandomize(N,JitterConst); VNorm(N,1); end; 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 tmp := Vcos(N,L.Dir) * oB^.Surface^.Kd {New 2 Prev} / VDot(L.Dir,L.Dir); {Делим на квадрат расстояния до источника} CAddMul(aC,Lt^.Color,tmp); VLinear(R,N,L.Dir,-2*VDot(N,L.Dir),1); 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); GetReflPointColor(ReflCol,Refl,Num+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 FillChar(Ray.Org,vecsize,0); FillChar(Ray.Dir,vecsize,0); FillChar(DX,vecsize,0); FillChar(DY,vecsize,0); BlockWrite(outF,ResX,2); BlockWrite(outF,ResY,2); i:=24; BlockWrite(outF,i,2); C := View.LLPos; VLinear(DX,View.Right,View.Right,1/ResX,0); {Расчет вектора прироста по X & Y} VLinear(DY,View.Up, View.Right,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!)} 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; begin randomize; TGA.Init('ballpln.tga'); TGA.Load('ballpln.tra'); { New(aTex,Init(54,64)); aTex^.LoadTGA('Rod.tga'); PTriangle(TGA.Objects^[2])^.SetTexture(aTex,1/5,1/5);} { VSet(v1,-40,100,-130); VSet(v2,0,-10,0); TGA.SetCamera(v1,v2,0,50,1); VSet(v1,0,-30,0); VSet(v2,5,-30,0); VSet(v3,0,-30,5); aC.R:=0.3;aC.G:=0.4;aC.B:=1; New(PTri,Init(v1,v2,v3,aC)); PTri^.SetSurf(0.6,0.9,1); TGA.AddObject(PTri); aC.R:=7000;aC.G:=10000;aC.B:=7000; New(m_gOmni,Init(30,100,-70,aC)); TGA.AddLight(m_gOmni); TGA.Save('new.tra',true); { VSet(v1,-100,2,0); VSet(v2,100,20,0); VSet(v3,0,100,50); aC.R:=0.3;aC.G:=0.4;aC.B:=1; New(PTri,Init(v1,v2,v3,aC)); PTri^.SetSurf(0.6,0.5,1); TGA.AddObject(PTri); } TGA.Trace(500,500); Writeln; TGA.Done; { TGA.Load('cool.tra');} { TGA.Load('planes.tra');} { TGA.Save('cool.tra',true);} end.