aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

14
Task/Death-Star/REXX/death-star.rexx
View file

@ -1,10 +1,10 @@
/*REXX program to draw a "deathstar", a sphere with another subtracted. */
signal on syntax; signal on novalue /*handle REXX program errors. */
signal on syntax; signal on noValue /*handle REXX program errors. */
numeric digits 20 /*use a fair amount of precision.*/
lightSource = norm('-50 30 50')
call drawSphereM 2, .5, lightSource
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────drawSphereM subroutine──────────────*/
/*──────────────────────────────────DRAWSPHEREM subroutine──────────────*/
drawSphereM: procedure; parse arg k,ambient,lightSource
z1=0; z2=0
parse var lightSource s1 s2 s3 /*break-apart the light source. */
@ -21,7 +21,7 @@ ship= 20 20 0 20 ; parse var ship ship.cx ship.cy ship.cz ship.radius
hole=' 1 1 -6 20'; parse var hole hole.cx hole.cy hole.cz hole.radius
do i=floor(ship.cy-ship.radius) to ceil(ship.cy+ship.radius)+1; y=i+.5; aLine=
do j=trunc(floor(ship.cx - 2*ship.radius) ) to,
do j=trunc(floor(ship.cx - 2*ship.radius) ) to ,
trunc( ceil(ship.cx + 2*ship.radius) +1)
x=.5*(j-ship.cx) + .5 + ship.cx; !bg=0; !pos=0; !neg=0; z1=0; z2=0
?=hitSphere(ship, x, y); zb1=z1; zb2=z2
@ -52,7 +52,7 @@ hole=' 1 1 -6 20'; parse var hole hole.cx hole.cy hole.cz hole.radius
end /*i*/
return
/*──────────────────────────────────hitSphere subroutine────────────────*/
/*──────────────────────────────────HITSPHERE subroutine────────────────*/
hitSphere: procedure expose z1 z2; parse arg $.cx $.cy $.cz $.radius, x0, y0
x=x0-$.cx
y=y0-$.cy
@ -61,15 +61,15 @@ hitSphere: procedure expose z1 z2; parse arg $.cx $.cy $.cz $.radius, x0, y0
z1=$.cz-_
z2=$.cz+_
return 1
/*──────────────────────────────────"1-liner" subroutines───────────────*/
V3: procedure; parse arg v; return norm(v)
/*──────────────────────────────────one─liner subroutines────────────────────────────────────────────────────────────────────────────────────────────────────────*/
dot.: procedure; parse arg x,y; d=dot(x,y); if d<0 then return -d; return 0
dot: procedure; parse arg x,y; s=0; do j=1 for words(x); s=s+word(x,j)*word(y,j); end; return s
err: say; say; say center(' error! ',max(40,linesize()%2),"*"); say; do j=1 for arg(); say arg(j); say; end; say; exit 13
novalue: syntax: call err 'REXX program' condition('C') "error", condition('D'),'REXX source statement (line' sigl"):",sourceline(sigl)
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/_
noValue: syntax: call err 'REXX program' condition('C') "error", condition('D'),'REXX source statement (line' sigl"):",sourceline(sigl)
sqrt: procedure; parse arg x; if x=0 then return 0; return .sqrt(x)/1
.sqrt: d=digits();numeric digits 11;g=.sqrtG();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;return g
.sqrtG: numeric form; m.=11; p=d+d%4+2; v=format(x,2,1,,0) 'E0'; parse var v g 'E' _ .; return g*.5'E'_%2
V3: procedure; parse arg v; return norm(v)