RosettaCodeData/Task/Draw-a-sphere/ZX-Spectrum-Basic/draw-a-sphere.basic

53 lines
1.7 KiB
Plaintext

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