|
|
OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
RANDOMIZE
LET ZTH=0 ! z軸のまわりの回転角
LET XTH=0 ! x軸のまわりの回転角初期値
LET YTH=0 ! y軸のまわりの回転角初期値
LET LMIN=1E+10
LET LMAX=-1E+10
LET NN=40 !'分割数
LET MM=40
DIM M(4,4),POINT(4),ROTX(4,4),ROTY(4,4)
DIM XX(0 TO NN,0 TO MM),YY(0 TO NN,0 TO MM),ZZ(0 TO NN,0 TO MM)
MAT M=ROTATE(ZTH)
SET POINT STYLE 1
LET MODE=INT(RND*3)
LET RR=INT(RND*20)+5
LET R=INT(RND*5)+1
SELECT CASE MODE
CASE 0 !'トーラス
FOR J=0 TO MM
FOR I=0 TO NN
LET ALPHA=I*360/NN
LET BETA=J*360/MM
LET XX(I,J)=(RR+R*COS(ALPHA))*COS(BETA)
LET ZZ(I,J)=(RR+R*COS(ALPHA))*SIN(BETA)
LET YY(I,J)=R*SIN(ALPHA)
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 I
NEXT J
CASE 1 !'変形トーラス
LET R1=INT(RND*20)+1
LET R2=INT(RND*20)+1
LET K=INT(RND*20)+1
FOR J=0 TO MM
FOR I=0 TO NN
LET ALPHA=I*360/NN
LET BETA=J*360/MM
LET XX(I,J)=(R1+R*COS(ALPHA))*(R2+RR*COS(K*BETA))*COS(BETA)
LET ZZ(I,J)=(R1+R*COS(ALPHA))*(R2+RR*COS(K*BETA))*SIN(BETA)
LET YY(I,J)=R*SIN(ALPHA)*(R2+RR*COS(K*BETA))
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 I
NEXT J
CASE 2 !'歪んだトーラス
LET R1=INT(RND*10)+1
LET K=INT(RND*20)+1
FOR J=0 TO MM
FOR I=0 TO NN
LET ALPHA=I*360/NN
LET BETA=J*360/MM
LET XX(I,J)=(RR+R*COS(ALPHA))*COS(BETA)
LET ZZ(I,J)=(RR+R*COS(ALPHA))*SIN(BETA)
LET YY(I,J)=R*SIN(ALPHA)+R1*SIN(K*BETA)
LET MX=MX+XX(I,J)
LET MY=MY+YY(I,J)
LET MZ=MZ+ZZ(I,J)
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 I
NEXT J
END SELECT
LET MX=MX/NN/MM
LET MY=MY/NN/MM
LET MZ=MZ/NN/MM
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 J=0 TO MM-1
FOR I=0 TO NN-1
CALL PLOT(XX(I,J),YY(I,J),ZZ(I,J))
CALL PLOT(XX(I,J+1),YY(I,J+1),ZZ(I,J+1))
CALL PLOT(XX(I+1,J+1),YY(I+1,J+1),ZZ(I+1,J+1))
CALL PLOT(XX(I+1,J),YY(I+1,J),ZZ(I+1,J))
CALL PLOT(XX(I,J),YY(I,J),ZZ(I,J))
PLOT LINES
NEXT I
NEXT J
IF FL=0 THEN
SET WINDOW -LMAX*1.2,LMAX*1.2,-LMAX*1.2,LMAX*1.2
LET WW=LMAX*2.4
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$(NN*MM*2);
FOR I=0 TO NN-1
FOR J=0 TO MM-1
LET X1=XX(I+1,J+1)
LET Y1=YY(I+1,J+1)
LET Z1=ZZ(I+1,J+1)
LET X2=XX(I+1,J)
LET Y2=YY(I+1,J)
LET Z2=ZZ(I+1,J)
LET X3=XX(I,J)
LET Y3=YY(I,J)
LET Z3=ZZ(I,J)
LET X4=XX(I,J+1)
LET Y4=YY(I,J+1)
LET Z4=ZZ(I,J+1)
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 J
NEXT I
CLOSE #1
SUB PLOT(X,Y,Z)
LET POINT(1)=X-MX+XMOVE
LET POINT(2)=Y-MY+YMOVE
LET POINT(3)=Z-MZ+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 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 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 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
|
|