回転曲線

 投稿者:しばっち  投稿日:2013年 9月 2日(月)20時03分57秒
  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
 
 

戻る