Rosetta Code

Draw a sphere: Difference between revisions

Page Discussion

Draw a sphere (view source)

Revision as of 06:26, 1 June 2016

414 bytes added ,  8 years ago
m
→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations.
m (→‎{{header|FreeBASIC}}: removed redundant code)
m (→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations.)
Line 3,488:
<br>Same with the &nbsp; '''CEIL'''ing &nbsp; and &nbsp; '''FLOOR''' &nbsp; functions.
<br><br>Programming note: &nbsp; the output will appear slightly different when executed on an EBCDIC machine &nbsp; (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 /*draw a sphere with a radius of 19. */
call drawSphere 10, 2, 4/10 /* " " " " " " " ten. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*─────────────────────────────────────one─liner subroutines──────────────────*/
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 _1$a _2$b _3$c; _=sqrt(_1$a**2 +_2 $b**2 +_3 $c**2); return _1 $a/_ _2$b/_ _3$c/_
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────DRAWSPHERE subroutine─────────────────────*/
drawSphere: procedure; parse arg r, k, ambient /*get the arguments from CL*/
if 15=='f1f5'x then shading= ".:!*oe&#%@" /* EBCDIC dithering chars. */
else shading= "·:!°oe@░▒▓" /* ASCII " " */
lightSource lightSource= '30 30 -50' /*position of light source.*/
parse value norm(lightSource) with s1 s2 s3 /*normalize light source. */
sLen=length(shading)-1; rr=r*r /*handy─dandy variables. */
 
do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; $=
do j=floor(-2*r) to ceil(r+r); y=j/2+.5; yy=y**2
if xx+yy<=rr then do /*is point within sphere ? */
parse value norm(x y sqrt(rr-xx-yy)) with v1 v2 v3
dot=s1*v1 + s2*v2 + s3*v3 /*the dot product of the Vs*/
if dot>0 then dot=0 /*if positive, make it zero*/
b=abs(dot)**k + ambient /*calculate the brightness.*/
if b<=0 then brite=sLen
else brite=trunc( max( (1-b) * sLen, 0) )
$=($)substr(shading,brite+1,1) /*buildconstruct a display line.*/
end
else $=$' ' /*append a blank to line. */
end /*j*/
say strip($, 'trailingT') /*show a line of the sphere*/
end /*i*/ /* [↑] display the sphere.*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────SQRT subroutine───────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); im.=9; numeric m.=9form
numeric digits 9; numericparse form;value h=d+6;format(x,2,1,,0) 'E0' if x<0with theng do;"E" x=-x_ .; i g=g*.5'ie'; end_%2
parseh=d+6; value format(x,2,1,, do j=0) 'E0' while withh>9; g 'E' _ m.j=h; g h=g*.5'e'_h%2+1; end /*j*/
do j=0 while h>9; m.do k=j=h;+5 to 0 by -1; numeric digits m.k; hg=h%2(g+1x/g)*.5; end /*jk*/
numeric digits d; do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end return g/*k*1</lang>
numeric digits d; return (g/1)i /*make complex if X < 0.*/</lang>
'''output''' &nbsp; when executed on an ASCII machine:
<pre>
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/176279"