Draw a sphere: Difference between revisions

Content added Content deleted
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: Line 3,324:
<br>Same with the &nbsp; '''CEIL'''ing &nbsp; and &nbsp; '''FLOOR''' &nbsp; functions.
<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).
<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 chars for shading.*/
<lang rexx>/*REXX program expresses a lighted sphere with simple characters for shading.*/
call drawSphere 19, 4, 2/10 /*draw a sphere with radius 19. */
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. */
call drawSphere 10, 2, 4/10 /* " " " " " " " ten. */
exit /*stick a fork in it, we're done.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────DRAWSPHERE subroutine───────────────*/
/*──────────────────────────────────DRAWSPHERE subroutine─────────────────────*/
drawSphere: procedure; parse arg r, k, ambient /*get the arguments*/
drawSphere: procedure; parse arg r, k, ambient /*get the arguments from CL*/
if 1=='f1'x then shading='.:!*oe&#%@' /*EBCDIC dithering.*/
if 1=='f1'x then shading='.:!*oe&#%@' /* EBCDIC dithering chars. */
else shading='·:!°oe@░▒▓' /*ASCII " */
else shading='·:!°oe@░▒▓' /* ASCII " " */
lightSource = '30 30 -50' /*the light source.*/
lightSource = '30 30 -50' /*position of light source.*/
parse value norm(lightSource) with s1 s2 s3 /*normalize light S*/
parse value norm(lightSource) with s1 s2 s3 /*normalize light source. */
sLen=length(shading); sLen1=sLen-1; rr=r*r /*handy-dandy vars.*/
sLen=length(shading)-1; rr=r*r /*handy-dandy variables. */


do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; aLine=
do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; aLine=
do j=floor(-2*r) to ceil(2*r); y=j/2+.5; yy=y**2
do j=floor(-2*r) to ceil(r+r); y=j/2+.5; yy=y**2
if xx+yy<=rr then do /*within the phere?*/
if xx+yy<=rr then do /*is point within sphere ? */
parse value norm(x y sqrt(rr-xx-yy)) with v1 v2 v3
parse value norm(x y sqrt(rr-xx-yy)) with v1 v2 v3
dot=s1*v1 + s2*v2 + s3*v3 /*dot product of Vs*/
dot=s1*v1 + s2*v2 + s3*v3 /*the dot product of the Vs*/
if dot>0 then dot=0 /*if pos, make it 0*/
if dot>0 then dot=0 /*if positive, make it zero*/
b=abs(dot)**k + ambient /*calc. brightness.*/
b=abs(dot)**k + ambient /*calculate the brightness.*/
if b<=0 then brite=sLenm1
if b<=0 then brite=sLen
else brite=trunc( max( (1-b) * sLen1, 0) )
else brite=trunc( max( (1-b) * sLen, 0) )
aLine=aLine || substr(shading,brite+1,1) /*build.*/
aLine=(aLine)substr(shading,brite+1,1) /*build a line.*/
end
end
else aLine=aLine' ' /*append a blank. */
else aLine=aLine' ' /*append a blank to line. */
end /*j*/
end /*j*/
say strip(aLine,'trailing') /*show a line of it*/
say strip(aLine,'trailing') /*show a line of the sphere*/
end /*i*/ /* [↑] show sphere*/
end /*i*/ /* [↑] display the sphere.*/
return
return
/*─────────────────────────────────────one─liner subroutines──────────────────*/
/*─────────────────────────────────────subroutines────────────────────────────*/
ceil: procedure; parse arg x; _=trunc(x); return _ + (x>0) * (x\=_)
ceil: procedure; parse arg x; _=trunc(x); return _ + (x>0) *(x\=_)
floor: 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/_
norm: parse arg _1 _2 _3; _=sqrt(_1**2+_2**2+_3**2); return _1/_ _2/_ _3/_
/*─────────────────────────────────────SQRT subroutine────────────────────────*/
/*─────────────────────────────────────SQRT subroutine────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); p=d+d%4+2; m.=11
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' _ .
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
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
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>
numeric digits d; return g/1</lang>
{{out}} when executed on an ASCII machine:
'''output''' when executed on an ASCII machine:
<pre style="height:105ex">
<pre style="height:105ex">
eeeeeeeeee@@@@@@@
eeeeeeeeee@@@@@@@
Retrieved from "https://rosettacode.org/wiki/Draw_a_sphere"