Rosetta Code

Draw a sphere: Difference between revisions

Page Discussion

Draw a sphere (view source)

Revision as of 21:40, 19 June 2015

131 bytes added ,  9 years ago
m
→‎{{header|REXX}}: added/changed whitespace and comments, reduced need for some temp variables.
m (J: torgb better fits than tograyscale - the gray of that image is because we're only using one channel of intensity and using it for all three colors - but the conversion routine does support all three...)
m (→‎{{header|REXX}}: added/changed whitespace and comments, reduced need for some temp variables.)
Line 3,324:
<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 charscharacters for shading.*/
call drawSphere 19, 4, 2/10 /*draw a sphere with a radius of 19. */
call drawSphere 10, 2, 4/10 /*draw a sphere" with radius" " " " " " ten. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────DRAWSPHERE subroutine───────────────subroutine─────────────────────*/
drawSphere: procedure; parse arg r, k, ambient /*get the arguments from CL*/
if 1=='f1'x then shading='.:!*oe&#%@' /* EBCDIC dithering chars. */
else shading='·:!°oe@░▒▓' /* ASCII " " */
lightSource = '30 30 -50' /*theposition of light source.*/
parse value norm(lightSource) with s1 s2 s3 /*normalize light Ssource. */
sLen=length(shading)-1; sLen1=sLen-1; rr=r*r /*handy-dandy varsvariables. */
 
do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; aLine=
do j=floor(-2*r) to ceil(2*r+r); y=j/2+.5; yy=y**2
if xx+yy<=rr then do /*is point within thesphere phere? */
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 pospositive, make it 0zero*/
b=abs(dot)**k + ambient /*calc.calculate the brightness.*/
if b<=0 then brite=sLenm1sLen
else brite=trunc( max( (1-b) * sLen1sLen, 0) )
aLine=(aLine || )substr(shading,brite+1,1) /*build a line.*/
end
else aLine=aLine' ' /*append a blank to line. */
end /*j*/
say strip(aLine,'trailing') /*show a line of itthe sphere*/
end /*i*/ /* [↑] showdisplay the sphere.*/
return
/*─────────────────────────────────────one─liner subroutines──────────────────*/
/*─────────────────────────────────────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 _2 _3; _=sqrt(_1**2+_2**2+_3**2); return _1/_ _2/_ _3/_
/*─────────────────────────────────────SQRT subroutine────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); p=d+d%4+2; m.=11
numeric digits m.; numeric form;parse value format(x,2,1,,0) 'E0' with g 'E' _ .
g=g*.5'E'_%2; do j=0 while p>9; m.j=p; p=p%2+1; end
do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k; g=.5*(g+x/g); end
numeric digits d; return g/1</lang>
{{out}}'''output''' when executed on an ASCII machine:
<pre style="height:105ex">
eeeeeeeeee@@@@@@@
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/176258"