|
|
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
|
|