Perl サンプルスクリプト

レイトレーシング

以下のPerlスクリプトは赤い球1つ、ライト1つのたいへん簡単なレイトレーシングを行うものである。

$xres = $ARGV[0];
$yres = $ARGV[1];
print $xres," ",$yres,"\n";
@eye = (0.0,0.0,4.0);
@sph = (0.0,0.0,0.0,0.7);
@light = &mklight(-1,-1,0.5);
$picname = "tmp.ppm";

;# main program
open(pic,">$picname");
select(pic);
print "P6\n",$xres," ",$yres,"\n255\n";
for($y = 0; $y < $yres; $y++){
	for($x = 0; $x < $yres; $x++){
		@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;
}

実行方法

解像度400 x 400 の画像がレンダリングされてtmp.ppmというファイルに出力される。

# perl ray.pl 400 400