% perl ray.pl 100 100
;# datas
$xres = $ARGV[0];
$yres = $ARGV[1];
@eye = (0.0,0.0,4.0);
@sph = (0.0,0.0,0.0,0.7);
@light = &mklight(-1,-1,0.5);
$picname = "perlray.ppm";
;# main program
open(pic,">$picname");
select(pic);
print "P6\n",$xres," ",$yres,"\n",255,"\n";
for($y = 0; $y < $yres; $y++){
for($x = 0; $x < $yres; $x++){
print STDERR $y," ",$x,"\r";
@ray = &mkeye($x,$y,@eye);
$rgb = &scan(@sph,@ray,@eye);
print $rgb;
}
}
close(pic);
sub mklight {
local(@l) = @_;
local(@v) = &mknormalv(@l);
return @v;
}
sub mkeye {
local($x,$y,@eye) = @_;
local($xx,$yy);
$xx = 2.0/$xres*$x - 1.0;
$yy = 2.0/$yres*$y - 1.0;
@target = ($xx,$yy,0.0);
@vec = &vminus(@target,@eye);
@vec = &mknormalv(@vec);
return @vec;
}
sub vminus {
local($v1,$v2,$v3,$vv1,$vv2,$vv3) = @_;
local(@v1) = ($_[0],$_[1],$_[2]);
local(@v2) = ($_[3],$_[4],$_[5]);
return ($v1[0] - $v2[0],$v1[1] - $v2[1],$v1[2] - $v2[2]);
}
sub mknormalv {
local(@v) = @_;
local($len) = sqrt($v[0]*$v[0] + $v[1]*$v[1] + $v[2]*$v[2]);
local($v1) = $v[0] / $len;
local($v2) = $v[1] / $len;
local($v3) = $v[2] / $len;
return ($v1,$v2,$v3);
}
sub scan {
local(@obj) = ($_[0],$_[1],$_[2],$_[3]);
local(@ray) = ($_[4],$_[5],$_[6]);
local(@eye) = ($_[7],$_[8],$_[9]);
local(@rgb,@normalv);
if(&intersect(@obj,@ray,@eye,*normalv) == 1){
$rgb = &shade(@normalv,@light);
}
else{
$rgb = &backcol();
}
return $rgb;
}
sub backcol{
$col = pack('CCC',0,200,200);
return $col;
}
sub intersect {
local(@obj) = ($_[0],$_[1],$_[2]);
local($rad) = $_[3];
local(@ray) = ($_[4],$_[5],$_[6]);
local(@eye) = ($_[7],$_[8],$_[9]);
local(@u) = &vminus(@obj,@eye);
local($b) = -&innerp(@ray,@u);
local($c) = &innerp(@u,@u) - $rad;
local($d) = $b * $b - $c;
if($d < 0.0){
return 0;
}
$s = sqrt($d);
local($t1) = -$b - $s;
local($t2) = -$b + $s;
local($t);
if($t2 < $t1){
$t = $t2;
$t2 = $t1;
$t1 = $t;
}
if($t1 >= 0.0){
$t = $t1;
}
elsif($t1 < 0.0 && $t2 >= 0.0){
$t = $t2;
}
else{
return 0;
}
@normalv = &scalarv($t,@ray);
@normalv = &vminus(@normalv,@u);
@normalv = &mknormalv(@normalv);
return 1;
}
sub innerp {
local(@a) = ($_[0],$_[1],$_[2]);
local(@b) = ($_[3],$_[4],$_[5]);
return $a[0] * $b[0] + $a[1] * $b[1] + $a[2] * $b[2];
}
sub scalarv {
local($a,@b) = @_;
return ($a * $b[0],$a * $b[1],$a * $b[2]);
}
sub shade {
local(@n) = ($_[0],$_[1],$_[2]);
local(@l) = ($_[3],$_[4],$_[5]);
local($rgb,$r,$g,$b) = (0,0,0,0);
local($i) = $n[0]*$l[0] + $n[1]*$l[1] + $n[2]*$l[2];
if($i < 0.0){
$i = 0.0;
}
$r = int($i*255.0);
$rgb = pack('CCC',$r,$g,$b);
return $rgb;
}
;# for debug
sub dispv {
local($coment,@v) = @_;
print STDERR $coment,$v[0]," ",$v[1]," ",$v[2],"\n";
}
sub dispval {
local($coment,$val) = @_;
print STDERR $coment,$val,"\n";
}