Death Star: Difference between revisions
Content deleted Content added
→{{header|Sidef}}: simplified the code to use the Vector class and added link to the output image |
m →{{header|REXX}}: added whitespace and comments, used a template for the output section. |
||
Line 1,428: | Line 1,428: | ||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
{{trans|D}} |
{{trans|D}} |
||
(Apologies for the comments making the lines so wide, but it was easier to read and compare to the original '''D''' source.) |
(Apologies for the comments making the lines so wide, but it was easier to read and compare to the original '''D''' source.) |
||
<lang rexx>/*REXX program displays a sphere with another sphere subtracted where it's superimposed.*/ |
<lang rexx>/*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. */ |
exit /*stick a fork in it, we're all done. */ |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
||
Line 1,439: | Line 1,440: | ||
v3: procedure; parse arg a b c; #=sqrt(a**2 + b**2 + c**2); return a/# b/# c/# |
v3: procedure; parse arg a b c; #=sqrt(a**2 + b**2 + c**2); return a/# b/# c/# |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
||
sqrt: procedure; parse arg x; |
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); h= d+6; numeric digits |
||
numeric form; |
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 !.; |
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; |
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*/ |
deathStar: procedure; parse arg k,ambient,sun /* [↓] display the deathstar to screen*/ |
||
parse var sun s1 s2 s3 /*identify the light source coördinates*/ |
parse var sun s1 s2 s3 /*identify the light source coördinates*/ |
||
if |
if 5=="f5"x then shading= '.:!*oe&#%@' /*dithering chars for an EBCDIC machine*/ |
||
else shading= '·:!ºoe@░▒▓' /* " |
else shading= '·:!ºoe@░▒▓' /* " " " " ASCII " */ |
||
shadingL=length(shading) |
shadingL= length(shading) /*the number of dithering characters. */ |
||
shades.=' '; do i=1 for shadingL; shades.i=substr(shading, i, 1) |
shades.= ' '; do i=1 for shadingL; shades.i= substr(shading, i, 1) |
||
⚫ | |||
ship= 20 20 0 20 ; parse var ship shipX shipY shipZ shipR |
ship= 20 20 0 20 ; parse var ship shipX shipY shipZ shipR |
||
hole= ' 1 1 -6 20' ; parse var hole holeX holeY holeZ . |
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. */ |
|||
⚫ | |||
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. */ |
|||
⚫ | |||
/*$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 s1>b1 then $pos=1 /*ray hits both, but ship front surface is closer. */ |
||
else if s2>b2 then $bg= |
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 if s2>b1 then $neg=1 /*hole back surface is inside ship; the only place ··· */ |
||
else $pos=1 /* |
else $pos=1 /*························ a hole surface will be shown.*/ |
||
end |
end |
||
select |
select |
||
when $bg then do; |
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 $pos then vec_= v3(x-shipX y-shipY b1-shipZ) |
||
when $neg then vec_= v3(holeX-x holeY-y holeZ-s2) |
when $neg then vec_= v3(holeX-x holeY-y holeZ-s2) |
||
end /*select*/ |
end /*select*/ |
||
b=1 +min(shadingL, max(0, trunc((1 - (dot.(sun, v3(vec_))**k + ambient)) * shadingL))) |
b=1 +min(shadingL, max(0, trunc((1 - (dot.(sun, v3(vec_))**k + ambient)) * shadingL))) |
||
@=@ || shades.b /*B |
@=@ || shades.b /*B: the ray's intensity│brightness*/ |
||
end /*j*/ /* [↑] build a line for the sphere.*/ |
end /*j*/ /* [↑] build a line for the sphere.*/ |
||
Line 1,484: | Line 1,484: | ||
end /*i*/ /* [↑] show all lines for sphere. */ |
end /*i*/ /* [↑] show all lines for sphere. */ |
||
return</lang> |
return</lang> |
||
{{out|output|text= when using the internal default input:}} |
|||
'''output''' |
|||
<pre> |
<pre> |
||
eeeee::::::: |
eeeee::::::: |