Draw a sphere: Difference between revisions

Content added Content deleted
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: Line 2,986:
<br>The REXX language doesn't have a &nbsp; '''SQRT''' &nbsp; function, so a version is included here.
<br>The REXX language doesn't have a &nbsp; '''SQRT''' &nbsp; function, so a version is included here.
<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.
<lang rexx>/*REXX program to express a lighted sphere with simple chars for shading*/
<lang rexx>/*REXX program expresses a lighted sphere with simple chars for shading.*/
call drawSphere 19, 4, 2/10
call drawSphere 19, 4, 2/10 /*draw a sphere with radius 19. */
call drawSphere 10, 2, 4/10
call drawSphere 10, 2, 4/10 /*draw a sphere with radius ten. */
exit /*stick a fork in it, we're done.*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────drawSphere subroutine───────────────*/
/*──────────────────────────────────DRAWSPHERE subroutine───────────────*/
drawSphere: procedure; parse arg r, k, ambient
drawSphere: procedure; parse arg r, k, ambient /*get the arguments*/
if 1=='f1'x then shading='.:!*oe&#%@' /*for EBCDIC machs.*/
if 1=='f1'x then shading='.:!*oe&#%@' /*EBCDIC dithering.*/
else shading='·:!ºoe@░▒▓' /*for ASCI machines*/
else shading='·:!°oe@░▒▓' /*ASCII " */
lightSource = '30 30 -50' /*the light source.*/
lightSource = '30 30 -50' /*the light source.*/
parse value norm(lightSource) with s1 s2 s3 /*normalize light S*/
parse value norm(lightSource) with s1 s2 s3 /*normalize light S*/
sLen=length(shading); sLen1=sLen-1; rr=r*r
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 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(2*r); y=j/2+.5; yy=y**2
if xx+yy<=rr then do
if xx+yy<=rr then do /*within the phere?*/
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=s1*v1 + s2*v2 + s3*v3 /*dot product of Vs*/
if dot>0 then dot=0
if dot>0 then dot=0 /*if pos, make it 0*/
b=abs(dot)**k + ambient
b=abs(dot)**k + ambient /*calc. brightness.*/
if b<=0 then brite=sLenm1
if b<=0 then brite=sLenm1
else brite=trunc( max( (1-b) * sLen1, 0) )
else brite=trunc( max( (1-b) * sLen1, 0) )
aLine=aLine || substr(shading,brite+1,1)
aLine=aLine || substr(shading,brite+1,1) /*build.*/
end
end
else aLine=aLine' '
else aLine=aLine' ' /*append a blank. */
end /*j*/
end /*j*/
say strip(aLine,'trailing')
say strip(aLine,'trailing') /*show a line of it*/
end /*i*/ /* [↑] show sphere*/
end /*i*/
return
return
/*─────────────────────────────────────subroutines────────────────────────────*/
/*─────────────────────────────────────"1-liner" 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*_1+_2*_2+_3*_3); return _1/_ _2/_ _3/_
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; return .sqrt(x)/1
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); p=d+d%4+2; m.=11
.sqrt: d=digits(); numeric digits 11; g=.sqrtGuess()
numeric digits m.;numeric form;parse value format(x,2,1,,0) 'E0' with g 'E' _ .
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 by -1 to 0; 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
return g
.sqrtGuess: numeric form; m.=11; p=d+d%4+2; v=format(x,2,1,,0) 'E0'
numeric digits d; return g/1</lang>
parse var v g 'E' _ .; return g*.5'E'_%2</lang>
'''output'''
'''output'''
<pre style="height:105ex">
<pre style="height:105ex">
eeeeeeeeee@@@@@@@
eeeeeeeeee@@@@@@@
eoooooooooooooooeeeee@@@@@@@░
eoooooooooooooooeeeee@@@@@@@░
ooººº!!!!!!!!ººººººooooeeeee@@@@@@@░░
oo°°°!!!!!!!!°°°°°°ooooeeeee@@@@@@@░░
oºº!!!:::::::::!!!!!ºººººooooeeee@@@@@@@░░░
o°°!!!:::::::::!!!!!°°°°°ooooeeee@@@@@@@░░░
oº!!::::·········:::::!!!!ºººooooeeeee@@@@@@@░░░░
o°!!::::·········:::::!!!!°°°ooooeeeee@@@@@@@░░░░
oº!:::················::::!!!ººººoooeeeee@@@@@@@░░░░░
o°!:::················::::!!!°°°°oooeeeee@@@@@@@░░░░░
oº!::····················::::!!!ººººoooeeeee@@@@@@@░░░░░░
o°!::····················::::!!!°°°°oooeeeee@@@@@@@░░░░░░
oº!::·······················:::!!!!ºººooooeeee@@@@@@@@░░░░░░░
o°!::·······················:::!!!!°°°ooooeeee@@@@@@@@░░░░░░░
oº!::·························:::!!!ºººooooeeeee@@@@@@@░░░░░░░░
o°!::·························:::!!!°°°ooooeeeee@@@@@@@░░░░░░░░
oº!:···························:::!!!ººººoooeeeee@@@@@@@@░░░░░░░░
o°!:···························:::!!!°°°°oooeeeee@@@@@@@@░░░░░░░░
oº!::··························::::!!!ºººooooeeeee@@@@@@@@░░░░░░░░░
o°!::··························::::!!!°°°ooooeeeee@@@@@@@@░░░░░░░░░
oº!::···························:::!!!!ºººooooeeeee@@@@@@@@░░░░░░░░░░
o°!::···························:::!!!!°°°ooooeeeee@@@@@@@@░░░░░░░░░░
oº!!::··························::::!!!ººººooooeeeee@@@@@@@@░░░░░░░░░░░
o°!!::··························::::!!!°°°°ooooeeeee@@@@@@@@░░░░░░░░░░░
eoº!!::·························::::!!!ººººooooeeeee@@@@@@@@@░░░░░░░░░░░░
eo°!!::·························::::!!!°°°°ooooeeeee@@@@@@@@@░░░░░░░░░░░░
ooº!!::························::::!!!ººººooooeeeeee@@@@@@@@░░░░░░░░░░░░░
oo°!!::························::::!!!°°°°ooooeeeeee@@@@@@@@░░░░░░░░░░░░░
eooº!!:::·····················::::!!!!ººººoooooeeeee@@@@@@@@@░░░░░░░░░░░░░░
eoo°!!:::·····················::::!!!!°°°°oooooeeeee@@@@@@@@@░░░░░░░░░░░░░░
eooºº!!:::·················:::::!!!!!ººººooooeeeeee@@@@@@@@@░░░░░░░░░░░░░░░
eoo°°!!:::·················:::::!!!!!°°°°ooooeeeeee@@@@@@@@@░░░░░░░░░░░░░░░
eooºº!!!:::::··········:::::::!!!!!ººººoooooeeeeee@@@@@@@@@@░░░░░░░░░░░░░░░
eoo°°!!!:::::··········:::::::!!!!!°°°°oooooeeeeee@@@@@@@@@@░░░░░░░░░░░░░░░
eeooººº!!!:::::::::::::::::!!!!!!ºººººoooooeeeeee@@@@@@@@@@░░░░░░░░░░░░░░░░
eeoo°°°!!!:::::::::::::::::!!!!!!°°°°°oooooeeeeee@@@@@@@@@@░░░░░░░░░░░░░░░░
eeoooººº!!!!!!!:::::::!!!!!!!!ººººººoooooeeeeee@@@@@@@@@@@░░░░░░░░░░░░░░░░░
eeooo°°°!!!!!!!:::::::!!!!!!!!°°°°°°oooooeeeeee@@@@@@@@@@@░░░░░░░░░░░░░░░░░
@eeoooººººº!!!!!!!!!!!!!!!ºººººººooooooeeeeeee@@@@@@@@@@@░░░░░░░░░░░░░░░░░░
@eeooo°°°°°!!!!!!!!!!!!!!!°°°°°°°ooooooeeeeeee@@@@@@@@@@@░░░░░░░░░░░░░░░░░░
@@eeeooooºººººººººººººººººººººoooooooeeeeeee@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░
@@eeeoooo°°°°°°°°°°°°°°°°°°°°°oooooooeeeeeee@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░
@@@eeeooooooºººººººººººººoooooooooeeeeeeee@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░
@@@eeeoooooo°°°°°°°°°°°°°oooooooooeeeeeeee@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░
@@@eeeeeooooooooooooooooooooooeeeeeeeee@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░
@@@eeeeeooooooooooooooooooooooeeeeeeeee@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░
@@@@@eeeeeeeooooooooooooeeeeeeeeeeee@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░
@@@@@eeeeeeeooooooooooooeeeeeeeeeeee@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░
Line 3,066: Line 3,065:
░░░░░░░░░░░░░░░░░
░░░░░░░░░░░░░░░░░


::···:::!!!ºo
::···:::!!!°o
··············::!!ºoo
··············::!!°oo
··················::!!ººooe
··················::!!°°ooe
·····················::!!ººooee
·····················::!!°°ooee
·······················::!!ººooee
·······················::!!°°ooee
························::!!ººoooee
························::!!°°oooee
·························::!!ººoooeee
·························::!!°°oooeee
:························::!!!ººoooeeee
:························::!!!°°oooeeee
························::!!!ººooooeeee
························::!!!°°ooooeeee
:······················::!!!ºººoooeeeee
:······················::!!!°°°oooeeeee
:····················:::!!!ºººoooeeeeee
:····················:::!!!°°°oooeeeeee
!:·················:::!!!ººººoooeeeeeee
!:·················:::!!!°°°°oooeeeeeee
º!:::···········::::!!!!ºººooooeeeeeeee
°!:::···········::::!!!!°°°ooooeeeeeeee
º!!!:::::::::::!!!!!ººººoooooeeeeeeee
°!!!:::::::::::!!!!!°°°°oooooeeeeeeee
oºº!!!!!!!!!!!!!ºººººoooooeeeeeeeee
o°°!!!!!!!!!!!!!°°°°°oooooeeeeeeeee
ooººººººººººººººooooooeeeeeeeeeee
oo°°°°°°°°°°°°°°ooooooeeeeeeeeeee
eoooooooooooooooooeeeeeeeeeeeee
eoooooooooooooooooeeeeeeeeeeeee
eeeooooooooeeeeeeeeeeeeeeee
eeeooooooooeeeeeeeeeeeeeeee
Retrieved from "https://rosettacode.org/wiki/Draw_a_sphere"