Anonymous user
Draw a sphere: Difference between revisions
m
→{{header|REXX}}: added/changed comments, changed 1 dithering character, simplified NORM and SQRT subroutines.
m (→{{header|REXX}}: removed OVERFLOW from PRE html tag.) |
m (→{{header|REXX}}: added/changed comments, changed 1 dithering character, simplified NORM and SQRT subroutines.) |
||
Line 2,986:
<br>The REXX language doesn't have a '''SQRT''' function, so a version is included here.
<br>Same with the '''CEIL'''ing and '''FLOOR''' functions.
<lang rexx>/*REXX program
call drawSphere 19, 4, 2/10 /*draw a sphere with radius 19. */
call drawSphere 10, 2, 4/10 /*draw a sphere with radius ten. */
exit /*stick a fork in it, we're done.*/
/*
drawSphere: procedure; parse arg r, k, ambient /*get the arguments*/
if 1=='f1'x then shading='.:!*oe&#%@'
else shading='·:!
lightSource = '30 30 -50'
parse value norm(lightSource) with s1 s2 s3 /*normalize light S*/
sLen=length(shading); sLen1=sLen-1; rr=r*r /*handy-dandy vars.*/
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
if xx+yy<=rr then do /*within the phere?*/
parse value norm(x y sqrt(rr-xx-yy)) with v1 v2 v3
dot=s1*v1 + s2*v2 + s3*v3 /*dot product of Vs*/
if dot>0 then dot=0 /*if pos, make it 0*/
b=abs(dot)**k + ambient /*calc. brightness.*/
if b<=0 then brite=sLenm1
else brite=trunc( max( (1-b) * sLen1, 0) )
aLine=aLine || substr(shading,brite+1,1) /*build.*/
end
else aLine=aLine' ' /*append a blank. */
end /*j*/
say strip(aLine,'trailing') /*show a line of it*/
end /*i*/ /* [↑] show sphere*/
return
/*─────────────────────────────────────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*
/*─────────────────────────────────────SQRT subroutine────────────────────────*/
sqrt: procedure;
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
'''output'''
<pre style="height:105ex">
eeeeeeeeee@@@@@@@
eoooooooooooooooeeeee@@@@@@@░
oo
o
o
o
o
o
o
o
o
o
o
eo
oo
eoo
eoo
eoo
eeoo
eeooo
@eeooo
@@eeeoooo
@@@eeeoooooo
@@@eeeeeooooooooooooooooooooooeeeeeeeee@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░
@@@@@eeeeeeeooooooooooooeeeeeeeeeeee@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░
Line 3,066 ⟶ 3,065:
░░░░░░░░░░░░░░░░░
::···:::!!!
··············::!!
··················::!!
·····················::!!
·······················::!!
························::!!
·························::!!
:························::!!!
························::!!!
:······················::!!!
:····················:::!!!
!:·················:::!!!
o
oo
eoooooooooooooooooeeeeeeeeeeeee
eeeooooooooeeeeeeeeeeeeeeee
| |||