|
|
RANDOMIZE
OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
LET ZTH=0 ! z軸のまわりの回転角
LET XTH=0 ! x軸のまわりの回転角初期値
LET YTH=0 ! y軸のまわりの回転角初期値
LET N=360 !'周期
LET NN=8 !'分割数
LET LL=5 !'チューブ太さ
LET RR=100 !'半径
DIM M(4,4),POINT(4),ROTX(4,4),ROTY(4,4)
DIM XN(0 TO NN),YN(0 TO NN),ZN(0 TO NN),XM(0 TO NN),YM(0 TO NN),ZM(0 TO NN)
DIM XX(0 TO N+1),YY(0 TO N+1),ZZ(0 TO N+1)
MAT M=ROTATE(ZTH)
SET POINT STYLE 1
LET A=INT(RND*20+1)
LET B=INT(RND*20+1)
FOR I=0 TO N+1
LET XX(I)=RR*SIN(A*I)*COS(B*I)
LET ZZ(I)=RR*SIN(A*I)*SIN(B*I)
LET YY(I)=RR*COS(A*I)
LET XMIN=MIN(XMIN,XX(I))
LET XMAX=MAX(XMAX,XX(I))
LET YMIN=MIN(YMIN,YY(I))
LET YMAX=MAX(YMAX,YY(I))
LET ZMIN=MIN(ZMIN,ZZ(I))
LET ZMAX=MAX(ZMAX,ZZ(I))
NEXT I
LET RANGE=MAX(XMAX-XMIN,MAX(YMAX-YMIN,ZMAX-ZMIN))
LET XDT=RND-.5
LET YDT=RND-.5
LET LMIN=1E+10
LET LMAX=-1E+10
LOCATE VALUE NOWAIT(1),RANGE 0 TO 2,AT 1 : SCALE
LOCATE VALUE NOWAIT(2),RANGE -3 TO 5,AT 1 : SPEED
LOCATE VALUE NOWAIT(3),RANGE -RANGE TO RANGE,AT 0 : XMOVE
LOCATE VALUE NOWAIT(4),RANGE -RANGE TO RANGE,AT 0 : YMOVE
LOCATE VALUE NOWAIT(5),RANGE -RANGE TO RANGE,AT 0 : ZMOVE
DO
LOCATE VALUE NOWAIT(1): SCALE
LOCATE VALUE NOWAIT(2): SPEED
LOCATE VALUE NOWAIT(3): XMOVE
LOCATE VALUE NOWAIT(4): YMOVE
LOCATE VALUE NOWAIT(5): ZMOVE
MAT ROTX=IDN ! x軸のまわりの回転
LET ROTX(2,2)=COS(XTH)
LET ROTX(2,3)=SIN(XTH)
LET ROTX(3,2)=-SIN(XTH)
LET ROTX(3,3)=COS(XTH)
MAT ROTY=IDN ! y軸のまわりの回転
LET ROTY(1,1)=COS(YTH)
LET ROTY(1,3)=-SIN(YTH)
LET ROTY(3,1)=SIN(YTH)
LET ROTY(3,3)=COS(YTH)
MAT M=M * ROTX * ROTY
SET DRAW MODE HIDDEN
CLEAR
FOR I=0 TO N+1
CALL PLOT(XX(I),YY(I),ZZ(I))
NEXT I
PLOT LINES
IF FL=0 THEN
SET WINDOW LMIN*1.5,LMAX*1.5,LMIN*1.5,LMAX*1.5
LET WW=(LMAX-LMIN)*1.5
END IF
LET FL=1
SET DRAW MODE EXPLICIT
MOUSE POLL X,Y,L,R
IF R<>0 THEN EXIT DO
LET XTH=0
LET YTH=0
IF L<>0 THEN
DO WHILE L<>0
MOUSE POLL X,Y,L,R
LOOP
LET XDT=-(Y-Y0)/WW*5
LET YDT= (X-X0)/WW*5
LET XDT=MAX(-5,MIN(5,XDT))
LET YDT=MAX(-5,MIN(5,YDT))
ELSE
LET XTH=XTH+XDT*SPEED
LET YTH=YTH+YDT*SPEED
END IF
LET X0=X
LET Y0=Y
LOOP
FILE GETSAVENAME F$,"STLファイル|*.stl"
IF F$="" THEN STOP
IF POS(UCASE$(F$),".STL")=0 THEN LET F$=F$ & ".stl"
OPEN #1:NAME F$
ERASE #1
PRINT #1:REPEAT$(CHR$(0),80);
PRINT #1:MKL$(2*NN*N);
FOR I=0 TO N
LET XA=XX(I+1)-XX(I)
LET YA=YY(I+1)-YY(I)
LET ZA=ZZ(I+1)-ZZ(I)
LET VX=YY(I+1)*ZZ(I)-ZZ(I+1)*YY(I)
LET VY=ZZ(I+1)*XX(I)-XX(I+1)*ZZ(I)
LET VZ=XX(I+1)*YY(I)-YY(I+1)*XX(I)
LET SS=SQR(VX^2+VY^2+VZ^2)
IF SS=0 THEN
LET VX=(YY(I+1)+1)*(ZZ(I)+1)-(ZZ(I+1)+1)*(YY(I)+1)
LET VY=(ZZ(I+1)+1)*(XX(I)+1)-(XX(I+1)+1)*(ZZ(I)+1)
LET VZ=(XX(I+1)+1)*(YY(I)+1)-(YY(I+1)+1)*(XX(I)+1)
LET SS=SQR(VX^2+VY^2+VZ^2)
END IF
LET VX=VX/SS
LET VY=VY/SS
LET VZ=VZ/SS
LET TX=XA+VX*LL
LET TY=YA+VY*LL
LET TZ=ZA+VZ*LL
FOR K=0 TO NN-1
CALL ROTATE(TX,TY,TZ,XA,YA,ZA,K*360/NN,XO,YO,ZO)
LET XN(K)=XO+XX(I)
LET YN(K)=YO+YY(I)
LET ZN(K)=ZO+ZZ(I)
NEXT K
IF I>0 THEN
FOR K=0 TO NN-1
LET X1=XM(K)
LET Y1=YM(K)
LET Z1=ZM(K)
IF K=NN-1 THEN
LET X2=XM(0)
LET Y2=YM(0)
LET Z2=ZM(0)
ELSE
LET X2=XM(K+1)
LET Y2=YM(K+1)
LET Z2=ZM(K+1)
END IF
IF K=NN-1 THEN
LET X3=XN(0)
LET Y3=YN(0)
LET Z3=ZN(0)
ELSE
LET X3=XN(K+1)
LET Y3=YN(K+1)
LET Z3=ZN(K+1)
END IF
LET X4=XN(K)
LET Y4=YN(K)
LET Z4=ZN(K)
CALL VECTORNORMAL(X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,XS,YS,ZS)
PRINT #1:MKS$(XS);
PRINT #1:MKS$(YS);
PRINT #1:MKS$(ZS);
PRINT #1:MKS$(X1);
PRINT #1:MKS$(Y1);
PRINT #1:MKS$(Z1);
PRINT #1:MKS$(X2);
PRINT #1:MKS$(Y2);
PRINT #1:MKS$(Z2);
PRINT #1:MKS$(X3);
PRINT #1:MKS$(Y3);
PRINT #1:MKS$(Z3);
PRINT #1:CHR$(0);CHR$(0);
CALL VECTORNORMAL(X1,Y1,Z1,X3,Y3,Z3,X4,Y4,Z4,XS,YS,ZS)
PRINT #1:MKS$(XS);
PRINT #1:MKS$(YS);
PRINT #1:MKS$(ZS);
PRINT #1:MKS$(X1);
PRINT #1:MKS$(Y1);
PRINT #1:MKS$(Z1);
PRINT #1:MKS$(X3);
PRINT #1:MKS$(Y3);
PRINT #1:MKS$(Z3);
PRINT #1:MKS$(X4);
PRINT #1:MKS$(Y4);
PRINT #1:MKS$(Z4);
PRINT #1:CHR$(0);CHR$(0);
NEXT K
END IF
MAT XM=XN
MAT YM=YN
MAT ZM=ZN
NEXT I
CLOSE #1
SUB PLOT(X,Y,Z)
LET POINT(1)=X+XMOVE
LET POINT(2)=Y+YMOVE
LET POINT(3)=Z+ZMOVE
MAT POINT=POINT*M
IF FL=0 THEN
LET LMIN=MIN(LMIN,POINT(1))
LET LMAX=MAX(LMAX,POINT(1))
LET LMIN=MIN(LMIN,POINT(2))
LET LMAX=MAX(LMAX,POINT(2))
ELSE
PLOT LINES:POINT(1)*SCALE,POINT(2)*SCALE;
END IF
END SUB
END
EXTERNAL SUB ROTATE(XX,YY,ZZ,X0,Y0,Z0,TH,NX,NY,NZ)
OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
DIM A(3,3)
LET S=SQR(X0*X0+Y0*Y0+Z0*Z0)
LET X=X0/S
LET Y=Y0/S
LET Z=Z0/S
LET A(1,1)=X*X*(1-COS(TH))+COS(TH)
LET A(1,2)=X*Y*(1-COS(TH))+Z*SIN(TH)
LET A(1,3)=X*Z*(1-COS(TH))-Y*SIN(TH)
LET A(2,1)=Y*X*(1-COS(TH))-Z*SIN(TH)
LET A(2,2)=Y*Y*(1-COS(TH))+COS(TH)
LET A(2,3)=Y*Z*(1-COS(TH))+X*SIN(TH)
LET A(3,1)=Z*X*(1-COS(TH))+Y*SIN(TH)
LET A(3,2)=Z*Y*(1-COS(TH))-X*SIN(TH)
LET A(3,3)=Z*Z*(1-COS(TH))+COS(TH)
LET NX=XX*A(1,1)+YY*A(1,2)+ZZ*A(1,3)
LET NY=XX*A(2,1)+YY*A(2,2)+ZZ*A(2,3)
LET NZ=XX*A(3,1)+YY*A(3,2)+ZZ*A(3,3)
END SUB
EXTERNAL SUB VECTORNORMAL(X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,XX,YY,ZZ)
OPTION ARITHMETIC NATIVE
LET XX=(Y3-Y2)*(Z1-Z3)-(Z3-Z2)*(Y1-Y3)
LET YY=(Z3-Z2)*(X1-X3)-(X3-X2)*(Z1-Z3)
LET ZZ=(X3-X2)*(Y1-Y3)-(Y3-Y2)*(X1-X3)
LET S=SQR(XX^2+YY^2+ZZ^2)
IF S<>0 THEN
LET XX=XX/S
LET YY=YY/S
LET ZZ=ZZ/S
END IF
END SUB
EXTERNAL FUNCTION MKS$(X)
OPTION ARITHMETIC NATIVE
OPTION CHARACTER BYTE
OPTION BASE 0
DIM B(32)
IF X<0 THEN LET B(0)=1
IF X<>0 THEN
IF ABS(X)<1 THEN
DO WHILE 2^(N+1)>ABS(X)
LET N=N-1
LOOP
LET N=N+1
ELSE
DO WHILE 2^(N+1)<ABS(X)
LET N=N+1
LOOP
END IF
LET NN=N
LET N=N+127
FOR I=1 TO 8
IF BITAND(N,2^(8-I))<>0 THEN LET B(I)=1
NEXT I
LET T=(ABS(X)-2^NN)/2^NN
FOR I=9 TO 31
LET T=T*2
IF T>=1 THEN
LET B(I)=1
LET T=T-INT(T)
END IF
NEXT I
END IF
LET AA$=CHR$(B(0)*128+B(1)*64+B(2)*32+B(3)*16+B(4)*8+B(5)*4+B(6)*2+B(7))
LET BB$=CHR$(B(8)*128+B(9)*64+B(10)*32+B(11)*16+B(12)*8+B(13)*4+B(14)*2+B(15))
LET CC$=CHR$(B(16)*128+B(17)*64+B(18)*32+B(19)*16+B(20)*8+B(21)*4+B(22)*2+B(23))
LET DD$=CHR$(B(24)*128+B(25)*64+B(26)*32+B(27)*16+B(28)*8+B(29)*4+B(30)*2+B(31))
LET MKS$=DD$&CC$&BB$&AA$
END FUNCTION
EXTERNAL FUNCTION MKL$(A)
OPTION ARITHMETIC NATIVE
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$&B$&C$&D$
END FUNCTION
|
|