Draw a sphere: Difference between revisions

m
→‎{{header|REXX}}: added whitespace and changed comments.
m (→‎{{header|REXX}}: used a more idiomatic expression for getting the minimum.)
m (→‎{{header|REXX}}: added whitespace and changed comments.)
Line 4,171:
Programming note:   the output will appear slightly different when executed on an EBCDIC machine   (due to different dithering characters).
<lang rexx>/*REXX program expresses a lighted sphere with simple characters used for shading. */
call drawSphere 19, 4, 2/10, '30 30 -50' /*draw a sphere with a radius of 19. */
call drawSphere 10, 2, 4/10, '30 30 -50' /* " " " " " " " ten. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
ceil: procedure; parse arg x; _= trunc(x); return _ + (x>0) * (x\=_)
floor: procedure; parse arg x; _= trunc(x); return _ - (x<0) * (x\=_)
norm: parse arg $a $b $c; _= sqrt($a**2 + $b**2 + $c**2); return $a/_ $b/_ $c/_
/*──────────────────────────────────────────────────────────────────────────────────────*/
drawSphere: procedure; parse arg r, k, ambient, lightSource /*getobtain the four arguments from CL*/
if 58=='f5f8'x then shading= ".:!*oe&#%@" /* EBCDIC dithering chars. */
else shading= "·:!°oe@░▒▓" /* ASCII " " */
lightSource= '30 30 -50' /*position of light source.*/
parse value norm(lightSource) with s1 s2 s3 /*normalize light source. */
shadeLen= length(shading) - 1; rr= r**2; r2= r+r /*handy─dandy variables. */
 
do i=floor( -r ) to ceil(r r); x= i + .5; xx= x**2; $=
do j=floor(-r2) to ceil(r2); y= j * .5 + .5; yy= y**2; z= xx+yy
if xx+yyz<=rr then do /*is point within sphere ? */
parse value norm(x y sqrt(rr - xx - yy) ) with v1 v2 v3
dot= min(0, s1*v1 + s2*v2 + s3*v3) /*the dot product of the Vsabove.*/
b= -dot=**k min(0, dot)+ ambient /*if positive, makecalculate itthe zerobrightness.*/
if b<=0 -dot**k then + ambient /*calculate thebrite= brightness.*/shadeLen
if b<=0 then else brite= max(0, (1-b) * shadeLen) % 1
else brite$= max( $)substr(1-b) * shadeLenshading, brite 0)+ 1, % 1)
end $= ($)substr(shading, brite + 1, 1) /* [↑] build display line.*/
else $= $' end' /*append [↑]a blank build displayto line. */
else $= $' ' /*append a blank to line. */
end /*j*/ /*[↓] strip trailing blanks*/
say strip($, 'T') /*show a line of the sphere*/