Draw a sphere: Difference between revisions

Content added Content deleted
(Rename Perl 6 -> Raku, alphabetize, minor clean-up)
Line 239: Line 239:
Gdip_Shutdown(pToken)
Gdip_Shutdown(pToken)
ExitApp</lang>
ExitApp</lang>

=={{header|AWK}}==
=={{header|AWK}}==
<lang AWK>
<lang AWK>
Line 1,940: Line 1,941:
</pre>
</pre>



=={{header|FutureBasic}}==
=={{header|FutureBasic}}==
Line 2,019: Line 2,019:
until gFBquit
until gFBquit
</lang>
</lang>



=={{header|Go}}==
=={{header|Go}}==
Line 2,093: Line 2,092:
}
}
}</lang>
}</lang>

=={{header|HTML}}==

See [[Draw_a_sphere#Javascript]]


=={{header|Haskell}}==
=={{header|Haskell}}==
Line 2,161: Line 2,156:


<div style="border: 1px solid #000000; overflow: auto; width: 100%"></div>
<div style="border: 1px solid #000000; overflow: auto; width: 100%"></div>

=={{header|HTML}}==

See [[Draw_a_sphere#Javascript]]

=={{header|J}}==
=={{header|J}}==


Line 2,300: Line 2,300:
eeeeeeeeeeeee
eeeeeeeeeeeee
</pre>
</pre>

=={{header|JavaScript}}==
=={{header|JavaScript}}==


Line 2,701: Line 2,702:
eeeeeeeeeeeee
eeeeeeeeeeeee
</pre>
</pre>

=={{header|M2000 Interpreter}}==
=={{header|M2000 Interpreter}}==
<lang M2000 Interpreter>
<lang M2000 Interpreter>
Line 2,898: Line 2,900:
{{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}}==
=={{header|Perl}}==
Line 2,956: Line 2,957:
q{""} => sub { sprintf "Vector:[%s]", join ' ', @{shift()} };
q{""} => sub { sprintf "Vector:[%s]", join ' ', @{shift()} };
}</lang>
}</lang>

=={{header|Perl 6}}==

===Pure Perl 6===
{{trans|C}}

The C code is modified to output a .pgm file.
{{works with|Rakudo|2018.10}}

[[File:Sphere-perl6.png|thumb]]
<lang perl6>my $width = my $height = 255; # must be odd

my @light = normalize([ 3, 2, -5 ]);

my $depth = 255;

sub MAIN ($outfile = 'sphere-perl6.pgm') {
spurt $outfile, "P5\n$width $height\n$depth\n"; # .pgm header
my $out = open( $outfile, :a, :bin ) orelse .die;
$out.write( Blob.new(draw_sphere( ($width-1)/2, .9, .2) ) );
$out.close;
}

sub normalize (@vec) { @vec »/» ([+] @vec »*« @vec).sqrt }

sub dot (@x, @y) { -([+] @x »*« @y) max 0 }

sub draw_sphere ( $rad, $k, $ambient ) {
my @pixels[$height];
my $r2 = $rad * $rad;
my @range = -$rad .. $rad;
@range.hyper.map: -> $x {
my @row[$width];
@range.map: -> $y {
if (my $x2 = $x * $x) + (my $y2 = $y * $y) < $r2 {
my @vector = normalize([$x, $y, ($r2 - $x2 - $y2).sqrt]);
my $intensity = dot(@light, @vector) ** $k + $ambient;
my $pixel = (0 max ($intensity * $depth).Int) min $depth;
@row[$y+$rad] = $pixel;
}
else {
@row[$y+$rad] = 0;
}
}
@pixels[$x+$rad] = @row;
}
flat |@pixels.map: *.list;
}</lang>

===Cairo graphics library===
<lang perl6>use Cairo;

given Cairo::Image.create(Cairo::FORMAT_ARGB32, 256, 256) {
given Cairo::Context.new($_) {

my Cairo::Pattern::Solid $bg .= create(.5,.5,.5);
.rectangle(0, 0, 256, 256);
.pattern($bg);
.fill;
$bg.destroy;

my Cairo::Pattern::Gradient::Radial $shadow .=
create(105.2, 102.4, 15.6, 102.4, 102.4, 128.0);
$shadow.add_color_stop_rgba(0, .3, .3, .3, .3);
$shadow.add_color_stop_rgba(1, .1, .1, .1, .02);
.pattern($shadow);
.arc(136.0, 134.0, 110, 0, 2 * pi);
.fill;
$shadow.destroy;

my Cairo::Pattern::Gradient::Radial $sphere .=
create(115.2, 102.4, 25.6, 102.4, 102.4, 128.0);
$sphere.add_color_stop_rgba(0, 1, 1, .698, 1);
$sphere.add_color_stop_rgba(1, .923, .669, .144, 1);
.pattern($sphere);
.arc(128.0, 128.0, 110, 0, 2 * pi);
.fill;
$sphere.destroy;
};
.write_png('sphere2-perl6.png');
}</lang>
See [https://github.com/thundergnat/rc/blob/master/img/sphere2-perl6.png sphere2-perl6.png] (offsite .png image)


=={{header|Phix}}==
=={{header|Phix}}==
Line 4,281: Line 4,200:
(plot3d (polar3d (λ (θ ρ) 1)) #:altitude 25)
(plot3d (polar3d (λ (θ ρ) 1)) #:altitude 25)
</lang>
</lang>

=={{header|Raku}}==
(formerly Perl 6)

===Pure Perl 6===
{{trans|C}}

The C code is modified to output a .pgm file.
{{works with|Rakudo|2018.10}}

[[File:Sphere-perl6.png|thumb]]
<lang perl6>my $width = my $height = 255; # must be odd

my @light = normalize([ 3, 2, -5 ]);

my $depth = 255;

sub MAIN ($outfile = 'sphere-perl6.pgm') {
spurt $outfile, "P5\n$width $height\n$depth\n"; # .pgm header
my $out = open( $outfile, :a, :bin ) orelse .die;
$out.write( Blob.new(draw_sphere( ($width-1)/2, .9, .2) ) );
$out.close;
}

sub normalize (@vec) { @vec »/» ([+] @vec »*« @vec).sqrt }

sub dot (@x, @y) { -([+] @x »*« @y) max 0 }

sub draw_sphere ( $rad, $k, $ambient ) {
my @pixels[$height];
my $r2 = $rad * $rad;
my @range = -$rad .. $rad;
@range.hyper.map: -> $x {
my @row[$width];
@range.map: -> $y {
if (my $x2 = $x * $x) + (my $y2 = $y * $y) < $r2 {
my @vector = normalize([$x, $y, ($r2 - $x2 - $y2).sqrt]);
my $intensity = dot(@light, @vector) ** $k + $ambient;
my $pixel = (0 max ($intensity * $depth).Int) min $depth;
@row[$y+$rad] = $pixel;
}
else {
@row[$y+$rad] = 0;
}
}
@pixels[$x+$rad] = @row;
}
flat |@pixels.map: *.list;
}</lang>

===Cairo graphics library===
<lang perl6>use Cairo;

given Cairo::Image.create(Cairo::FORMAT_ARGB32, 256, 256) {
given Cairo::Context.new($_) {

my Cairo::Pattern::Solid $bg .= create(.5,.5,.5);
.rectangle(0, 0, 256, 256);
.pattern($bg);
.fill;
$bg.destroy;

my Cairo::Pattern::Gradient::Radial $shadow .=
create(105.2, 102.4, 15.6, 102.4, 102.4, 128.0);
$shadow.add_color_stop_rgba(0, .3, .3, .3, .3);
$shadow.add_color_stop_rgba(1, .1, .1, .1, .02);
.pattern($shadow);
.arc(136.0, 134.0, 110, 0, 2 * pi);
.fill;
$shadow.destroy;

my Cairo::Pattern::Gradient::Radial $sphere .=
create(115.2, 102.4, 25.6, 102.4, 102.4, 128.0);
$sphere.add_color_stop_rgba(0, 1, 1, .698, 1);
$sphere.add_color_stop_rgba(1, .923, .669, .144, 1);
.pattern($sphere);
.arc(128.0, 128.0, 110, 0, 2 * pi);
.fill;
$sphere.destroy;
};
.write_png('sphere2-perl6.png');
}</lang>
See [https://github.com/thundergnat/rc/blob/master/img/sphere2-perl6.png sphere2-perl6.png] (offsite .png image)


=={{header|REXX}}==
=={{header|REXX}}==
Line 4,608: Line 4,610:
var s = Sphere(frame: CGRectMake(0, 0, 200, 200))
var s = Sphere(frame: CGRectMake(0, 0, 200, 200))
</lang>
</lang>



=={{header|Tcl}}==
=={{header|Tcl}}==
Retrieved from "https://rosettacode.org/wiki/Draw_a_sphere"