2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,6 +1,7 @@
|
|||
The task is to draw a sphere.
|
||||
;Task:
|
||||
Draw a sphere.
|
||||
|
||||
The sphere can be represented graphically, or in ascii art,
|
||||
depending on the language capabilities.
|
||||
The sphere can be represented graphically, or in ASCII art, depending on the language capabilities.
|
||||
|
||||
Either static or rotational projection is acceptable for this task.
|
||||
<br><br>
|
||||
|
|
|
|||
101
Task/Draw-a-sphere/ATS/draw-a-sphere.ats
Normal file
101
Task/Draw-a-sphere/ATS/draw-a-sphere.ats
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
(*
|
||||
** Solution to Draw_a_sphere.dats
|
||||
*)
|
||||
|
||||
(* ****** ****** *)
|
||||
//
|
||||
#include
|
||||
"share/atspre_define.hats" // defines some names
|
||||
#include
|
||||
"share/atspre_staload.hats" // for targeting C
|
||||
#include
|
||||
"share/HATS/atspre_staload_libats_ML.hats" // for ...
|
||||
#include
|
||||
"share/HATS/atslib_staload_libats_libc.hats" // for libc
|
||||
//
|
||||
(* ****** ****** *)
|
||||
|
||||
extern
|
||||
fun
|
||||
Draw_a_sphere
|
||||
(
|
||||
R: double, k: double, ambient: double
|
||||
) : void // end of [Draw_a_sphere]
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
implement
|
||||
Draw_a_sphere
|
||||
(
|
||||
R: double, k: double, ambient: double
|
||||
) = let
|
||||
fun normalize(v0: double, v1: double, v2: double): (double, double, double) = let
|
||||
val len = sqrt(v0*v0+v1*v1+v2*v2)
|
||||
in
|
||||
(v0/len, v1/len, v2/len)
|
||||
end // end of [normalize]
|
||||
|
||||
fun dot(v0: double, v1: double, v2: double, x0: double, x1: double, x2: double): double = let
|
||||
val d = v0*x0+v1*x1+v2*x2
|
||||
val sgn = gcompare_val_val<double> (d, 0.0)
|
||||
in
|
||||
if sgn < 0 then ~d else 0.0
|
||||
end // end of [dot]
|
||||
|
||||
fun print_char(i: int): void =
|
||||
if i = 0 then print!(".") else
|
||||
if i = 1 then print!(":") else
|
||||
if i = 2 then print!("!") else
|
||||
if i = 3 then print!("*") else
|
||||
if i = 4 then print!("o") else
|
||||
if i = 5 then print!("e") else
|
||||
if i = 6 then print!("&") else
|
||||
if i = 7 then print!("#") else
|
||||
if i = 8 then print!("%") else
|
||||
if i = 9 then print!("@") else print!(" ")
|
||||
|
||||
val i_start = floor(~R)
|
||||
val i_end = ceil(R)
|
||||
val j_start = floor(~2 * R)
|
||||
val j_end = ceil(2 * R)
|
||||
val (l0, l1, l2) = normalize(30.0, 30.0, ~50.0)
|
||||
|
||||
fun loopj(j: int, j_end: int, x: double): void = let
|
||||
val y = j / 2.0 + 0.5;
|
||||
val sgn = gcompare_val_val<double> (x*x + y*y, R*R)
|
||||
val (v0, v1, v2) = normalize(x, y, sqrt(R*R - x*x - y*y))
|
||||
val b = pow(dot(l0, l1, l2, v0, v1, v2), k) + ambient
|
||||
val intensity = 9.0 - 9.0*b
|
||||
val sgn2 = gcompare_val_val<double> (intensity, 0.0)
|
||||
val sgn3 = gcompare_val_val<double> (intensity, 9.0)
|
||||
in
|
||||
( if sgn > 0 then print_char(10) else
|
||||
if sgn2 < 0 then print_char(0) else
|
||||
if sgn3 >= 0 then print_char(8) else
|
||||
print_char(g0float2int(intensity));
|
||||
if j < j_end then loopj(j+1, j_end, x)
|
||||
)
|
||||
end // end of [loopj]
|
||||
|
||||
fun loopi(i: int, i_end: int, j: int, j_end: int): void = let
|
||||
val x = i + 0.5
|
||||
val () = loopj(j, j_end, x)
|
||||
val () = println!()
|
||||
in
|
||||
if i < i_end then loopi(i+1, i_end, j, j_end)
|
||||
end // end of [loopi]
|
||||
|
||||
in
|
||||
loopi(g0float2int(i_start), g0float2int(i_end), g0float2int(j_start), g0float2int(j_end))
|
||||
end
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
implement
|
||||
main0() = () where
|
||||
{
|
||||
val () = DrawSphere(20.0, 4.0, .1)
|
||||
val () = DrawSphere(10.0, 2.0, .4)
|
||||
} (* end of [main0] *)
|
||||
|
||||
(* ****** ****** *)
|
||||
|
|
@ -42,7 +42,7 @@ Next
|
|||
Locate 50,2
|
||||
Color(RGB(255,255,255),RGB(0,0,0)) ' foreground color is changed
|
||||
' empty keyboard buffer
|
||||
While InKey <> "" : Var _key_ = InKey : Wend
|
||||
While InKey <> "" : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
|
|
|
|||
40
Task/Draw-a-sphere/Batch-File/draw-a-sphere.bat
Normal file
40
Task/Draw-a-sphere/Batch-File/draw-a-sphere.bat
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
@echo off
|
||||
setlocal enabledelayedexpansion
|
||||
mode con cols=80
|
||||
|
||||
set /a r=220,cent=340,r2=r/2
|
||||
set "spaces= "
|
||||
set "block1=MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM"
|
||||
set "block2=#########"
|
||||
set "block3=XXXXXXXXX"
|
||||
set "block4=ooooooooo"
|
||||
set "block5=?????????"
|
||||
set "block6=*********"
|
||||
set "block7=~~~~~~~~~"
|
||||
set "block8=---------"
|
||||
|
||||
set wy=0
|
||||
set linea=
|
||||
echo Batch-File ASCII Ball
|
||||
echo.
|
||||
for /L %%y in (-%r%,10,%r%) do (
|
||||
set /a "w1=r*r-%%y*%%y"
|
||||
call:sqrt2 w1 w1
|
||||
set /a "w1=14*w1/10,wy=(cent-w1),cnt=0,sp=wy/10,centre=cent/10-sp"
|
||||
call set "linea=%%spaces:~0,!sp!%%%%block1:~0,!centre!%%
|
||||
set /a wy=0,sum=0
|
||||
for %%i in (30 80 120 150 170 185 195 200) do (
|
||||
set /a "cnt+=1,wy2=(%%i+r2)*w1/r,ww=(wy2+5)/10-sum,wy=wy2,sum+=ww"
|
||||
call set miblock=%%block!cnt!%%
|
||||
call set "Linea=%%linea%%%%miblock:~0,!ww!%%"
|
||||
)
|
||||
call echo(!linea!
|
||||
)
|
||||
echo.
|
||||
exit /b
|
||||
|
||||
:sqrt2 [num] calculates integer square root . By AAcini
|
||||
set "s=!%~1!"
|
||||
set /A "x=s/(11*1024)+40,x=(s/x+x)>>1,x=(s/x+x)>>1,x=(s/x+x)>>1,x=(s/x+x)>>1,x=(s/x+x)>>1,x+=(s-x*x)>>31
|
||||
set %~2=%x%
|
||||
exit /b
|
||||
1
Task/Draw-a-sphere/Maple/draw-a-sphere.maple
Normal file
1
Task/Draw-a-sphere/Maple/draw-a-sphere.maple
Normal file
|
|
@ -0,0 +1 @@
|
|||
plots[display](plottools[sphere](), axes = none, style = surface);
|
||||
|
|
@ -1,39 +1,38 @@
|
|||
/*REXX program expresses a lighted sphere with simple characters for shading.*/
|
||||
call drawSphere 19, 4, 2/10 /*draw a sphere with a radius of 19. */
|
||||
call drawSphere 10, 2, 4/10 /* " " " " " " " ten. */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*─────────────────────────────────────one─liner 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/_
|
||||
/*──────────────────────────────────DRAWSPHERE 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' /*position of light source.*/
|
||||
parse value norm(lightSource) with s1 s2 s3 /*normalize light source. */
|
||||
sLen=length(shading)-1; rr=r*r /*handy─dandy variables. */
|
||||
/*REXX program expresses a lighted sphere with simple characters used for shading. */
|
||||
call drawSphere 19, 4, 2/10 /*draw a sphere with a radius of 19. */
|
||||
call drawSphere 10, 2, 4/10 /* " " " " " " " ten. */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
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 $a $b $c; _=sqrt($a**2 + $b**2 + $c**2); return $a/_ $b/_ $c/_
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
drawSphere: procedure; parse arg r, k, ambient /*get the arguments from CL*/
|
||||
if 5=='f5'x then shading= ".:!*oe&#%@" /* EBCDIC dithering chars. */
|
||||
else shading= "·:!°oe@░▒▓" /* ASCII " " */
|
||||
lightSource= '30 30 -50' /*position of light source.*/
|
||||
parse value norm(lightSource) with s1 s2 s3 /*normalize light source. */
|
||||
sLen=length(shading)-1; rr=r*r /*handy─dandy variables. */
|
||||
|
||||
do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; $=
|
||||
do j=floor(-2*r) to ceil(r+r); y=j/2+.5; yy=y**2
|
||||
if xx+yy<=rr then do /*is point within sphere ? */
|
||||
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 positive, make it zero*/
|
||||
b=abs(dot)**k + ambient /*calculate the brightness.*/
|
||||
if b<=0 then brite=sLen
|
||||
else brite=trunc( max( (1-b) * sLen, 0) )
|
||||
$=($)substr(shading,brite+1,1) /*build a display line.*/
|
||||
end
|
||||
else $=$' ' /*append a blank to line. */
|
||||
end /*j*/
|
||||
say strip($,'trailing') /*show a line of the sphere*/
|
||||
end /*i*/ /* [↑] display the sphere.*/
|
||||
return
|
||||
/*──────────────────────────────────SQRT subroutine───────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
|
||||
numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
|
||||
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2
|
||||
do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
|
||||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
|
||||
numeric digits d; return (g/1)i /*make complex if X < 0.*/
|
||||
do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; $=
|
||||
do j=floor(-2*r) to ceil(r+r); y=j/2+.5; yy=y**2
|
||||
if xx+yy<=rr then do /*is point within sphere ? */
|
||||
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 positive, make it zero*/
|
||||
b=abs(dot)**k + ambient /*calculate the brightness.*/
|
||||
if b<=0 then brite=sLen
|
||||
else brite=trunc( max( (1-b) * sLen, 0) )
|
||||
$=($)substr(shading,brite+1,1) /*construct a display line.*/
|
||||
end
|
||||
else $=$' ' /*append a blank to line. */
|
||||
end /*j*/
|
||||
say strip($, 'T') /*show a line of the sphere*/
|
||||
end /*i*/ /* [↑] display the sphere.*/
|
||||
return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form
|
||||
numeric digits; parse value format(x,2,1,,0) 'E0' with g "E" _ .; g=g*.5'e'_%2
|
||||
h=d+6; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
|
||||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
|
||||
numeric digits d; return g/1
|
||||
|
|
|
|||
52
Task/Draw-a-sphere/ZX-Spectrum-Basic/draw-a-sphere.zx
Normal file
52
Task/Draw-a-sphere/ZX-Spectrum-Basic/draw-a-sphere.zx
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
1 REM fast
|
||||
50 REM spheer with hidden lines and rotation
|
||||
100 CLS
|
||||
110 PRINT "sphere with lenght&wide-circles"
|
||||
120 PRINT "_______________________________"''
|
||||
200 INPUT "rotate x-as:";a
|
||||
210 INPUT "rotate y-as:";b
|
||||
220 INPUT "rotate z-as:";c
|
||||
225 INPUT "distance lines(10-45):";d
|
||||
230 LET u=128: LET v=87: LET r=87: LET bm=PI/180: LET h=.5
|
||||
240 LET s1=SIN (a*bm): LET s2=SIN (b*bm): LET s3=SIN (c*bm)
|
||||
250 LET c1=COS (a*bm): LET c2=COS (b*bm): LET c3=COS (c*bm)
|
||||
260 REM calc rotate matrix
|
||||
270 LET ax=c2*c3: LET ay=-c2*s3: LET az=s2
|
||||
280 LET bx=c1*s3+s1*s2*c3
|
||||
290 LET by=c1*c3-s1*s2*s3: LET bz=-s1*c2
|
||||
300 LET cx=s1*s3-c1*s2*c3
|
||||
310 LET cy=s1*c3+c1*s2*s3: LET cz=c1*c2
|
||||
400 REM draw outer
|
||||
410 CLS : CIRCLE u,v,r
|
||||
500 REM draw lenght-circle
|
||||
510 FOR l=0 TO 180-d STEP d
|
||||
515 LET f1=0
|
||||
520 FOR p=0 TO 360 STEP 5
|
||||
530 GO SUB 1000: REM xx,yy,zz calc
|
||||
540 IF yy>0 THEN LET f2=0: LET f1=0: GO TO 580
|
||||
550 LET xb=INT (u+xx+h): LET yb=INT (v+zz+h): LET f2=1
|
||||
560 IF f1=0 THEN LET x1=xb: LET y1=yb: LET f1=1: GO TO 580
|
||||
570 PLOT x1,y1: DRAW xb-x1,yb-y1: LET x1=xb: LET y1=yb: LET f1=f2
|
||||
580 NEXT p
|
||||
590 NEXT l
|
||||
600 REM draw wide-circle
|
||||
610 FOR p=-90+d TO 90-d STEP d
|
||||
615 LET f1=0
|
||||
620 FOR l=0 TO 360 STEP 5
|
||||
630 GO SUB 1000: REM xx,yy,zz
|
||||
640 IF yy>0 THEN LET f2=0: LET f1=0: GO TO 680
|
||||
650 LET xb=INT (u+xx+h): LET yb=INT (v+zz+h): LET f2=1
|
||||
660 IF f1=0 THEN LET x1=xb: LET y1=yb: LET f1=1: GO TO 680
|
||||
670 PLOT x1,y1: DRAW xb-x1,yb-y1: LET x1=xb: LET y1=yb: LET f1=f2
|
||||
680 NEXT l
|
||||
690 NEXT p
|
||||
700 PRINT #0;"...press any key...": PAUSE 0: RUN
|
||||
999 REM sfere-coordinates>>>Cartesis Coordinate
|
||||
1000 LET x=r*COS (p*bm)*COS (l*bm)
|
||||
1010 LET y=r*COS (p*bm)*SIN (l*bm)
|
||||
1020 LET z=r*SIN (p*bm)
|
||||
1030 REM p(x,y,z) rotate to p(xx,yy,zz)
|
||||
1040 LET xx=ax*x+ay*y+az*z
|
||||
1050 LET yy=bx*x+by*y+bz*z
|
||||
1060 LET zz=cx*x+cy*y+cz*z
|
||||
1070 RETURN
|
||||
Loading…
Add table
Add a link
Reference in a new issue