aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September Morn Update

Browse source
This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
Download patch file Download diff file Expand all files Collapse all files

17
Task/Death-Star/Julia/death-star.julia Normal file
View file

@ -0,0 +1,17 @@
# run in REPL
using Makie
function deathstarjpg()
n = 60
θ = [0; (0.5: n - 0.5) / n; 1]
φ = [(0: 2n - 2) * 2 / (2n - 1); 2]
# if x is +0.9 radius units, replace it with the coordinates of sphere surface
# at (1.2,0,0) center, radius 0.5 units
x = [(x1 = cospi(φ)*sinpi(θ)) > 0.9 ? 1.2 - x1 * 0.5 : x1 for θ in θ, φ in φ]
y = [sinpi(φ)*sinpi(θ) for θ in θ, φ in φ]
z = [cospi(θ) for θ in θ, φ in φ]
scene = Scene(backgroundcolor=:black)
surface!(scene, x, y, z, color = rand(RGBAf0, 124, 124), show_axis=false)
end
deathstarjpg()

6
Task/Death-Star/Maple/death-star.maple Normal file
View file

@ -0,0 +1,6 @@
with(plots):
with(plottools):
plots:-display(
implicitplot3d(x^2 + y^2 + z^2 = 1, x = -1..0.85, y = -1..1, z = -1..1, style = surface, grid = [50,50,50]),
translate(rotate(implicitplot3d(x^2 + y^2 + z^2 = 1, x = 0.85..1, y = -1..1, z = -1..1, style = surface, grid = [50,50,50]), 0, Pi, 0), 1.70, 0, 0),
axes = none, scaling = constrained, color = gray)

39
Task/Death-Star/Perl-6/death-star.pl6
View file

@ -7,9 +7,9 @@ class sphere {
my $depth = 255; # image color depth
my $x = my $y = 255; # dimensions of generated .pgm; must be odd
my $width = my $height = 255; # dimensions of generated .pgm; must be odd
my $s = ($x - 1)/2; # scaled dimension to build geometry
my $s = ($width - 1)/2; # scaled dimension to build geometry
my @light = normalize([ 4, -1, -3 ]);
@ -30,29 +30,30 @@ my $neg = sphere.new(
);
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) ) );
spurt $outfile, ("P5\n$width $height\n$depth\n"); # .pgm header
my $out = open( $outfile, :a, :bin ) orelse .die;
say 'Working...';
$out.write( Blob.new( |draw_ds(3, .15) ) );
say 'File written.';
$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 {
my @pixels[$height];
(($pos.cy - $pos.r) .. ($pos.cy + $pos.r)).race.map: -> $y {
my @row[$width];
(($pos.cx - $pos.r) .. ($pos.cx + $pos.r)).map: -> $x {
# black if we don't hit positive sphere, ignore negative sphere
if not hit($pos, $x, $y, my $posz) {
@pixels.push(0);
@row[$x + $s] = 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; }
if $negz.min < $posz.max < $negz.max { @row[$x + $s] = 0; next; }
# render inside of negative sphere
@vec = normalize([$neg.cx - $x, $neg.cy - $y, -$negz.max - $neg.cz]);
}
@ -61,18 +62,18 @@ sub draw_ds ( $k, $ambient ) {
@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 );
@row[$x + $s] = ($intensity * $depth).Int min $depth;
}
@pixels[$y + $s] = @row;
}
say $bs, 'Writing file.';
return @pixels;
flat |@pixels.map: *.list;
}
# normalize a vector
sub normalize (@vec) { return @vec »/» ([+] @vec »*« @vec).sqrt }
sub normalize (@vec) { @vec »/» ([+] @vec »*« @vec).sqrt }
# dot product of two vectors
sub dot (@x, @y) { return -([+] @x »*« @y) max 0 }
sub dot (@x, @y) { -([+] @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) {
@ -82,5 +83,5 @@ sub hit ($sphere, $x is copy, $y is copy, $z is rw) {
return 0 if $z2 < 0;
$z2 = $z2.sqrt;
$z = $sphere.cz - $z2 .. $sphere.cz + $z2;
return 1;
1;
}

63
Task/Death-Star/REXX/death-star.rexx
View file

@ -1,5 +1,5 @@
/*REXX program displays a sphere with another sphere subtracted where it's superimposed.*/
call deathStar 2, .5, v3('-50 30 50')
call deathStar 2, .5, v3('-50 30 50')
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
dot: #=0; do j=1 for words(x); #=# + word(x,j)*word(y,j); end; return #
@ -8,46 +8,45 @@ ceil: procedure; parse arg x; _=trunc(x); return _+(x
floor: procedure; parse arg x; _=trunc(x); return _-(x<0)*(x\=_)
v3: procedure; parse arg a b c; #=sqrt(a**2 + b**2 + c**2); return a/# b/# c/#
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric digits
numeric form; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g * .5'e'_ % 2
h=d+6; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
numeric digits d; return g/1
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); h= d+6; numeric digits
m.=9; numeric form; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2
do j=0 while h>9; m.j= h; h= h % 2 + 1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g= (g +x/g)* .5; end /*k*/; return g
/*──────────────────────────────────────────────────────────────────────────────────────*/
hitSphere: procedure expose !.; parse arg xx yy zz r,x0,y0; z=r*r-(x0-xx)**2-(y0-yy)**2
if z<0 then return 0; _=sqrt(z); !.z1=zz-_; !.z2=zz+_; return 1
hitSphere: procedure expose !.; parse arg xx yy zz r,x0,y0; z= r*r -(x0-xx)**2-(y0-yy)**2
if z<0 then return 0; _= sqrt(z); !.z1= zz - _; !.z2= zz + _; return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
deathStar: procedure; parse arg k,ambient,sun /* [↓] display the deathstar to screen*/
parse var sun s1 s2 s3 /*identify the light source coördinates*/
if 6=="f6"x then shading= '.:!*oe&#%@' /*shading characters for EBCDIC machine*/
else shading= '·:!ºoe@░▒▓' /* " " " ASCII " */
shadingL=length(shading)
shades.=' '; do i=1 for shadingL; shades.i=substr(shading, i, 1); end /*i*/
if 5=="f5"x then shading= '.:!*oe&#%@' /*dithering chars for an EBCDIC machine*/
else shading= '·:!ºoe@░▒▓' /* " " " " ASCII " */
shadingL= length(shading) /*the number of dithering characters. */
shades.= ' '; do i=1 for shadingL; shades.i= substr(shading, i, 1)
end /*i*/
ship= 20 20 0 20 ; parse var ship shipX shipY shipZ shipR
hole= ' 1 1 -6 20' ; parse var hole holeX holeY holeZ .
ship= 20 20 0 20 ; parse var ship shipX shipY shipZ shipR
hole= ' 1 1 -6 20' ; parse var hole holeX holeY holeZ .
do i=floor(shipY-shipR ) to ceil(shipY+shipR )+1; y=i+.5; @= /*@ is a single line of the deathstar to be displayed.*/
do j=floor(shipX-shipR*2) to ceil(shipX+shipR*2)+1; !.=0
x=.5 * (j-shipX+1) + shipX; $bg=0; $pos=0; $neg=0 /*$BG, $POS, and $NEG are boolean values. */
?=hitSphere(ship, x, y); b1=!.z1; b2=!.z2 /*? is boolean, "true" indicates ray hits the sphere.*/
if \? then $bg=1 /*ray lands in blank space, so draw the background. */
else do; ?=hitSphere(hole, x, y); s1=!.z1; s2=!.z2
if \? then $pos=1 /*ray hits ship but not the hole, so draw ship surface. */
do i=floor(shipY-shipR ) to ceil(shipY+shipR )+1; y= i +.5; @= /*@ is a single line of the deathstar to be displayed.*/
do j=floor(shipX-shipR*2) to ceil(shipX+shipR*2)+1; !.= 0
x=.5 * (j-shipX+1) + shipX; $bg= 0; $pos= 0; $neg= 0 /*$BG, $POS, and $NEG are boolean values. */
?= hitSphere(ship, x, y); b1= !.z1; b2= !.z2 /*? is boolean, "true" indicates ray hits the sphere.*/
/*$BG: if 1, its background; if zero, it's foreground.*/
if \? then $bg= 1 /*ray lands in blank space, so draw the background. */
else do; ?= hitSphere(hole, x, y); s1= !.z1; s2= !.z2
if \? then $pos= 1 /*ray hits ship but not the hole, so draw ship surface. */
else if s1>b1 then $pos=1 /*ray hits both, but ship front surface is closer. */
else if s2>b2 then $bg=1 /*ship surface is inside hole, so show the background. */
else if s2>b1 then $neg=1 /*hole back surface is inside ship; the only place a ···*/
else $pos=1 /*························· hole surface will be shown.*/
else if s2>b2 then $bg= 1 /*ship surface is inside hole, so show the background. */
else if s2>b1 then $neg=1 /*hole back surface is inside ship; the only place ··· */
else $pos=1 /*························ a hole surface will be shown.*/
end
select
when $bg then do; @=@' '; iterate j; end /*append a blank character to the line to be displayed. */
when $pos then vec_= v3(x-shipX y-shipY b1-shipZ)
when $neg then vec_= v3(holeX-x holeY-y holeZ-s2)
end /*select*/
select
when $bg then do; @= @' '; iterate j; end /*append a blank character to the line to be displayed. */
when $pos then vec_= v3(x-shipX y-shipY b1-shipZ)
when $neg then vec_= v3(holeX-x holeY-y holeZ-s2)
end /*select*/
b=1 +min(shadingL, max(0, trunc((1 - (dot.(sun, v3(vec_))**k + ambient)) * shadingL)))
@=@ || shades.b /*B the ray's intensity│brightness*/
@=@ || shades.b /*B: the ray's intensity│brightness*/
end /*j*/ /* [↑] build a line for the sphere.*/
if @\='' then say strip(@, 'T') /*strip trailing blanks from line. */

67
Task/Death-Star/Sidef/death-star.sidef
View file

@ -1,65 +1,62 @@
func sq(*nums) {
nums »**» 2 «+»;
}
func hitf(sph, x, y) {
x -= sph[0];
y -= sph[1];
x -= sph[0]
y -= sph[1]
var z = (sq(sph[3]) - sq(x, y));
z < 0 && return nil;
var z = (sph[3]**2 - (x**2 + y**2))
z.sqrt!;
[sph[2] - z, sph[2] + z];
z < 0 && return nil
z.sqrt!
[sph[2] - z, sph[2] + z]
}
func normalize(v) {
var n = sq(v...).sqrt;
v »/» n;
v / v.abs
}
func dot(x, y) {
var s = (x[0]*y[0] + x[1]*y[1] + x[2]*y[2]);
s > 0 ? s : 0;
max(0, x*y)
}
var pos = [120, 120, 0, 120];
var neg = [-77, -33, -100, 190];
var light = normalize([-12, 13, -10]);
var pos = [120, 120, 0, 120]
var neg = [-77, -33, -100, 190]
var light = normalize(Vector(-12, 13, -10))
func draw(k, amb) {
STDOUT.binmode(':raw');
print ("P5\n", pos[0]*2 + 3, " ", pos[1]*2 + 3, "\n255\n");
STDOUT.binmode(':raw')
print ("P5\n", pos[0]*2 + 3, " ", pos[1]*2 + 3, "\n255\n")
for y in ((pos[1] - pos[3] - 1) .. (pos[1] + pos[3] + 1)) {
var row = [];
var row = []
for x in ((pos[0] - pos[3] - 1) .. (pos[0] + pos[3] + 1)) {
var hit = 0;
var hs = [];
var h = hitf(pos, x, y);
var hit = 0
var hs = []
var h = hitf(pos, x, y)
if (!h) { hit = 0; h = [0, 0] }
elsif (!(hs = hitf(neg, x, y))) { hit = 1; hs = [0, 0] }
elsif (hs[0] > h[0]) { hit = 1 }
elsif (hs[1] > h[0]) { hit = (hs[1] > h[1] ? 0 : 2) }
else { hit = 1 };
else { hit = 1 }
var (val, v)
var (val, v);
given(hit) {
when (0) { val = 0}
when (1) { v = [x-pos[0], y-pos[1], h[0]-pos[2]] }
default { v = [neg[0]-x, neg[1]-y, neg[2]-hs[1]] }
when (1) { v = Vector(x-pos[0], y-pos[1], h[0]-pos[2]) }
default { v = Vector(neg[0]-x, neg[1]-y, neg[2]-hs[1]) }
}
if (v) {
v = normalize(v);
val = int((dot(v, light)**k + amb) * 255);
val = (val > 255 ? 255 : (val < 0 ? 0 : val));
};
row.append(val);
if (defined(v)) {
v = normalize(v)
val = int((dot(v, light)**k + amb) * 255)
val = (val > 255 ? 255 : (val < 0 ? 0 : val))
}
row.append(val)
}
print 'C*'.pack(row...);
print 'C*'.pack(row...)
}
}
draw(2, 0.2);
draw(2, 0.2)