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