ケーリーツリー

 投稿者:しばっち  投稿日:2013年 9月 2日(月)20時00分44秒
  RANDOMIZE
OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
PUBLIC NUMERIC K,XX(2730),YY(2730),ZZ(2730) !' 2+8*(4^(LEV-1)-1)/3
LET ZTH=0          ! z軸のまわりの回転角
LET XTH=0          ! x軸のまわりの回転角初期値
LET YTH=0          ! y軸のまわりの回転角初期値
DIM M(4,4),POINT(4),ROTX(4,4),ROTY(4,4)
MAT M=ROTATE(ZTH)
SET POINT STYLE 1
LET LMIN=1E+10
LET LMAX=-1E+10
LET LL=2^9  !'TREEの大きさ
INPUT  PROMPT "LEVEL(2<=LEV<=6)=":LEV
CALL TREE(LEV,0,0,0,0,LL,0,LL)
FOR I=1 TO K
   LET MX=MX+XX(I)
   LET MY=MY+YY(I)
   LET MZ=MZ+ZZ(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 MX=MX/K
LET MY=MY/K
LET MZ=MZ/K
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=1 TO K STEP 2
      CALL  PLOTLINE(XX(I),YY(I),ZZ(I),XX(I+1),YY(I+1),ZZ(I+1))
   NEXT I
   IF FL=0 THEN
      SET WINDOW -LMAX*1.2,LMAX*1.2,-LMAX*1.2,LMAX*1.2
      LET WW=(LMAX-LMIN)*1.2
   END IF
   LET FL=1
   SET DRAW MODE EXPLICIT
   MOUSE POLL X,Y,L,R
   IF R<>0 THEN STOP
   LET XTH=0
   LET YTH=0
   IF L<>0 THEN
      LET X0=X
      LET Y0=Y
      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(-2,MIN(2,XDT))
      LET YDT=MAX(-2,MIN(2,YDT))
   ELSE
      LET XTH=XTH+XDT*SPEED
      LET YTH=YTH+YDT*SPEED
   END IF
   LET X0=X
   LET Y0=Y
LOOP

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

SUB PLOTLINE(X1,Y1,Z1,X2,Y2,Z2)
   PLOT LINES
   CALL PLOT(X1,Y1,Z1)
   CALL PLOT(X2,Y2,Z2)
   PLOT LINES
END SUB
END

EXTERNAL  SUB TREE(N,XS,YS,ZS,XE,YE,ZE,L)
OPTION ARITHMETIC NATIVE
IF N>0 THEN
   LET K=K+1
   LET XX(K)=XS
   LET YY(K)=YS
   LET ZZ(K)=ZS
   LET K=K+1
   LET XX(K)=XE
   LET YY(K)=YE
   LET ZZ(K)=ZE
   LET X=XE-XS
   LET Y=YE-YS
   LET Z=ZE-ZS
   IF X<>0 THEN
      CALL TREE(N-1,XE,YE,ZE,XE,YE,ZE+L/2,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE,ZE-L/2,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE+L/2,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE-L/2,ZE,L/2)
   END IF
   IF Y<>0 THEN
      CALL TREE(N-1,XE,YE,ZE,XE+L/2,YE,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE-L/2,YE,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE,ZE+L/2,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE,ZE-L/2,L/2)
   END IF
   IF Z<>0 THEN
      CALL TREE(N-1,XE,YE,ZE,XE+L/2,YE,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE-L/2,YE,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE+L/2,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE-L/2,ZE,L/2)
   END IF
END IF
END SUB
 

戻る