Code:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
public
end ;
type
{ TD3D }
TD3D = class
public
x , y , z : double ;
constructor create() ;
constructor create( a , b , c : double ) ;
end ;
operator +( a , b : TD3D ) : TD3D ;
operator -( a , b : TD3D ) : TD3D ;
operator /( a : TD3D ; d : double ) : TD3D ;
operator *( a : TD3D ; d : double ) : TD3D ;
function normalize( a : TD3D ) : TD3D ;
function toColor( a : TD3D ) : TColor ;
function dot( a , b : TD3D ) : double ;
function lenght( a : TD3D) : double ;
function getangle( a , b : TD3D ) : double ;
function cross( a , b : TD3D ) : TD3D ;
type
TMaterial = class
public
diffuse : TD3D ;
reflection : double ;
end ;
type
{ TSphere }
TSphere = class
public
center : TD3D ;
radius , radius2 : double ;
mat : TMaterial ;
function hit( o , d : TD3D ) : double ;
end ;
var
Form1: TForm1 ;
infinity : double = 1e9 ;
spheres : array[ 0 .. 200 ] of TSphere ;
spheretel : integer ;
material : TMaterial ;
implementation
{$R *.lfm}
procedure sphere( x , y , z , r : double ) ;
begin
spheres[ spheretel ].center := TD3D.create( x , y , z ) ;
spheres[ spheretel ].radius := r ;
spheres[ spheretel ].radius2 := r * r ;
spheres[ spheretel ].mat := material ;
spheretel := spheretel + 1 ;
end ;
function render( o , d : TD3D ; dept : integer ) : TD3D ;
var
lowdist , dist , angle : double ;
i : integer ;
isph : integer ;
p , n , kl : TD3D ;
begin
lowdist := infinity ;
isph := -1 ;
for i := 0 to spheretel do
begin
dist := spheres[ i ].hit( o , d ) ;
if dist < lowdist then
begin
lowdist := dist ;
isph := i ;
end ;
end ;
if isph = -1 then result := TD3D.create ;
p := o + normalize( d ) * lowdist ;
n := p - spheres[ isph ].center ;
kl := spheres[ isph ].mat.diffuse ;
angle := getangle( normalize( n ) , TD3D.create( -1 , 5 , -1 ) ) ;
kl := kl * ( cos( angle ) / 2 + 0.5 ) ;
result := kl ;
end ;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
x , y : double ;
o , d , kl : TD3D ;
begin
spheretel := 0 ;
material.diffuse := TD3D.create( 1 , 1 , 0 ) ; //yellow
sphere( 0 , 0 , 0 , 50 ) ; //in center
for x := -self.width / 2 to self.width / 2 do
begin
for y := -self.height / 2 to self.height / 2 do
begin
o := TD3D.create( 0 , 0 , -1000 ) ;
d := TD3D.create( x , y , 1000 ) ;
kl := render( o , d , 1 ) ;
canvas.Pen.Color := tocolor( kl ) ;
canvas.Brush.color := tocolor( kl ) ;
canvas.FillRect( x + self.width / 2
, y + self.height / 2
, x + 1 + self.width / 2
, y + 1 + self.height / 2 ) ;
end;
end;
end;
{ TSphere }
function TSphere.hit( o , d : TD3D ) : double ;
var
t , a , b , c , e , demon , disc : double ;
temp : TD3D ;
begin
temp := o - center ;
a := dot( d , d ) ;
b := 2 * dot( temp , d ) ;
c := dot( temp , temp ) - radius2 ;
disc := b * b - 4 * a * c ;
if disc < 0 then
begin
result := infinity ;
else
e := sqr( disc ) ;
demon := 2 * a ;
t := ( -b - e ) / demon ;
if t > 1e-12 then
begin
result := t ;
end ;
t := ( -b + e ) / demon ;
if t > 1e-12 then
begin
result := t ;
end ;
end ;
result := infinity ;
end ;
{ TD3D }
constructor TD3D.create() ;
begin
x = 0 ;
y = 0 ;
z = 0 ;
end ;
constructor TD3D.create( a , b , c : double ) ;
begin
x = a ;
y = b ;
z = c ;
end ;
operator + ( a , b : TD3D ) : TD3D ;
begin
result := TD3D.create( a.x + b.x , a.y + b.y , a.z + b.z ) ;
end;
operator - ( a , b : TD3D ) : TD3D;
begin
result := TD3D.create( a.x - b.x , a.y - b.y , a.z - b.z ) ;
end;
operator / ( a : TD3D ; d : double ) : TD3D ;
begin
result := TD3D.create( a.x / d , a.y / d , a.z / d ) ;
end;
operator * ( a : TD3D ; d: double): TD3D;
begin
result := TD3D.create( a.x * d , a.y * d , a.z * d ) ;
end;
function dot( a , b : TD3D): double;
begin
result := a.x * b.x + a.y * a.y + z * a.z ;
end;
function lenght( a : TD3D ): double;
begin
result := sqr( dot( a , a ) )
end;
function getangle( a , b : TD3D ) : double ;
var
lb , la , d : double ;
begin
d := dot( a , b ) ;
lb := lenght( b ) ;
la := lenght( a ) ;
result := acos( d / ( lb * la ) ) ;
end;
function cross( b , a : TD3D ) : TD3D ;
begin
result := TD3D.create( b.y * a.z - b.z * a.y
, b.z * a.x - b.x * a.z
, b.x * a.y - b.y * a.x ) ;
end;
function nomalize( a : TD3D ) : TD3D ;
begin
result := a / lenght( a ) ;
end;
function toColor( a : TD3D ) : TColor ;
var
r , g , b : integer ;
begin
r := floattoint( a.x * 255 ) ;
g := floattoint( a.y * 255 ) ;
b := floattoint( a.z * 255 ) ;
result := TColor( r + g * 256 + b * 256 * 256 ) ;
end ;
end.
Bookmarks