class sphere {
has $.cx; # center x coordinate
has $.cy; # center y coordinate
has $.cz; # center z coordinate
has $.r; # radius
}
my $depth = 255; # image color depth
my $x = my $y = 255; # dimensions of generated .pgm; must be odd
my $s = ($x - 1)/2; # scaled dimension to build geometry
my @light = normalize([ 4, -1, -3 ]);
# positive sphere at origin
my $pos = sphere.new(
cx => 0,
cy => 0,
cz => 0,
r => $s.Int
);
# negative sphere offset to upper left
my $neg = sphere.new(
cx => (-$s*.90).Int,
cy => (-$s*.90).Int,
cz => (-$s*.3).Int,
r => ($s*.7).Int
);
sub MAIN ($outfile = 'deathstar-perl6.pgm') {
spurt $outfile, ("P5\n$x $y\n$depth\n"); # .pgm header
my $out = open( $outfile, :a, :bin ) or die "$!\n";
say 'Calculating row:';
$out.write( Blob.new( draw_ds(3, .15) ) );
$out.close;
}
sub draw_ds ( $k, $ambient ) {
my @pixels;
my $bs = "\b" x 8;
for ($pos.cy - $pos.r) .. ($pos.cy + $pos.r) -> $y {
print $bs, $y, ' '; # monitor progress
for ($pos.cx - $pos.r) .. ($pos.cx + $pos.r) -> $x {
# black if we don't hit positive sphere, ignore negative sphere
if not hit($pos, $x, $y, my $posz) {
@pixels.push(0);
next;
}
my @vec;
# is front of positive sphere inside negative sphere?
if hit($neg, $x, $y, my $negz) and $negz.min < $posz.min < $negz.max {
# make black if whole positive sphere eaten here
if $negz.min < $posz.max < $negz.max { @pixels.push(0); next; }
# render inside of negative sphere
@vec = normalize([$neg.cx - $x, $neg.cy - $y, -$negz.max - $neg.cz]);
}
else {
# render outside of positive sphere
@vec = normalize([$x - $pos.cx, $y - $pos.cy, $posz.max - $pos.cz]);
}
my $intensity = dot(@light, @vec) ** $k + $ambient;
@pixels.push( ($intensity * $depth).Int min $depth );
}
}
say $bs, 'Writing file.';
return @pixels;
}
# normalize a vector
sub normalize (@vec) { return @vec »/» ([+] @vec »*« @vec).sqrt }
# dot product of two vectors
sub dot (@x, @y) { return -([+] @x »*« @y) max 0 }
# are the coordinates within the radius of the sphere?
sub hit ($sphere, $x is copy, $y is copy, $z is rw) {
$x -= $sphere.cx;
$y -= $sphere.cy;
my $z2 = $sphere.r * $sphere.r - $x * $x - $y * $y;
return 0 if $z2 < 0;
$z2 = $z2.sqrt;
$z = $sphere.cz - $z2 .. $sphere.cz + $z2;
return 1;
}