Draw a sphere: Difference between revisions
Content deleted Content added
added autohotkey |
Perl entry |
||
Line 1,379: | Line 1,379: | ||
{{works with|Free_Pascal}} |
{{works with|Free_Pascal}} |
||
After changing "{$APPTYPE CONSOLE}" to "{$mode delphi}" or "{$mode objfpc}" the Delphi example works with FreePascal. |
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}}== |
=={{header|Perl 6}}== |