星型多角形

 投稿者:しばっち  投稿日:2017年10月29日(日)14時55分40秒
  OPTION ARITHMETIC NATIVE
RANDOMIZE
OPTION ANGLE DEGREES
LET ZTH=0          ! z軸のまわりの回転角
LET XTH=0          ! x軸のまわりの回転角初期値
LET YTH=0          ! y軸のまわりの回転角初期値
LET N=30
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
DEF FF(X)=.5*(IP(X)-IP(-X)-1)
DEF S2(X)=X+IP(-X)+1
DEF A(N)=360/N
DEF K(A,B,X)=FF((X+A)/(A+B))-FF(X/(A+B))
DEF KK(A,B,X)=2*(K(A,B,X)-.5)
DEF S(A,X)=2*ABS(S2(X/(A*2))-.5)*KK(A*2,A*2,X+A)
!'DEF ACC(X)=-.5*PI*(S(.5*PI,X)+1)
DEF ACC(X)=ACOS(COS(X))
DEF CNS(N,T)=COS(A(N))/COS(A(N)-ACC(N*T)/N)
DEF PC(N,T)=COS(T)*CNS(N,T)
DEF PS(N,T)=SIN(T)*CNS(N,T)
DEF P3X(N,U,V)=PS(N,U)*PC(N,V)
DEF P3Y(N,U,V)=PS(N,U)*PS(N,V)
DEF P3Z(N,U)=PC(N,U)
INPUT  PROMPT "何角形 =":NN !'NN>=5
FOR I=0 TO N
   FOR J=0 TO N
      LET ALPHA=I*180/N
      LET BETA=J*360/N
      LET XX(I,J)=P3X(NN,ALPHA,BETA)
      LET YY(I,J)=P3Y(NN,ALPHA,BETA)
      LET ZZ(I,J)=P3Z(NN,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 J
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
      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.2,LMAX*1.2,LMIN*1.2,LMAX*1.2
      LET WW=(LAMX-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
      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

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
 

戻る