Draw a sphere: Difference between revisions
Perl entry
(added autohotkey) |
(Perl entry) |
||
Line 1,379:
{{works with|Free_Pascal}}
After changing "{$APPTYPE CONSOLE}" to "{$mode delphi}" or "{$mode objfpc}" the Delphi example works with FreePascal.
=={{header|Perl}}==
{{trans|Perl 6}}
This produces a PGM image which can't be uploaded on rosettacode at the moment. It looks similar as the Perl 6 solution, though.
<lang perl>use strict;
use warnings;
my $x = my $y = 255;
$x |= 1; # must be odd
my $depth = 255;
my $light = Vector->new(rand, rand, rand)->normalized;
print "P2\n$x $y\n$depth\n";
my ($rad, $ambient) = (($x - 1)/2, .2);
my ($r2) = $rad ** 2;
{
for my $x (-$rad .. $rad) {
my $x2 = $x**2;
for my $y (-$rad .. $rad) {
my $y2 = $y**2;
my $pixel = 127;
if ($x2 + $y2 < $r2) {
my $v = Vector->new($x, $y, sqrt($r2 - $x2 - $y2))->normalized;
my $I = ($light . $v) + $ambient;
$I = $I < 0 ? 0 : $I > 1 ? 1 : $I;
$pixel = int($I * $depth);
}
print $pixel;
print $y == $rad ? "\n" : " ";
}
}
}
package Vector {
sub new {
my $class = shift;
bless ref($_[0]) eq 'Array' ? $_[0] : [ @_ ], $class;
}
use overload q{.} => sub {
my ($a, $b) = @_;
my $sum = 0;
for (0 .. @$a - 1) {
$sum += $a->[$_] * $b->[$_]
}
return $sum;
},
q{""} => sub { sprintf "Vector:[%s]", join ' ', @{shift()} };
sub normalized {
my $this = shift;
my $norm = sqrt($this . $this);
bless [ map $_/$norm, @$this ], ref $this;
}
}</lang>
=={{header|Perl 6}}==
| |||