超楕円体

 投稿者:しばっち  投稿日:2013年 9月 2日(月)20時04分42秒
  OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
RANDOMIZE
LET ZTH=0          ! z軸のまわりの回転角
LET XTH=0          ! x軸のまわりの回転角初期値
LET YTH=0          ! y軸のまわりの回転角初期値
LET N=30
LET LMIN=1E+10
LET LMAX=-1E+10
DIM M(4,4),POINT(4),ROTX(4,4),ROTY(4,4)
DIM XX(0 TO N,0 TO N),YY(0 TO N,0 TO N),ZZ(0 TO N,0 TO N)
MAT M=ROTATE(ZTH)
SET POINT STYLE 1
LET NN=RND*4
LET MM=RND*4
FOR I=0 TO N
   FOR J=0 TO N
      LET ALPHA=I*180/N
      LET BETA=J*360/N
      LET  XX(I,J)=-SGN(SIN(ALPHA))*ABS(SIN(ALPHA))^NN*SGN(COS(BETA))*ABS(COS(BETA))^MM
      LET  YY(I,J)=SGN(COS(ALPHA))*ABS(COS(ALPHA))^NN
      LET  ZZ(I,J)=SGN(SIN(ALPHA))*ABS(SIN(ALPHA))^NN*SGN(SIN(BETA))*ABS(SIN(BETA))^MM
      LET XMIN=MIN(XMIN,XX(I,J))
      LET XMAX=MAX(XMAX,XX(I,J))
      LET YMIN=MIN(YMIN,YY(I,J))
      LET YMAX=MAX(YMAX,YY(I,J))
      LET ZMIN=MIN(ZMIN,ZZ(I,J))
      LET ZMAX=MAX(ZMAX,ZZ(I,J))
   NEXT J
NEXT I
LET XDT=RND-.5
LET YDT=RND-.5
LET RANGE=MAX(XMAX-XMIN,MAX(YMAX-YMIN,ZMAX-ZMIN))
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
      FOR J=0 TO N
         CALL PLOT(XX(I,J),YY(I,J),ZZ(I,J))
      NEXT  J
      PLOT LINES
   NEXT  I
   FOR J=0 TO N
      FOR I=0 TO N
         CALL PLOT(XX(I,J),YY(I,J),ZZ(I,J))
      NEXT  I
      PLOT LINES
   NEXT  J
   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*N*N-N*2);
FOR I=0 TO N-1
   CALL VECTORNORMAL(XX(0,0),YY(0,0),ZZ(0,0),XX(1,I+1),YY(1,I+1),ZZ(1,I+1),XX(1,I),YY(1,I),ZZ(1,I),XS,YS,ZS)
   PRINT #1:MKS$(XS);
   PRINT #1:MKS$(YS);
   PRINT #1:MKS$(ZS);
   PRINT #1:MKS$(XX(0,0));
   PRINT #1:MKS$(YY(0,0));
   PRINT #1:MKS$(ZZ(0,0));
   PRINT #1:MKS$(XX(1,I+1));
   PRINT #1:MKS$(YY(1,I+1));
   PRINT #1:MKS$(ZZ(1,I+1));
   PRINT #1:MKS$(XX(1,I));
   PRINT #1:MKS$(YY(1,I));
   PRINT #1:MKS$(ZZ(1,I));
   PRINT #1:CHR$(0);CHR$(0);
NEXT I
FOR I=1 TO N-2
   FOR J=1 TO N
      CALL VECTORNORMAL(XX(I+1,J),YY(I+1,J),ZZ(I+1,J),XX(I+1,J-1),YY(I+1,J-1),ZZ(I+1,J-1),XX(I,J-1),YY(I,J-1),ZZ(I,J-1),XS,YS,ZS)
      PRINT #1:MKS$(XS);
      PRINT #1:MKS$(YS);
      PRINT #1:MKS$(ZS);
      PRINT #1:MKS$(XX(I+1,J));
      PRINT #1:MKS$(YY(I+1,J));
      PRINT #1:MKS$(ZZ(I+1,J));
      PRINT #1:MKS$(XX(I+1,J-1));
      PRINT #1:MKS$(YY(I+1,J-1));
      PRINT #1:MKS$(ZZ(I+1,J-1));
      PRINT #1:MKS$(XX(I,J-1));
      PRINT #1:MKS$(YY(I,J-1));
      PRINT #1:MKS$(ZZ(I,J-1));
      PRINT #1:CHR$(0);CHR$(0);
      CALL VECTORNORMAL(XX(I+1,J),YY(I+1,J),ZZ(I+1,J),XX(I,J-1),YY(I,J-1),ZZ(I,J-1),XX(I,J),YY(I,J),ZZ(I,J),XS,YS,ZS)
      PRINT #1:MKS$(XS);
      PRINT #1:MKS$(YS);
      PRINT #1:MKS$(ZS);
      PRINT #1:MKS$(XX(I+1,J));
      PRINT #1:MKS$(YY(I+1,J));
      PRINT #1:MKS$(ZZ(I+1,J));
      PRINT #1:MKS$(XX(I,J-1));
      PRINT #1:MKS$(YY(I,J-1));
      PRINT #1:MKS$(ZZ(I,J-1));
      PRINT #1:MKS$(XX(I,J));
      PRINT #1:MKS$(YY(I,J));
      PRINT #1:MKS$(ZZ(I,J));
      PRINT #1:CHR$(0);CHR$(0);
   NEXT J
NEXT I
FOR I=1 TO N
   CALL VECTORNORMAL(XX(N,N),YY(N,N),ZZ(N,N),XX(N-1,I-1),YY(N-1,I-1),ZZ(N-1,I-1),XX(N-1,I),YY(N-1,I),ZZ(N-1,I),XS,YS,ZS)
   PRINT #1:MKS$(XS);
   PRINT #1:MKS$(YS);
   PRINT #1:MKS$(ZS);
   PRINT #1:MKS$(XX(N,N));
   PRINT #1:MKS$(YY(N,N));
   PRINT #1:MKS$(ZZ(N,N));
   PRINT #1:MKS$(XX(N-1,I-1));
   PRINT #1:MKS$(YY(N-1,I-1));
   PRINT #1:MKS$(ZZ(N-1,I-1));
   PRINT #1:MKS$(XX(N-1,I));
   PRINT #1:MKS$(YY(N-1,I));
   PRINT #1:MKS$(ZZ(N-1,I));
   PRINT #1:CHR$(0);CHR$(0);
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  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

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
 

戻る