3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時04分8秒
  外積を使って3次元図形表示をします。

まず、座標系として上向きをY軸(Z軸ではありません)とし、奥行きを手前に向かってZ軸とする
右手系を使用します。

 y
 │
 ・─ x

z

簡単にするため光源は平行光源とし、平行投影(Z座標を無視)で描写して、拡大縮小はWINDOW文で行います。
ワイヤーフレームではなく、隠面処理したサーフェスモデルでレンダリング(描画)を行います。


それには頂点データ(座標値 X,Y,Z)とメッシュデータ(どの頂点と頂点をどう繋いでいくか)を
用意します。この方法はデータさえ揃えればいろいろと描画させることができます。

頂点データとは単に座標値のことで、頂点には順に番号が振られます。
座標値を配列変数でX(n),Y(n),Z(n)とするならば添え字のnが頂点番号となります。

Meshデータとはどの頂点とを結んでいくかで、頂点にふられた頂点番号(添え字)を使って3角形、又は
4角形以上(※全ての頂点が同一平面上にあること)で構成します。また、4角形以上は3角形に分割できます。

ややこしいのですがメッシュデータには「裏・表」があり、頂点(1,2,3)とする3角形が「表」向きとするなら頂点(3,2,1)では「裏」
向きとなります。

裏・表の判断には法線ベクトルを使い、外積によってそれを求めます。
そして表向きとなる面だけを描画していけばオブジェクトの表示ができます。


3角形等はPLOT AREA文で描画できます。
十進BASICのPLOT AREA文は描画が非常に高速なので、アニメーション表示が可能です。
スライドバーで動かせます。
2進モードで実行してください。


※外積を使った方法は、オブジェクトに凹み等があると正しく描画できません。

4面体を表示します(外積)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
DIM X0(4),Y0(4),Z0(4),X1(4),Y1(4),Z1(4),X2(4),Y2(4),Z2(4)
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3),CPOS(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
MAT READ CPOS !'視線ベクトル
DATA 0,0,1
CALL TETRAHEDRON(0,0,0,2)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO NUM
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      LET S=DOT(CPOS,N) !'内積 COS(TH)  -90<TH<90...表
      IF S>0 THEN !'表向きなら
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP

SUB TETRAHEDRON(X,Y,Z,L) !'4面体
   LET XX1=X+L*COS(0)
   LET ZZ1=Z+L*SIN(0)
   LET YY1=Y
   LET XX2=X+L*COS(120)
   LET ZZ2=Z+L*SIN(120)
   LET YY2=Y
   LET XX3=X+L*COS(240)
   LET ZZ3=Z+L*SIN(240)
   LET YY3=Y
   LET XX4=X
   LET ZZ4=Z
   LET YY4=Y+L*SQR(2)
   LET NUM=NUM+1
   LET X0(NUM)=XX4
   LET Y0(NUM)=YY4
   LET Z0(NUM)=ZZ4
   LET X1(NUM)=XX1
   LET Y1(NUM)=YY1
   LET Z1(NUM)=ZZ1
   LET X2(NUM)=XX2
   LET Y2(NUM)=YY2
   LET Z2(NUM)=ZZ2
   LET NUM=NUM+1
   LET X0(NUM)=XX3
   LET Y0(NUM)=YY3
   LET Z0(NUM)=ZZ3
   LET X1(NUM)=XX2
   LET Y1(NUM)=YY2
   LET Z1(NUM)=ZZ2
   LET X2(NUM)=XX1
   LET Y2(NUM)=YY1
   LET Z2(NUM)=ZZ1
   LET NUM=NUM+1
   LET X0(NUM)=XX4
   LET Y0(NUM)=YY4
   LET Z0(NUM)=ZZ4
   LET X1(NUM)=XX3
   LET Y1(NUM)=YY3
   LET Z1(NUM)=ZZ3
   LET X2(NUM)=XX1
   LET Y2(NUM)=YY1
   LET Z2(NUM)=ZZ1
   LET NUM=NUM+1
   LET X0(NUM)=XX4
   LET Y0(NUM)=YY4
   LET Z0(NUM)=ZZ4
   LET X1(NUM)=XX2
   LET Y1(NUM)=YY2
   LET Z1(NUM)=ZZ2
   LET X2(NUM)=XX3
   LET Y2(NUM)=YY3
   LET Z2(NUM)=ZZ3
END SUB
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM A(3)
MAT READ A      ! 光源の向き
DATA 1,1,1
LET S=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時04分40秒
  6面体を表示します(外積)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
DIM X0(6),Y0(6),Z0(6),X1(6),Y1(6),Z1(6),X2(6),Y2(6),Z2(6),X3(6),Y3(6),Z3(6)
DIM P0(4),P1(4),P2(4),P3(4)
DIM L(4),M(4),N(3),CPOS(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
MAT READ CPOS !'視線ベクトル
DATA 0,0,1
CALL CUBE(0,0,0,2)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO NUM
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P3(1)=X3(I)
      LET P3(2)=Y3(I)
      LET P3(3)=Z3(I)
      LET P0(4),P1(4),P2(4),P3(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT P3=P3*Q
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      LET S=DOT(CPOS,N) !'内積 COS(TH)  -90<TH<90...表
      IF S>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
      MAT L=P3-P2
      MAT M=P2-P0
      CALL OUTER(N,L,M)
      LET S=DOT(CPOS,N) !'内積 COS(TH)  -90<TH<90...表
      IF S>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P2,P3)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP

SUB CUBE(X,Y,Z,L) !'立方体
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y+L/2
   LET Z0(NUM)=Z-L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y+L/2
   LET Z1(NUM)=Z-L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y+L/2
   LET Z2(NUM)=Z+L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y+L/2
   LET Z3(NUM)=Z+L/2
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y+L/2
   LET Z0(NUM)=Z+L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y+L/2
   LET Z1(NUM)=Z+L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y-L/2
   LET Z2(NUM)=Z+L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y-L/2
   LET Z3(NUM)=Z+L/2
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y-L/2
   LET Z0(NUM)=Z+L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y-L/2
   LET Z1(NUM)=Z+L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y-L/2
   LET Z2(NUM)=Z-L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y-L/2
   LET Z3(NUM)=Z-L/2
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y-L/2
   LET Z0(NUM)=Z-L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y-L/2
   LET Z1(NUM)=Z-L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y+L/2
   LET Z2(NUM)=Z-L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y+L/2
   LET Z3(NUM)=Z-L/2
   LET NUM=NUM+1
   LET X0(NUM)=X+L/2
   LET Y0(NUM)=Y+L/2
   LET Z0(NUM)=Z-L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y-L/2
   LET Z1(NUM)=Z-L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y-L/2
   LET Z2(NUM)=Z+L/2
   LET X3(NUM)=X+L/2
   LET Y3(NUM)=Y+L/2
   LET Z3(NUM)=Z+L/2
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y-L/2
   LET Z0(NUM)=Z-L/2
   LET X1(NUM)=X-L/2
   LET Y1(NUM)=Y+L/2
   LET Z1(NUM)=Z-L/2
   LET X2(NUM)=X-L/2
   LET Y2(NUM)=Y+L/2
   LET Z2(NUM)=Z+L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y-L/2
   LET Z3(NUM)=Z+L/2
END SUB
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM A(3)
MAT READ A      ! 光源の向き
DATA 1,1,1
LET S=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時05分18秒
  8面体を表示します(外積)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
DIM X0(8),Y0(8),Z0(8),X1(8),Y1(8),Z1(8),X2(8),Y2(8),Z2(8)
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3),CPOS(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
MAT READ CPOS !'視線ベクトル
DATA 0,0,1
CALL OCTAH(0,0,0,2,2,2)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO NUM
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      LET S=DOT(CPOS,N) !'内積 COS(TH)  -90<TH<90...表
      IF S>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP

SUB OCTAH(X,Y,Z,XL,YL,ZL) !'8面体
   LET XX0=X
   LET YY0=Y+YL/2
   LET ZZ0=Z
   LET XX1=X+XL/2
   LET YY1=Y
   LET ZZ1=Z
   LET XX2=X
   LET YY2=Y
   LET ZZ2=Z+ZL/2
   LET XX3=X-XL/2
   LET YY3=Y
   LET ZZ3=Z
   LET XX4=X
   LET YY4=Y
   LET ZZ4=Z-ZL/2
   LET XX5=X
   LET YY5=Y-YL/2
   LET ZZ5=Z
   LET NUM=NUM+1
   LET X0(NUM)=XX0
   LET Y0(NUM)=YY0
   LET Z0(NUM)=ZZ0
   LET X1(NUM)=XX1
   LET Y1(NUM)=YY1
   LET Z1(NUM)=ZZ1
   LET X2(NUM)=XX2
   LET Y2(NUM)=YY2
   LET Z2(NUM)=ZZ2
   LET NUM=NUM+1
   LET X0(NUM)=XX0
   LET Y0(NUM)=YY0
   LET Z0(NUM)=ZZ0
   LET X1(NUM)=XX2
   LET Y1(NUM)=YY2
   LET Z1(NUM)=ZZ2
   LET X2(NUM)=XX3
   LET Y2(NUM)=YY3
   LET Z2(NUM)=ZZ3
   LET NUM=NUM+1
   LET X0(NUM)=XX0
   LET Y0(NUM)=YY0
   LET Z0(NUM)=ZZ0
   LET X1(NUM)=XX3
   LET Y1(NUM)=YY3
   LET Z1(NUM)=ZZ3
   LET X2(NUM)=XX4
   LET Y2(NUM)=YY4
   LET Z2(NUM)=ZZ4
   LET NUM=NUM+1
   LET X0(NUM)=XX0
   LET Y0(NUM)=YY0
   LET Z0(NUM)=ZZ0
   LET X1(NUM)=XX4
   LET Y1(NUM)=YY4
   LET Z1(NUM)=ZZ4
   LET X2(NUM)=XX1
   LET Y2(NUM)=YY1
   LET Z2(NUM)=ZZ1
   LET NUM=NUM+1
   LET X0(NUM)=XX5
   LET Y0(NUM)=YY5
   LET Z0(NUM)=ZZ5
   LET X1(NUM)=XX2
   LET Y1(NUM)=YY2
   LET Z1(NUM)=ZZ2
   LET X2(NUM)=XX1
   LET Y2(NUM)=YY1
   LET Z2(NUM)=ZZ1
   LET NUM=NUM+1
   LET X0(NUM)=XX5
   LET Y0(NUM)=YY5
   LET Z0(NUM)=ZZ5
   LET X1(NUM)=XX3
   LET Y1(NUM)=YY3
   LET Z1(NUM)=ZZ3
   LET X2(NUM)=XX2
   LET Y2(NUM)=YY2
   LET Z2(NUM)=ZZ2
   LET NUM=NUM+1
   LET X0(NUM)=XX5
   LET Y0(NUM)=YY5
   LET Z0(NUM)=ZZ5
   LET X1(NUM)=XX4
   LET Y1(NUM)=YY4
   LET Z1(NUM)=ZZ4
   LET X2(NUM)=XX3
   LET Y2(NUM)=YY3
   LET Z2(NUM)=ZZ3
   LET NUM=NUM+1
   LET X0(NUM)=XX5
   LET Y0(NUM)=YY5
   LET Z0(NUM)=ZZ5
   LET X1(NUM)=XX1
   LET Y1(NUM)=YY1
   LET Z1(NUM)=ZZ1
   LET X2(NUM)=XX4
   LET Y2(NUM)=YY4
   LET Z2(NUM)=ZZ4
END SUB
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM A(3)
MAT READ A      ! 光源の向き
DATA 1,1,1
LET S=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時05分59秒
  12面体を表示します(外積)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
DIM X0(36),Y0(36),Z0(36),X1(36),Y1(36),Z1(36),X2(36),Y2(36),Z2(36)
DIM P0(4),P1(4),P2(4),P3(4)
DIM L(4),M(4),N(3),CPOS(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
DIM XX(20),YY(20),ZZ(20)
LET LL=1
FOR TH=0 TO 359 STEP 72
   LET K=K+1
   LET XX(K)=LL*COS((TH+18))
   LET ZZ(K)=LL*SIN((TH+18))
   LET YY(K)=LL*(SQR(5)+3)/4
NEXT TH
FOR TH=0 TO 359 STEP 72
   LET K=K+1
   LET XX(K)=LL*(SQR(5)+1)/2*COS((TH+18))
   LET ZZ(K)=LL*(SQR(5)+1)/2*SIN((TH+18))
   LET YY(K)=LL*(SQR(5)-1)/4
NEXT TH
FOR TH=0 TO 359 STEP 72
   LET K=K+1
   LET XX(K)=LL*(SQR(5)+1)/2*COS((TH+54))
   LET ZZ(K)=LL*(SQR(5)+1)/2*SIN((TH+54))
   LET YY(K)=-LL*(SQR(5)-1)/4
NEXT TH
FOR TH=0 TO 359 STEP 72
   LET K=K+1
   LET XX(K)=LL*COS((TH+54))
   LET ZZ(K)=LL*SIN((TH+54))
   LET YY(K)=-LL*(SQR(5)+3)/4
NEXT TH
FOR I=1 TO 36
   READ A,B,C
   LET X0(I)=XX(A+1)
   LET Y0(I)=YY(A+1)
   LET Z0(I)=ZZ(A+1)
   LET X1(I)=XX(B+1)
   LET Y1(I)=YY(B+1)
   LET Z1(I)=ZZ(B+1)
   LET X2(I)=XX(C+1)
   LET Y2(I)=YY(C+1)
   LET Z2(I)=ZZ(C+1)
NEXT I
DATA 0,1,2 !'メッシュデータ
DATA 0,2,3
DATA 0,3,4
DATA 5,10,6
DATA 5,6,1
DATA 5,1,0
DATA 6,11,7
DATA 6,7,2
DATA 6,2,1
DATA 7,12,8
DATA 7,8,3
DATA 7,3,2
DATA 8,13,9
DATA 8,9,4
DATA 8,4,3
DATA 9,14,5
DATA 9,5,0
DATA 9,0,4
DATA 15,16,11
DATA 15,11,6
DATA 15,6,10
DATA 16,17,12
DATA 16,12,7
DATA 16,7,11
DATA 17,18,13
DATA 17,13,8
DATA 17,8,12
DATA 18,19,14
DATA 18,14,9
DATA 18,9,13
DATA 19,15,10
DATA 19,10,5
DATA 19,5,14
DATA 19,18,17
DATA 19,17,16
DATA 19,16,15
MAT READ CPOS !'視線ベクトル
DATA 0,0,1
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO 36
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      LET S=DOT(CPOS,N) !'内積 COS(TH)  -90<TH<90...表
      IF S>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM A(3)
MAT READ A      ! 光源の向き
DATA 1,1,1
LET S=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時06分41秒
  4角錐を表示します(外積)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
DIM X0(100),Y0(100),Z0(100),X1(100),Y1(100),Z1(100),X2(100),Y2(100),Z2(100)
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3),CPOS(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
DIM XX(15),YY(15),ZZ(15)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
LOCATE VALUE NOWAIT(5),RANGE .1 TO 5,AT 2:LL
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   LOCATE VALUE NOWAIT(5):LL
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   LET XX(1)=X
   LET YY(1)=Y
   LET ZZ(1)=Z
   LET XX(2)=X-LL/2
   LET YY(2)=Y-LL*SQR(3)/2
   LET ZZ(2)=Z+LL/2
   LET XX(3)=X+LL/2
   LET YY(3)=Y-LL*SQR(3)/2
   LET ZZ(3)=Z+LL/2
   LET XX(4)=X+LL/2
   LET YY(4)=Y-LL*SQR(3)/2
   LET ZZ(4)=Z-LL/2
   LET XX(5)=X-LL/2
   LET YY(5)=Y-LL*SQR(3)/2
   LET ZZ(5)=Z-LL/2
   RESTORE
   FOR I=1 TO 6
      READ A,B,C
      LET X0(I)=XX(A+1)
      LET Y0(I)=YY(A+1)
      LET Z0(I)=ZZ(A+1)
      LET X1(I)=XX(B+1)
      LET Y1(I)=YY(B+1)
      LET Z1(I)=ZZ(B+1)
      LET X2(I)=XX(C+1)
      LET Y2(I)=YY(C+1)
      LET Z2(I)=ZZ(C+1)
   NEXT I
   DATA 0,2,1 !'メッシュデータ
   DATA 0,3,2
   DATA 0,4,3
   DATA 0,1,4
   DATA 1,2,3
   DATA 1,3,4
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   MAT READ CPOS !'視線ベクトル
   DATA 0,0,1
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO 6
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      LET S=DOT(CPOS,N) !'内積 COS(TH)  -90<TH<90...表
      IF S>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM A(3)
MAT READ A      ! 光源の向き
DATA 1,1,1
LET S=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時07分30秒
  N角柱を表示します(外積)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
DIM X0(100),Y0(100),Z0(100),X1(100),Y1(100),Z1(100),X2(100),Y2(100),Z2(100)
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3),CPOS(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
DIM XX(15),YY(15),ZZ(15)
MAT READ CPOS !'視線ベクトル
DATA 0,0,1
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
LOCATE VALUE NOWAIT(5),RANGE .1 TO 5,AT 2:LL
LOCATE VALUE NOWAIT(6),RANGE .1 TO 5,AT 1:H
LOCATE VALUE NOWAIT(7),RANGE 3 TO 7,AT 3:NN
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   LOCATE VALUE NOWAIT(5):LL
   LOCATE VALUE NOWAIT(6):H
   LOCATE VALUE NOWAIT(7):NN
   LET NN=INT(NN)
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   LET NUM=0
   FOR TH=0 TO 359 STEP 360/NN
      LET NUM=NUM+1
      LET XX(NUM)=LL*COS(TH)
      LET ZZ(NUM)=LL*SIN(TH)
      LET YY(NUM)=0
   NEXT TH
   FOR TH=0 TO 359 STEP 360/NN
      LET NUM=NUM+1
      LET XX(NUM)=LL*COS(TH)
      LET ZZ(NUM)=LL*SIN(TH)
      LET YY(NUM)=H
   NEXT TH
   LET NUM=0
   FOR I=1 TO NN-2
      LET NUM=NUM+1
      LET X0(NUM)=XX(1)
      LET Y0(NUM)=YY(1)
      LET Z0(NUM)=ZZ(1)
      LET X1(NUM)=XX(I+2)
      LET Y1(NUM)=YY(I+2)
      LET Z1(NUM)=ZZ(I+2)
      LET X2(NUM)=XX(I+1)
      LET Y2(NUM)=YY(I+1)
      LET Z2(NUM)=ZZ(I+1)
   NEXT I
   FOR I=NN+1 TO 2*NN-2
      LET NUM=NUM+1
      LET X0(NUM)=XX(NN+1)
      LET Y0(NUM)=YY(NN+1)
      LET Z0(NUM)=ZZ(NN+1)
      LET X1(NUM)=XX(I+1)
      LET Y1(NUM)=YY(I+1)
      LET Z1(NUM)=ZZ(I+1)
      LET X2(NUM)=XX(I+2)
      LET Y2(NUM)=YY(I+2)
      LET Z2(NUM)=ZZ(I+2)
   NEXT I
   FOR I=0 TO NN-2
      LET NUM=NUM+1
      LET X0(NUM)=XX(I+1)
      LET Y0(NUM)=YY(I+1)
      LET Z0(NUM)=ZZ(I+1)
      LET X1(NUM)=XX(I+2)
      LET Y1(NUM)=YY(I+2)
      LET Z1(NUM)=ZZ(I+2)
      LET X2(NUM)=XX(I+NN+2)
      LET Y2(NUM)=YY(I+NN+2)
      LET Z2(NUM)=ZZ(I+NN+2)
      LET NUM=NUM+1
      LET X0(NUM)=XX(I+1)
      LET Y0(NUM)=YY(I+1)
      LET Z0(NUM)=ZZ(I+1)
      LET X1(NUM)=XX(I+NN+2)
      LET Y1(NUM)=YY(I+NN+2)
      LET Z1(NUM)=ZZ(I+NN+2)
      LET X2(NUM)=XX(I+NN+1)
      LET Y2(NUM)=YY(I+NN+1)
      LET Z2(NUM)=ZZ(I+NN+1)
   NEXT I
   LET NUM=NUM+1
   LET X0(NUM)=XX(NN)
   LET Y0(NUM)=YY(NN)
   LET Z0(NUM)=ZZ(NN)
   LET X1(NUM)=XX(1)
   LET Y1(NUM)=YY(1)
   LET Z1(NUM)=ZZ(1)
   LET X2(NUM)=XX(NN+1)
   LET Y2(NUM)=YY(NN+1)
   LET Z2(NUM)=ZZ(NN+1)
   LET NUM=NUM+1
   LET X0(NUM)=XX(NN)
   LET Y0(NUM)=YY(NN)
   LET Z0(NUM)=ZZ(NN)
   LET X1(NUM)=XX(NN+1)
   LET Y1(NUM)=YY(NN+1)
   LET Z1(NUM)=ZZ(NN+1)
   LET X2(NUM)=XX(2*NN)
   LET Y2(NUM)=YY(2*NN)
   LET Z2(NUM)=ZZ(2*NN)
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO NUM
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      LET S=DOT(CPOS,N) !'内積 COS(TH)  -90<TH<90...表
      IF S>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM A(3)
MAT READ A      ! 光源の向き
DATA 1,1,1
LET S=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時08分21秒
  多角形体を表示します(外積)


OPTION ANGLE DEGREES
LET NN=30
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
DIM X0(2*NN*NN),Y0(2*NN*NN),Z0(2*NN*NN),X1(2*NN*NN),Y1(2*NN*NN),Z1(2*NN*NN),X2(2*NN*NN),Y2(2*NN*NN),Z2(2*NN*NN)
DIM P0(4),P1(4),P2(4),P3(4),CPOS(3)
DIM L(4),M(4),N(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
MAT READ CPOS
DATA 0,0,1   !'視線ベクトル
DEF A(N)=360/N
DEF S1(X)=FP(X)
DEF CNP(N,T)=COS(A(N)*S1(T/A(N))-A(N)/2)
DEF PC(N,T)=COS(T)*COS(A(N)/2)/CNP(N,T)
DEF PS(N,T)=SIN(T)*COS(A(N)/2)/CNP(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)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 5,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
LOCATE VALUE NOWAIT(5),RANGE 3 TO 10,AT 3:N0
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   LOCATE VALUE NOWAIT(5):N0
   LET N0=INT(N0)
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   LET NUM=0
   FOR I=0 TO NN-1
      FOR J=0 TO NN-1
         LET NUM=NUM+1
         LET XX0=P3X(N0,I*180/NN,J*360/NN)
         LET YY0=P3Y(N0,I*180/NN,J*360/NN)
         LET ZZ0=P3Z(N0,I*180/NN)
         LET XX1=P3X(N0,I*180/NN,(J+1)*360/NN)
         LET YY1=P3Y(N0,I*180/NN,(J+1)*360/NN)
         LET ZZ1=P3Z(N0,I*180/NN)
         LET XX2=P3X(N0,(I+1)*180/NN,(J+1)*360/NN)
         LET YY2=P3Y(N0,(I+1)*180/NN,(J+1)*360/NN)
         LET ZZ2=P3Z(N0,(I+1)*180/NN)
         LET XX3=P3X(N0,(I+1)*180/NN,J*360/NN)
         LET YY3=P3Y(N0,(I+1)*180/NN,J*360/NN)
         LET ZZ3=P3Z(N0,(I+1)*180/NN)
         LET X0(NUM)=XX0
         LET Y0(NUM)=YY0
         LET Z0(NUM)=ZZ0
         LET X1(NUM)=XX1
         LET Y1(NUM)=YY1
         LET Z1(NUM)=ZZ1
         LET X2(NUM)=XX2
         LET Y2(NUM)=YY2
         LET Z2(NUM)=ZZ2
         LET NUM=NUM+1
         LET X0(NUM)=XX0
         LET Y0(NUM)=YY0
         LET Z0(NUM)=ZZ0
         LET X1(NUM)=XX2
         LET Y1(NUM)=YY2
         LET Z1(NUM)=ZZ2
         LET X2(NUM)=XX3
         LET Y2(NUM)=YY3
         LET Z2(NUM)=ZZ3
      NEXT J
   NEXT I
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO NUM
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      LET S=DOT(CPOS,N) !'内積 COS(TH)  -90<TH<90...表
      IF S>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM LA(3),LIGHT(3)
MAT READ LA
DATA .8,.7,.1
MAT READ LIGHT
DATA 1,1,1
LET S=DOT(LIGHT,N)/(SQR(DOT(LIGHT,LIGHT))*SQR(DOT(N,N)))
MAT LA=((S+1)/2)*LA
SET COLOR MIX(8) LA(1),LA(2),LA(3)
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時10分38秒
  Zソートと呼ばれる方法で3次元図形表示します。


ZソートとはZ値でソートを行い、奥から手前に向かって描画
していくことにより表示する方法で、一見するとムダに見えますが
奥にあるオブジェクトを手前にあるオブジェクトで塗り潰していくことで陰面処理を行います。

Zソートも描画が速くアニメーション表示が可能です。
スライドバーで動かせます。2進モードを使用してください

※オブジェクトが貫通している、三すくみ等があると正しく描画できません。



切頭6面体を表示します(Zソート)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
DIM X0(100),Y0(100),Z0(100),X1(100),Y1(100),Z1(100),X2(100),Y2(100),Z2(100),KEY(100),INDEX(100)
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
DIM XX(50),YY(50),ZZ(50)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   LET NUM=0
   FOR TH=22.5 TO 359+22.5 STEP 45
      LET NUM=NUM+1
      LET XX(NUM)=COS(TH)
      LET YY(NUM)=COS(22.5)
      LET ZZ(NUM)=SIN(TH)
   NEXT TH
   FOR TH=22.5 TO 359+22.5 STEP 45
      LET NUM=NUM+1
      LET XX(NUM)=-COS(22.5)
      LET YY(NUM)=COS(TH)
      LET ZZ(NUM)=SIN(TH)
   NEXT TH
   FOR TH=22.5 TO 359+22.5 STEP 45
      LET NUM=NUM+1
      LET XX(NUM)=COS(TH)
      LET YY(NUM)=-COS(22.5)
      LET ZZ(NUM)=SIN(TH)
   NEXT TH
   FOR TH=22.5 TO 359+22.5 STEP 45
      LET NUM=NUM+1
      LET XX(NUM)=COS(22.5)
      LET YY(NUM)=COS(TH)
      LET ZZ(NUM)=SIN(TH)
   NEXT TH
   FOR TH=22.5 TO 359+22.5 STEP 45
      LET NUM=NUM+1
      LET XX(NUM)=COS(TH)
      LET YY(NUM)=SIN(TH)
      LET ZZ(NUM)=-COS(22.5)
   NEXT TH
   FOR TH=22.5 TO 359+22.5 STEP 45
      LET NUM=NUM+1
      LET XX(NUM)=COS(TH)
      LET YY(NUM)=SIN(TH)
      LET ZZ(NUM)=COS(22.5)
   NEXT TH
   RESTORE
   FOR I=1 TO 44
      READ A,B,C
      LET X0(I)=XX(A+1)
      LET Y0(I)=YY(A+1)
      LET Z0(I)=ZZ(A+1)
      LET X1(I)=XX(B+1)
      LET Y1(I)=YY(B+1)
      LET Z1(I)=ZZ(B+1)
      LET X2(I)=XX(C+1)
      LET Y2(I)=YY(C+1)
      LET Z2(I)=ZZ(C+1)
   NEXT I
   DATA 0,1,2 !'メッシュデータ
   DATA 0,2,3
   DATA 0,3,4
   DATA 0,4,5
   DATA 0,5,6
   DATA 0,6,7
   DATA 8,9,10
   DATA 8,10,11
   DATA 8,11,12
   DATA 8,12,13
   DATA 8,13,14
   DATA 8,14,15
   DATA 16,18,17
   DATA 16,19,18
   DATA 16,20,19
   DATA 16,21,20
   DATA 16,22,21
   DATA 16,23,22
   DATA 24,26,25
   DATA 24,27,26
   DATA 24,28,27
   DATA 24,29,28
   DATA 24,30,29
   DATA 24,31,30
   DATA 32,33,34
   DATA 32,34,35
   DATA 32,35,36
   DATA 32,36,37
   DATA 32,37,38
   DATA 32,38,39
   DATA 40,42,41
   DATA 40,43,42
   DATA 40,44,43
   DATA 40,45,44
   DATA 40,46,45
   DATA 40,47,46
   DATA 0,25,1
   DATA 8,2,9
   DATA 10,18,11
   DATA 16,17,26
   DATA 30,31,6
   DATA 14,5,15
   DATA 28,29,22
   DATA 20,21,13
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   FOR I=1 TO 44
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      LET X0(I)=P0(1)
      LET Y0(I)=P0(2)
      LET Z0(I)=P0(3)
      LET X1(I)=P1(1)
      LET Y1(I)=P1(2)
      LET Z1(I)=P1(3)
      LET X2(I)=P2(1)
      LET Y2(I)=P2(2)
      LET Z2(I)=P2(3)
      LET KEY(I)=(Z0(I)+Z1(I)+Z2(I))/3 !'各頂点のZ座標値の平均
      LET INDEX(I)=I
   NEXT I
   CALL QUICKSORT(1,44,KEY,INDEX) !'Zソート
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO 44
      LET P0(1)=X0(INDEX(I))
      LET P0(2)=Y0(INDEX(I))
      LET P0(3)=Z0(INDEX(I))
      LET P1(1)=X1(INDEX(I))
      LET P1(2)=Y1(INDEX(I))
      LET P1(3)=Z1(INDEX(I))
      LET P2(1)=X2(INDEX(I))
      LET P2(2)=Y2(INDEX(I))
      LET P2(3)=Z2(INDEX(I))
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      CALL SETBRIGHTNESS(N)
      CALL PLOT3(P0,P1,P2)
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM A(3)
MAT READ A      ! 光源の向き
DATA 1,1,1
LET S=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET S=(S*.7+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB

EXTERNAL SUB QUICKSORT(FI,LA,A(),INDEX())
LET X=A(INDEX((FI+LA)/2))
LET I=FI
LET J=LA
DO
   DO WHILE A(INDEX(I))<X
      LET I=I+1
   LOOP
   DO WHILE X<A(INDEX(J))
      LET J=J-1
   LOOP
   IF I>=J THEN EXIT DO
   SWAP INDEX(I),INDEX(J)
   LET I=I+1
   LET J=J-1
LOOP
IF FI<I-1 THEN CALL QUICKSORT(FI,I-1,A,INDEX)
IF J+1<LA THEN CALL QUICKSORT(J+1,LA,A,INDEX)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時11分15秒
  切頭12面体を表示します(Zソート)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
DIM X0(200),Y0(200),Z0(200),X1(200),Y1(200),Z1(200),X2(200),Y2(200),Z2(200),KEY(200),INDEX(200)
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
DIM XX(100),YY(100),ZZ(100)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 5:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   RESTORE
   FOR I=1 TO 60
      READ XX(I),YY(I),ZZ(I)
   NEXT I
   DATA -.16838141 , .83850515 ,-.51822468 !'座標データ
   DATA -.44082824 , .83850515 ,-.32028047
   DATA -.54489368 , .83850515 , 0
   DATA -.44082824 , .83850515 , .32028047
   DATA -.16838141 , .83850515 , .51822468
   DATA  .16838141 , .83850515 , .51822468
   DATA  .44082824 , .83850515 , .32028047
   DATA  .54489368 , .83850515 , 0
   DATA  .44082824 , .83850515 ,-.32028047
   DATA  .16838141 , .83850515 ,-.51822468
   DATA  0 , .66145846 ,-.7499818
   DATA  0 , .3749909 ,-.92702849
   DATA  .16838141 , .08852334 ,-.98173893
   DATA  .44082824 ,-.08852334 ,-.89321558
   DATA  .71327508 ,-.08852334 ,-.69527137
   DATA  .88165649 , .08852334 ,-.46351425
   DATA  .88165649 , .3749909 ,-.28646756
   DATA  .71327508 , .66145846 ,-.23175712
   DATA -.16838141 , .08852334 ,-.98173893
   DATA -.44082824 ,-.08852334 ,-.89321558
   DATA -.71327508 ,-.08852334 ,-.69527137
   DATA -.88165649 , .08852334 ,-.46351425
   DATA -.88165649 , .3749909 ,-.28646756
   DATA -.71327508 , .66145846 ,-.23175712
   DATA -.98572192 , .08852334 ,-.14323378
   DATA -.98572192 ,-.08852334 , .14323378
   DATA -.88165649 ,-.08852334 , .46351425
   DATA -.71327508 , .08852334 , .69527137
   DATA -.54489368 , .3749909 , .7499818
   DATA -.44082824 , .66145846 , .60674802
   DATA -.44082824 , .08852334 , .89321558
   DATA -.16838141 ,-.08852334 , .98173893
   DATA  .16838141 ,-.08852334 , .98173893
   DATA  .44082824 , .08852334 , .89321558
   DATA  .54489368 , .3749909 , .7499818
   DATA  .44082824 , .66145846 , .60674802
   DATA  .71327508 , .08852334 , .69527137
   DATA  .88165649 ,-.08852334 , .46351425
   DATA  .98572192 ,-.08852334 , .14323378
   DATA  .98572192 , .08852334 ,-.14323378
   DATA  .54489368 ,-.3749909 ,-.7499818
   DATA  .44082824 ,-.66145846 ,-.60674802
   DATA  .16838141 ,-.83850515 ,-.51822468
   DATA -.16838141 ,-.83850515 ,-.51822468
   DATA -.44082824 ,-.66145846 ,-.60674802
   DATA -.54489368 ,-.3749909 ,-.7499818
   DATA -.44082824 ,-.83850515 ,-.32028047
   DATA -.54489367 ,-.83850515 , 0
   DATA -.71327508 ,-.66145846 , .23175712
   DATA -.88165649 ,-.3749909 , .28646756
   DATA -.44082824 ,-.83850515 , .32028047
   DATA -.16838141 ,-.83850515 , .51822468
   DATA  0 ,-.66145846 , .7499818
   DATA  0 ,-.3749909 , .92702849
   DATA  .16838141 ,-.83850515 , .51822468
   DATA  .44082824 ,-.83850515 , .32028047
   DATA  .71327508 ,-.66145846 , .23175712
   DATA  .88165649 ,-.3749909 , .28646756
   DATA  .54489368 ,-.83850515 , 0
   DATA  .44082824 ,-.83850515 ,-.32028047
   FOR I=1 TO 116
      READ A,B,C
      LET X0(I)=XX(A)
      LET Y0(I)=YY(A)
      LET Z0(I)=ZZ(A)
      LET X1(I)=XX(B)
      LET Y1(I)=YY(B)
      LET Z1(I)=ZZ(B)
      LET X2(I)=XX(C)
      LET Y2(I)=YY(C)
      LET Z2(I)=ZZ(C)
   NEXT I
   DATA 1,2,24  !'メッシュデータ
   DATA 1,24,23
   DATA 1,23,22
   DATA 1,22,21
   DATA 1,21,20
   DATA 1,20,19
   DATA 1,19,12
   DATA 1,12,11
   DATA 1,11,10
   DATA 1,10,9
   DATA 1,9,8
   DATA 1,8,7
   DATA 1,7,6
   DATA 1,6,5
   DATA 1,5,4
   DATA 1,4,3
   DATA 1,3,2
   DATA 2,3,24
   DATA 3,4,30
   DATA 3,30,29
   DATA 3,29,28
   DATA 3,28,27
   DATA 3,27,26
   DATA 3,26,25
   DATA 3,25,23
   DATA 3,23,24
   DATA 4,5,30
   DATA 5,6,36
   DATA 5,36,35
   DATA 5,35,34
   DATA 5,34,33
   DATA 5,33,32
   DATA 5,32,31
   DATA 5,31,29
   DATA 5,29,30
   DATA 6,7,36
   DATA 7,8,18
   DATA 7,18,17
   DATA 7,17,40
   DATA 7,40,39
   DATA 7,39,38
   DATA 7,38,37
   DATA 7,37,35
   DATA 7,35,36
   DATA 8,9,18
   DATA 9,10,11
   DATA 9,11,12
   DATA 9,12,13
   DATA 9,13,14
   DATA 9,14,15
   DATA 9,15,16
   DATA 9,16,17
   DATA 9,17,18
   DATA 12,19,13
   DATA 13,19,20
   DATA 13,20,46
   DATA 13,46,45
   DATA 13,45,44
   DATA 13,44,43
   DATA 13,43,42
   DATA 13,42,41
   DATA 13,41,14
   DATA 14,41,15
   DATA 15,41,42
   DATA 15,42,60
   DATA 15,60,59
   DATA 15,59,57
   DATA 15,57,58
   DATA 15,58,39
   DATA 15,39,40
   DATA 15,40,16
   DATA 16,40,17
   DATA 20,21,46
   DATA 21,22,25
   DATA 21,25,26
   DATA 21,26,50
   DATA 21,50,49
   DATA 21,49,48
   DATA 21,48,47
   DATA 21,47,45
   DATA 21,45,46
   DATA 22,23,25
   DATA 26,27,50
   DATA 27,28,31
   DATA 27,31,32
   DATA 27,32,54
   DATA 27,54,53
   DATA 27,53,52
   DATA 27,52,51
   DATA 27,51,49
   DATA 27,49,50
   DATA 28,29,31
   DATA 32,33,54
   DATA 33,34,37
   DATA 33,37,38
   DATA 33,38,58
   DATA 33,58,57
   DATA 33,57,56
   DATA 33,56,55
   DATA 33,55,53
   DATA 33,53,54
   DATA 34,35,37
   DATA 38,39,58
   DATA 42,43,60
   DATA 43,44,47
   DATA 43,47,48
   DATA 43,48,51
   DATA 43,51,52
   DATA 43,52,55
   DATA 43,55,56
   DATA 43,56,59
   DATA 43,59,60
   DATA 44,45,47
   DATA 48,49,51
   DATA 52,53,55
   DATA 56,57,59
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO 116
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT L=P2-P1
      MAT M=P1-P0
      LET X0(I)=P0(1)
      LET Y0(I)=P0(2)
      LET Z0(I)=P0(3)
      LET X1(I)=P1(1)
      LET Y1(I)=P1(2)
      LET Z1(I)=P1(3)
      LET X2(I)=P2(1)
      LET Y2(I)=P2(2)
      LET Z2(I)=P2(3)
      LET KEY(I)=(Z0(I)+Z1(I)+Z2(I))/3 !'各頂点のZ座標値の平均
      LET INDEX(I)=I
   NEXT I
   CALL QUICKSORT(1,116,KEY,INDEX) !'Zソート
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO 116
      LET P0(1)=X0(INDEX(I))
      LET P0(2)=Y0(INDEX(I))
      LET P0(3)=Z0(INDEX(I))
      LET P1(1)=X1(INDEX(I))
      LET P1(2)=Y1(INDEX(I))
      LET P1(3)=Z1(INDEX(I))
      LET P2(1)=X2(INDEX(I))
      LET P2(2)=Y2(INDEX(I))
      LET P2(3)=Z2(INDEX(I))
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      CALL SETBRIGHTNESS(N)
      CALL PLOT3(P0,P1,P2)
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM LIGHT(3)
MAT READ LIGHT      ! 光源の向き
DATA 1,1,1
LET S=DOT(LIGHT,N)/(SQR(DOT(LIGHT,LIGHT))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB

EXTERNAL SUB QUICKSORT(FI,LA,A(),INDEX())
LET X=A(INDEX((FI+LA)/2))
LET I=FI
LET J=LA
DO
   DO WHILE A(INDEX(I))<X
      LET I=I+1
   LOOP
   DO WHILE X<A(INDEX(J))
      LET J=J-1
   LOOP
   IF I>=J THEN EXIT DO
   SWAP INDEX(I),INDEX(J)
   LET I=I+1
   LET J=J-1
LOOP
IF FI<I-1 THEN CALL QUICKSORT(FI,I-1,A,INDEX)
IF J+1<LA THEN CALL QUICKSORT(J+1,LA,A,INDEX)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時11分53秒
  切頭20面体を表示します(Zソート)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
DIM X0(200),Y0(200),Z0(200),X1(200),Y1(200),Z1(200),X2(200),Y2(200),Z2(200),KEY(200),INDEX(200)
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
DIM XX(100),YY(100),ZZ(100)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 5:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   RESTORE
   FOR I=1 TO 60
      READ XX(I),YY(I),ZZ(I)
   NEXT I
   DATA -.20177411 , .93923362 ,-.27771823 !'座標データ
   DATA -.40354821 , .72707577 ,-.55543646
   DATA -.20177411 , .51491792 ,-.8331547
   DATA  .20177411 , .51491792 ,-.8331547
   DATA  .40354821 , .72707577 ,-.55543646
   DATA  .20177411 , .93923362 ,-.27771823
   DATA -.32647736 , .93923362 , .10607893
   DATA -.65295472 , .72707577 , .21215785
   DATA -.85472883 , .51491792 ,-.06556038
   DATA -.73002557 , .51491792 ,-.44935754
   DATA -.73002557 , .17163931 ,-.66151539
   DATA -.40354821 , .17163931 ,-.89871508
   DATA -.20177411 ,-.17163931 ,-.96427546
   DATA  .20177411 ,-.17163931 ,-.96427546
   DATA  .40354821 , .17163931 ,-.89871508
   DATA  .73002557 , .17163931 ,-.66151539
   DATA  .73002557 , .51491792 ,-.44935754
   DATA  .85472883 , .51491792 ,-.06556038
   DATA  .65295472 , .72707577 , .21215785
   DATA  .32647736 , .93923362 , .10607893
   DATA  0 , .93923362 , .34327861
   DATA -.65295472 , .51491792 , .55543646
   DATA -.85472883 , .17163931 , .48987608
   DATA -.97943209 , .17163931 , .10607893
   DATA -.97943209 ,-.17163931 ,-.10607892
   DATA -.85472883 ,-.17163931 ,-.48987608
   DATA -.65295472 ,-.51491792 ,-.55543646
   DATA -.32647736 ,-.51491792 ,-.79263615
   DATA  0 ,-.72707577 ,-.68655723
   DATA  .32647736 ,-.51491792 ,-.79263615
   DATA  .65295472 ,-.51491792 ,-.55543646
   DATA  .85472883 ,-.17163931 ,-.48987608
   DATA  .97943209 ,-.17163931 ,-.10607893
   DATA  .97943209 , .17163931 , .10607893
   DATA  .85472883 , .17163931 , .48987608
   DATA  .65295472 , .51491792 , .55543646
   DATA  .32647736 , .51491792 , .79263615
   DATA  0 , .72707577 , .68655723
   DATA -.32647736 , .51491792 , .79263615
   DATA -.73002557 ,-.17163931 , .66151539
   DATA -.73002557 ,-.51491792 , .44935754
   DATA -.85472883 ,-.51491792 , .06556038
   DATA -.65295472 ,-.72707577 ,-.21215785
   DATA -.32647736 ,-.93923362 ,-.10607892
   DATA  0 ,-.93923362 ,-.34327861
   DATA  .32647736 ,-.93923362 ,-.10607892
   DATA  .65295472 ,-.72707577 ,-.21215785
   DATA  .85472883 ,-.51491792 , .06556038
   DATA  .73002557 ,-.51491792 , .44935754
   DATA  .73002557 ,-.17163931 , .66151539
   DATA  .40354821 ,-.17163931 , .89871508
   DATA  .20177411 , .17163931 , .96427546
   DATA -.20177411 , .17163931 , .96427546
   DATA -.40354821 ,-.17163931 , .89871508
   DATA -.20177411 ,-.51491792 , .83315469
   DATA -.40354821 ,-.72707577 , .55543646
   DATA -.20177411 ,-.93923362 , .27771823
   DATA  .2017741 ,-.93923362 , .27771823
   DATA  .40354821 ,-.72707577 , .55543646
   DATA  .20177411 ,-.51491792 , .83315469
   FOR I=1 TO 116
      READ A,B,C
      LET X0(I)=XX(A)
      LET Y0(I)=YY(A)
      LET Z0(I)=ZZ(A)
      LET X1(I)=XX(B)
      LET Y1(I)=YY(B)
      LET Z1(I)=ZZ(B)
      LET X2(I)=XX(C)
      LET Y2(I)=YY(C)
      LET Z2(I)=ZZ(C)
   NEXT I
   DATA 1,6,20 !'メッシュデータ
   DATA 1,20,21
   DATA 1,21,7
   DATA 1,7,8
   DATA 1,8,9
   DATA 1,9,10
   DATA 1,10,2
   DATA 1,2,3
   DATA 1,3,4
   DATA 1,4,5
   DATA 1,5,6
   DATA 2,10,11
   DATA 2,11,12
   DATA 2,12,3
   DATA 3,12,13
   DATA 3,13,14
   DATA 3,14,15
   DATA 3,15,4
   DATA 4,15,16
   DATA 4,16,17
   DATA 4,17,5
   DATA 5,17,18
   DATA 5,18,19
   DATA 5,19,20
   DATA 5,20,6
   DATA 7,21,38
   DATA 7,38,39
   DATA 7,39,22
   DATA 7,22,8
   DATA 8,22,23
   DATA 8,23,24
   DATA 8,24,9
   DATA 9,24,25
   DATA 9,25,26
   DATA 9,26,11
   DATA 9,11,10
   DATA 11,26,27
   DATA 11,27,28
   DATA 11,28,13
   DATA 11,13,12
   DATA 13,28,29
   DATA 13,29,30
   DATA 13,30,14
   DATA 14,30,31
   DATA 14,31,32
   DATA 14,32,16
   DATA 14,16,15
   DATA 16,32,33
   DATA 16,33,34
   DATA 16,34,18
   DATA 16,18,17
   DATA 18,34,35
   DATA 18,35,36
   DATA 18,36,19
   DATA 19,36,37
   DATA 19,37,38
   DATA 19,38,21
   DATA 19,21,20
   DATA 22,39,53
   DATA 22,53,54
   DATA 22,54,40
   DATA 22,40,23
   DATA 23,40,41
   DATA 23,41,42
   DATA 23,42,25
   DATA 23,25,24
   DATA 25,42,43
   DATA 25,43,27
   DATA 25,27,26
   DATA 27,43,44
   DATA 27,44,45
   DATA 27,45,29
   DATA 27,29,28
   DATA 29,45,46
   DATA 29,46,47
   DATA 29,47,31
   DATA 29,31,30
   DATA 31,47,48
   DATA 31,48,33
   DATA 31,33,32
   DATA 33,48,49
   DATA 33,49,50
   DATA 33,50,35
   DATA 33,35,34
   DATA 35,50,51
   DATA 35,51,52
   DATA 35,52,37
   DATA 35,37,36
   DATA 37,52,53
   DATA 37,53,39
   DATA 37,39,38
   DATA 40,54,55
   DATA 40,55,56
   DATA 40,56,41
   DATA 41,56,57
   DATA 41,57,44
   DATA 41,44,43
   DATA 41,43,42
   DATA 44,57,58
   DATA 44,58,46
   DATA 44,46,45
   DATA 46,58,59
   DATA 46,59,49
   DATA 46,49,48
   DATA 46,48,47
   DATA 49,59,60
   DATA 49,60,51
   DATA 49,51,50
   DATA 51,60,55
   DATA 51,55,54
   DATA 51,54,53
   DATA 51,53,52
   DATA 55,60,59
   DATA 55,59,58
   DATA 55,58,57
   DATA 55,57,56
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO 116
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT L=P2-P1
      MAT M=P1-P0
      LET X0(I)=P0(1)
      LET Y0(I)=P0(2)
      LET Z0(I)=P0(3)
      LET X1(I)=P1(1)
      LET Y1(I)=P1(2)
      LET Z1(I)=P1(3)
      LET X2(I)=P2(1)
      LET Y2(I)=P2(2)
      LET Z2(I)=P2(3)
      LET KEY(I)=(Z0(I)+Z1(I)+Z2(I))/3 !'各頂点のZ座標値の平均
      LET INDEX(I)=I
   NEXT I
   CALL QUICKSORT(1,116,KEY,INDEX) !'Zソート
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO 116
      LET P0(1)=X0(INDEX(I))
      LET P0(2)=Y0(INDEX(I))
      LET P0(3)=Z0(INDEX(I))
      LET P1(1)=X1(INDEX(I))
      LET P1(2)=Y1(INDEX(I))
      LET P1(3)=Z1(INDEX(I))
      LET P2(1)=X2(INDEX(I))
      LET P2(2)=Y2(INDEX(I))
      LET P2(3)=Z2(INDEX(I))
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      CALL SETBRIGHTNESS(N)
      CALL PLOT3(P0,P1,P2)
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM LIGHT(3)
MAT READ LIGHT      ! 光源の向き
DATA 1,1,1
LET S=DOT(LIGHT,N)/(SQR(DOT(LIGHT,LIGHT))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB

EXTERNAL SUB QUICKSORT(FI,LA,A(),INDEX())
LET X=A(INDEX((FI+LA)/2))
LET I=FI
LET J=LA
DO
   DO WHILE A(INDEX(I))<X
      LET I=I+1
   LOOP
   DO WHILE X<A(INDEX(J))
      LET J=J-1
   LOOP
   IF I>=J THEN EXIT DO
   SWAP INDEX(I),INDEX(J)
   LET I=I+1
   LET J=J-1
LOOP
IF FI<I-1 THEN CALL QUICKSORT(FI,I-1,A,INDEX)
IF J+1<LA THEN CALL QUICKSORT(J+1,LA,A,INDEX)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時12分38秒
  12・20面体を表示します(Zソート)


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
DIM X0(200),Y0(200),Z0(200),X1(200),Y1(200),Z1(200),X2(200),Y2(200),Z2(200),KEY(200),INDEX(200)
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
DIM XX(100),YY(100),ZZ(100)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 5:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   RESTORE
   FOR I=1 TO 30
      READ XX(I),YY(I),ZZ(I)
   NEXT I
   DATA -.30901699 , 0 ,-.95105652 !'座標データ
   DATA -.80901699 , 0 ,-.58778525
   DATA -1 , 0 , 0
   DATA -.80901699 , 0 , .58778525
   DATA -.309017 , 0 , .95105652
   DATA  .30901699 , 0 , .95105652
   DATA  .80901699 , 0 , .58778525
   DATA  1 , 0 , 0
   DATA  .80901699 , 0 ,-.58778525
   DATA  .30901699 , 0 ,-.95105652
   DATA  0 ,-.52573111 ,-.85065081
   DATA -.80901699 ,-.52573111 ,-.26286556
   DATA -.5 ,-.52573111 , .68819096
   DATA  .5 ,-.52573111 , .68819096
   DATA  .80901699 ,-.52573111 ,-.26286556
   DATA -.30901699 ,-.85065081 ,-.4253254
   DATA -.5 ,-.85065081 , .16245985
   DATA  0 ,-.85065081 , .52573111
   DATA  .5 ,-.85065081 , .16245985
   DATA  .30901699 ,-.85065081 ,-.4253254
   DATA -.5 , .52573111 ,-.68819096
   DATA  .5 , .52573111 ,-.68819096
   DATA  .80901699 , .52573111 , .26286556
   DATA  0 , .52573111 , .85065081
   DATA -.80901699 , .52573111 , .26286556
   DATA  0 , .85065081 ,-.52573111
   DATA  .5 , .85065081 ,-.16245985
   DATA  .30901699 , .85065081 , .4253254
   DATA -.30901699 , .85065081 , .4253254
   DATA -.5 , .85065081 ,-.16245985
   FOR I=1 TO 56
      READ A,B,C
      LET X0(I)=XX(A)
      LET Y0(I)=YY(A)
      LET Z0(I)=ZZ(A)
      LET X1(I)=XX(B)
      LET Y1(I)=YY(B)
      LET Z1(I)=ZZ(B)
      LET X2(I)=XX(C)
      LET Y2(I)=YY(C)
      LET Z2(I)=ZZ(C)
   NEXT I
   DATA 1,2,12 !'メッシュデータ
   DATA 1,12,16
   DATA 1,16,11
   DATA 1,11,10
   DATA 1,10,22
   DATA 1,22,26
   DATA 1,26,21
   DATA 1,21,2
   DATA 2,3,12
   DATA 2,21,30
   DATA 2,30,25
   DATA 2,25,3
   DATA 3,4,13
   DATA 3,13,17
   DATA 3,17,12
   DATA 3,25,4
   DATA 4,5,13
   DATA 4,25,29
   DATA 4,29,24
   DATA 4,24,5
   DATA 5,6,14
   DATA 5,14,18
   DATA 5,18,13
   DATA 5,24,6
   DATA 6,7,14
   DATA 6,24,28
   DATA 6,28,23
   DATA 6,23,7
   DATA 7,8,15
   DATA 7,15,19
   DATA 7,19,14
   DATA 7,23,8
   DATA 8,9,15
   DATA 8,23,27
   DATA 8,27,22
   DATA 8,22,9
   DATA 9,10,11
   DATA 9,11,20
   DATA 9,20,15
   DATA 9,22,10
   DATA 11,16,20
   DATA 12,17,16
   DATA 13,18,17
   DATA 14,19,18
   DATA 15,20,19
   DATA 16,17,18
   DATA 16,18,19
   DATA 16,19,20
   DATA 21,26,30
   DATA 22,27,26
   DATA 23,28,27
   DATA 24,29,28
   DATA 25,30,29
   DATA 26,27,28
   DATA 26,28,29
   DATA 26,29,30
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO 56
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      MAT L=P2-P1
      MAT M=P1-P0
      LET X0(I)=P0(1)
      LET Y0(I)=P0(2)
      LET Z0(I)=P0(3)
      LET X1(I)=P1(1)
      LET Y1(I)=P1(2)
      LET Z1(I)=P1(3)
      LET X2(I)=P2(1)
      LET Y2(I)=P2(2)
      LET Z2(I)=P2(3)
      LET KEY(I)=(Z0(I)+Z1(I)+Z2(I))/3 !'各頂点のZ座標値の平均
      LET INDEX(I)=I
   NEXT I
   CALL QUICKSORT(1,56,KEY,INDEX)  !'Zソート
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO 56
      LET P0(1)=X0(INDEX(I))
      LET P0(2)=Y0(INDEX(I))
      LET P0(3)=Z0(INDEX(I))
      LET P1(1)=X1(INDEX(I))
      LET P1(2)=Y1(INDEX(I))
      LET P1(3)=Z1(INDEX(I))
      LET P2(1)=X2(INDEX(I))
      LET P2(2)=Y2(INDEX(I))
      LET P2(3)=Z2(INDEX(I))
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      CALL SETBRIGHTNESS(N)
      CALL PLOT3(P0,P1,P2)
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM LIGHT(3)
MAT READ LIGHT      ! 光源の向き
DATA 1,1,1
LET S=DOT(LIGHT,N)/(SQR(DOT(LIGHT,LIGHT))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB

EXTERNAL SUB QUICKSORT(FI,LA,A(),INDEX())
LET X=A(INDEX((FI+LA)/2))
LET I=FI
LET J=LA
DO
   DO WHILE A(INDEX(I))<X
      LET I=I+1
   LOOP
   DO WHILE X<A(INDEX(J))
      LET J=J-1
   LOOP
   IF I>=J THEN EXIT DO
   SWAP INDEX(I),INDEX(J)
   LET I=I+1
   LET J=J-1
LOOP
IF FI<I-1 THEN CALL QUICKSORT(FI,I-1,A,INDEX)
IF J+1<LA THEN CALL QUICKSORT(J+1,LA,A,INDEX)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時13分21秒
  トーラスを表示します(Zソート)


OPTION ANGLE DEGREES
LET NN=30
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
DIM X0(2*NN*NN),Y0(2*NN*NN),Z0(2*NN*NN),X1(2*NN*NN),Y1(2*NN*NN),Z1(2*NN*NN),X2(2*NN*NN),Y2(2*NN*NN),Z2(2*NN*NN),KEY(2*NN*NN),INDEX(2*NN*NN)
DIM P0(4),P1(4),P2(4),P3(4)
DIM N(3),L(4),M(4)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 30,AT 5 : SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
LOCATE VALUE NOWAIT(5),RANGE 0 TO 10,AT 0 : K
LOCATE VALUE NOWAIT(6),RANGE 0 TO 8,AT 1 : RR
LOCATE VALUE NOWAIT(7),RANGE 0 TO 8,AT .5 : R0
LOCATE VALUE NOWAIT(8),RANGE 0 TO 8,AT 1 : R1
LOCATE VALUE NOWAIT(9),RANGE 0 TO 8,AT 1 : R2
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   LOCATE VALUE NOWAIT(5):K
   LOCATE VALUE NOWAIT(6):RR
   LOCATE VALUE NOWAIT(7):R0
   LOCATE VALUE NOWAIT(8):R1
   LOCATE VALUE NOWAIT(9):R2
   LET K=INT(K)
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   LET NUM=0
   FOR I=0 TO NN-1
      FOR J=0 TO NN-1
         LET NUM=NUM+1
         LET ALPHA=I*360/NN
         LET BETA=J*360/NN
         LET XX0=(R1+R0*COS(ALPHA))*(R2+RR*COS(K*BETA))*COS(BETA)
         LET ZZ0=(R1+R0*COS(ALPHA))*(R2+RR*COS(K*BETA))*SIN(BETA)
         LET YY0=R0*SIN(ALPHA)*(R2+RR*COS(K*BETA))
         LET ALPHA=I*360/NN
         LET BETA=(J+1)*360/NN
         LET XX1=(R1+R0*COS(ALPHA))*(R2+RR*COS(K*BETA))*COS(BETA)
         LET ZZ1=(R1+R0*COS(ALPHA))*(R2+RR*COS(K*BETA))*SIN(BETA)
         LET YY1=R0*SIN(ALPHA)*(R2+RR*COS(K*BETA))
         LET ALPHA=(I+1)*360/NN
         LET BETA=(J+1)*360/NN
         LET XX2=(R1+R0*COS(ALPHA))*(R2+RR*COS(K*BETA))*COS(BETA)
         LET ZZ2=(R1+R0*COS(ALPHA))*(R2+RR*COS(K*BETA))*SIN(BETA)
         LET YY2=R0*SIN(ALPHA)*(R2+RR*COS(K*BETA))
         LET ALPHA=(I+1)*360/NN
         LET BETA=J*360/NN
         LET XX3=(R1+R0*COS(ALPHA))*(R2+RR*COS(K*BETA))*COS(BETA)
         LET ZZ3=(R1+R0*COS(ALPHA))*(R2+RR*COS(K*BETA))*SIN(BETA)
         LET YY3=R0*SIN(ALPHA)*(R2+RR*COS(K*BETA))
         LET X0(NUM)=XX0
         LET Y0(NUM)=YY0
         LET Z0(NUM)=ZZ0
         LET X1(NUM)=XX1
         LET Y1(NUM)=YY1
         LET Z1(NUM)=ZZ1
         LET X2(NUM)=XX2
         LET Y2(NUM)=YY2
         LET Z2(NUM)=ZZ2
         LET NUM=NUM+1
         LET X0(NUM)=XX0
         LET Y0(NUM)=YY0
         LET Z0(NUM)=ZZ0
         LET X1(NUM)=XX2
         LET Y1(NUM)=YY2
         LET Z1(NUM)=ZZ2
         LET X2(NUM)=XX3
         LET Y2(NUM)=YY3
         LET Z2(NUM)=ZZ3
      NEXT J
   NEXT I
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   FOR I=1 TO NUM
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      LET X0(I)=P0(1)
      LET Y0(I)=P0(2)
      LET Z0(I)=P0(3)
      LET X1(I)=P1(1)
      LET Y1(I)=P1(2)
      LET Z1(I)=P1(3)
      LET X2(I)=P2(1)
      LET Y2(I)=P2(2)
      LET Z2(I)=P2(3)
      LET KEY(I)=(Z0(I)+Z1(I)+Z2(I))/3 !'各頂点のZ座標値の平均
      LET INDEX(I)=I
   NEXT I
   CALL QUICKSORT(1,NUM,KEY,INDEX) !'Zソート
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO NUM
      LET P0(1)=X0(INDEX(I))
      LET P0(2)=Y0(INDEX(I))
      LET P0(3)=Z0(INDEX(I))
      LET P1(1)=X1(INDEX(I))
      LET P1(2)=Y1(INDEX(I))
      LET P1(3)=Z1(INDEX(I))
      LET P2(1)=X2(INDEX(I))
      LET P2(2)=Y2(INDEX(I))
      LET P2(3)=Z2(INDEX(I))
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      IF DOT(N,N)<>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM LA(3),LIGHT(3)
MAT READ LA
DATA .8,.6,.3
MAT READ LIGHT
DATA 1,1,1
LET S=DOT(LIGHT,N)/(SQR(DOT(LIGHT,LIGHT))*SQR(DOT(N,N)))
LET S=ABS(S)
MAT LA=((S+1)/2)*LA
SET COLOR MIX(8) LA(1),LA(2),LA(3)
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB

EXTERNAL SUB QUICKSORT(FI,LA,A(),INDEX())
LET X=A(INDEX((FI+LA)/2))
LET I=FI
LET J=LA
DO
   DO WHILE A(INDEX(I))<X
      LET I=I+1
   LOOP
   DO WHILE X<A(INDEX(J))
      LET J=J-1
   LOOP
   IF I>=J THEN EXIT DO
   SWAP INDEX(I),INDEX(J)
   LET I=I+1
   LET J=J-1
LOOP
IF FI<I-1 THEN CALL QUICKSORT(FI,I-1,A,INDEX)
IF J+1<LA THEN CALL QUICKSORT(J+1,LA,A,INDEX)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時14分2秒
  花型球体を表示します(Zソート)


OPTION ANGLE DEGREES
LET NN=30
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
DIM X0(2*NN*NN),Y0(2*NN*NN),Z0(2*NN*NN),X1(2*NN*NN),Y1(2*NN*NN),Z1(2*NN*NN),X2(2*NN*NN),Y2(2*NN*NN),Z2(2*NN*NN),KEY(2*NN*NN),INDEX(2*NN*NN)
DIM P0(4),P1(4),P2(4),P3(4)
DIM N(3),L(4),M(4)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 5,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
LOCATE VALUE NOWAIT(5),RANGE 1 TO 10,AT 1:A
LOCATE VALUE NOWAIT(6),RANGE 1 TO 10,AT 1:B
LOCATE VALUE NOWAIT(7),RANGE 1 TO 10,AT 1:N1
LOCATE VALUE NOWAIT(8),RANGE 1 TO 10,AT 1:M1
LOCATE VALUE NOWAIT(9),RANGE 1 TO 10,AT 1:RR
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   LOCATE VALUE NOWAIT(5):A
   LOCATE VALUE NOWAIT(6):B
   LOCATE VALUE NOWAIT(7):N1
   LOCATE VALUE NOWAIT(8):M1
   LOCATE VALUE NOWAIT(9):RR
   LET N1=INT(N1)
   LET M1=INT(M1)
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   LET NUM=0
   FOR I=0 TO NN-1
      FOR J=0 TO NN-1
         LET NUM=NUM+1
         LET R0=FUNC(1,A/20,B/20,N1,M1,RR/10,I*180/NN,J*360/NN)
         LET XX0=-R0*SIN(I*180/NN)*COS(J*360/NN)
         LET YY0=R0*COS(I*180/NN)
         LET ZZ0=R0*SIN(I*180/NN)*SIN(J*360/NN)
         LET R0=FUNC(1,A/20,B/20,N1,M1,RR/10,I*180/NN,(J+1)*360/NN)
         LET XX1=-R0*SIN(I*180/NN)*COS((J+1)*360/NN)
         LET YY1=R0*COS(I*180/NN)
         LET ZZ1=R0*SIN(I*180/NN)*SIN((J+1)*360/NN)
         LET R0=FUNC(1,A/20,B/20,N1,M1,RR/10,(I+1)*180/NN,(J+1)*360/NN)
         LET XX2=-R0*SIN((I+1)*180/NN)*COS((J+1)*360/NN)
         LET YY2=R0*COS((I+1)*180/NN)
         LET ZZ2=R0*SIN((I+1)*180/NN)*SIN((J+1)*360/NN)
         LET R0=FUNC(1,A/20,B/20,N1,M1,RR/10,(I+1)*180/NN,J*360/NN)
         LET XX3=-R0*SIN((I+1)*180/NN)*COS(J*360/NN)
         LET YY3=R0*COS((I+1)*180/NN)
         LET ZZ3=R0*SIN((I+1)*180/NN)*SIN(J*360/NN)
         LET X0(NUM)=XX0
         LET Y0(NUM)=YY0
         LET Z0(NUM)=ZZ0
         LET X1(NUM)=XX1
         LET Y1(NUM)=YY1
         LET Z1(NUM)=ZZ1
         LET X2(NUM)=XX2
         LET Y2(NUM)=YY2
         LET Z2(NUM)=ZZ2
         LET NUM=NUM+1
         LET X0(NUM)=XX0
         LET Y0(NUM)=YY0
         LET Z0(NUM)=ZZ0
         LET X1(NUM)=XX2
         LET Y1(NUM)=YY2
         LET Z1(NUM)=ZZ2
         LET X2(NUM)=XX3
         LET Y2(NUM)=YY3
         LET Z2(NUM)=ZZ3
      NEXT J
   NEXT I
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   FOR I=1 TO NUM
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      LET X0(I)=P0(1)
      LET Y0(I)=P0(2)
      LET Z0(I)=P0(3)
      LET X1(I)=P1(1)
      LET Y1(I)=P1(2)
      LET Z1(I)=P1(3)
      LET X2(I)=P2(1)
      LET Y2(I)=P2(2)
      LET Z2(I)=P2(3)
      LET KEY(I)=(Z0(I)+Z1(I)+Z2(I))/3 !'各頂点のZ座標値の平均
      LET INDEX(I)=I
   NEXT I
   CALL QUICKSORT(1,NUM,KEY,INDEX) !'Zソート
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO NUM
      LET P0(1)=X0(INDEX(I))
      LET P0(2)=Y0(INDEX(I))
      LET P0(3)=Z0(INDEX(I))
      LET P1(1)=X1(INDEX(I))
      LET P1(2)=Y1(INDEX(I))
      LET P1(3)=Z1(INDEX(I))
      LET P2(1)=X2(INDEX(I))
      LET P2(2)=Y2(INDEX(I))
      LET P2(3)=Z2(INDEX(I))
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      IF DOT(N,N)<>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  FUNCTION FUNC(R,A,B,N,M,RR,ALPHA,BETA) !'バラ曲線
OPTION ANGLE DEGREES
LET FUNC=ABS(R*(1+A*SIN(ALPHA*N)*(1+B*SIN(BETA*M)+RR)))
END FUNCTION

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM LA(3),LIGHT(3)
MAT READ LA
DATA .8,.8,.1
MAT READ LIGHT
DATA 1,1,1
LET S=DOT(LIGHT,N)/(SQR(DOT(LIGHT,LIGHT))*SQR(DOT(N,N)))
MAT LA=((S+1)/2)*LA
SET COLOR MIX(8) LA(1),LA(2),LA(3)
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB

EXTERNAL SUB QUICKSORT(FI,LA,A(),INDEX())
LET X=A(INDEX((FI+LA)/2))
LET I=FI
LET J=LA
DO
   DO WHILE A(INDEX(I))<X
      LET I=I+1
   LOOP
   DO WHILE X<A(INDEX(J))
      LET J=J-1
   LOOP
   IF I>=J THEN EXIT DO
   SWAP INDEX(I),INDEX(J)
   LET I=I+1
   LET J=J-1
LOOP
IF FI<I-1 THEN CALL QUICKSORT(FI,I-1,A,INDEX)
IF J+1<LA THEN CALL QUICKSORT(J+1,LA,A,INDEX)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時14分45秒
  超楕円体を表示します(Zソート)


OPTION ANGLE DEGREES
LET NN=30
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
DIM X0(2*NN*NN),Y0(2*NN*NN),Z0(2*NN*NN),X1(2*NN*NN),Y1(2*NN*NN),Z1(2*NN*NN),X2(2*NN*NN),Y2(2*NN*NN),Z2(2*NN*NN),KEY(2*NN*NN),INDEX(2*NN*NN)
DIM P0(4),P1(4),P2(4),P3(4)
DIM N(3),L(4),M(4)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 5,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
LOCATE VALUE NOWAIT(5),RANGE 0 TO 4,AT 1:N0
LOCATE VALUE NOWAIT(6),RANGE 0 TO 4,AT 1:M0
LOCATE VALUE NOWAIT(7),RANGE .1 TO 4,AT 1:R1
LOCATE VALUE NOWAIT(8),RANGE .1 TO 4,AT 1:R2
LOCATE VALUE NOWAIT(9),RANGE .1 TO 4,AT 1:R3
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   LOCATE VALUE NOWAIT(5):N0
   LOCATE VALUE NOWAIT(6):M0
   LOCATE VALUE NOWAIT(7):R1
   LOCATE VALUE NOWAIT(8):R2
   LOCATE VALUE NOWAIT(9):R3
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   LET NUM=0
   FOR I=0 TO NN-1
      FOR J=0 TO NN-1
         LET NUM=NUM+1
         LET XX0=-R1*SGN(SIN(I*180/NN))*ABS(SIN(I*180/NN))^N0*SGN(COS(J*360/NN))*ABS(COS(J*360/NN))^M0
         LET YY0=R2*SGN(COS(I*180/NN))*ABS(COS(I*180/NN))^N0
         LET ZZ0=R3*SGN(SIN(I*180/NN))*ABS(SIN(I*180/NN))^N0*SGN(SIN(J*360/NN))*ABS(SIN(J*360/NN))^M0
         LET XX1=-R1*SGN(SIN(I*180/NN))*ABS(SIN(I*180/NN))^N0*SGN(COS((J+1)*360/NN))*ABS(COS((J+1)*360/NN))^M0
         LET YY1=R2*SGN(COS(I*180/NN))*ABS(COS(I*180/NN))^N0
         LET ZZ1=R3*SGN(SIN(I*180/NN))*ABS(SIN(I*180/NN))^N0*SGN(SIN((J+1)*360/NN))*ABS(SIN((J+1)*360/NN))^M0
         LET XX2=-R1*SGN(SIN((I+1)*180/NN))*ABS(SIN((I+1)*180/NN))^N0*SGN(COS((J+1)*360/NN))*ABS(COS((J+1)*360/NN))^M0
         LET YY2=R2*SGN(COS((I+1)*180/NN))*ABS(COS((I+1)*180/NN))^N0
         LET ZZ2=R3*SGN(SIN((I+1)*180/NN))*ABS(SIN((I+1)*180/NN))^N0*SGN(SIN((J+1)*360/NN))*ABS(SIN((J+1)*360/NN))^M0
         LET XX3=-R1*SGN(SIN((I+1)*180/NN))*ABS(SIN((I+1)*180/NN))^N0*SGN(COS(J*360/NN))*ABS(COS(J*360/NN))^M0
         LET YY3=R2*SGN(COS((I+1)*180/NN))*ABS(COS((I+1)*180/NN))^N0
         LET ZZ3=R3*SGN(SIN((I+1)*180/NN))*ABS(SIN((I+1)*180/NN))^N0*SGN(SIN(J*360/NN))*ABS(SIN(J*360/NN))^M0
         LET X0(NUM)=XX0
         LET Y0(NUM)=YY0
         LET Z0(NUM)=ZZ0
         LET X1(NUM)=XX1
         LET Y1(NUM)=YY1
         LET Z1(NUM)=ZZ1
         LET X2(NUM)=XX2
         LET Y2(NUM)=YY2
         LET Z2(NUM)=ZZ2
         LET NUM=NUM+1
         LET X0(NUM)=XX0
         LET Y0(NUM)=YY0
         LET Z0(NUM)=ZZ0
         LET X1(NUM)=XX2
         LET Y1(NUM)=YY2
         LET Z1(NUM)=ZZ2
         LET X2(NUM)=XX3
         LET Y2(NUM)=YY3
         LET Z2(NUM)=ZZ3
      NEXT J
   NEXT I
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   FOR I=1 TO NUM
      LET P0(1)=X0(I)
      LET P0(2)=Y0(I)
      LET P0(3)=Z0(I)
      LET P1(1)=X1(I)
      LET P1(2)=Y1(I)
      LET P1(3)=Z1(I)
      LET P2(1)=X2(I)
      LET P2(2)=Y2(I)
      LET P2(3)=Z2(I)
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      LET X0(I)=P0(1)
      LET Y0(I)=P0(2)
      LET Z0(I)=P0(3)
      LET X1(I)=P1(1)
      LET Y1(I)=P1(2)
      LET Z1(I)=P1(3)
      LET X2(I)=P2(1)
      LET Y2(I)=P2(2)
      LET Z2(I)=P2(3)
      LET KEY(I)=(Z0(I)+Z1(I)+Z2(I))/3 !'各頂点のZ座標値の平均
      LET INDEX(I)=I
   NEXT I
   CALL QUICKSORT(1,NUM,KEY,INDEX) !'Zソート
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO NUM
      LET P0(1)=X0(INDEX(I))
      LET P0(2)=Y0(INDEX(I))
      LET P0(3)=Z0(INDEX(I))
      LET P1(1)=X1(INDEX(I))
      LET P1(2)=Y1(INDEX(I))
      LET P1(3)=Z1(INDEX(I))
      LET P2(1)=X2(INDEX(I))
      LET P2(2)=Y2(INDEX(I))
      LET P2(3)=Z2(INDEX(I))
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      IF DOT(N,N)<>0 THEN
         CALL SETBRIGHTNESS(N)
         CALL PLOT3(P0,P1,P2)
      END IF
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM LA(3),LIGHT(3)
MAT READ LA
DATA .8,.8,.1
MAT READ LIGHT
DATA 1,1,1
LET S=DOT(LIGHT,N)/(SQR(DOT(LIGHT,LIGHT))*SQR(DOT(N,N)))
LET S=ABS(S)
MAT LA=((S+1)/2)*LA
SET COLOR MIX(8) LA(1),LA(2),LA(3)
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB

EXTERNAL SUB QUICKSORT(FI,LA,A(),INDEX())
LET X=A(INDEX((FI+LA)/2))
LET I=FI
LET J=LA
DO
   DO WHILE A(INDEX(I))<X
      LET I=I+1
   LOOP
   DO WHILE X<A(INDEX(J))
      LET J=J-1
   LOOP
   IF I>=J THEN EXIT DO
   SWAP INDEX(I),INDEX(J)
   LET I=I+1
   LET J=J-1
LOOP
IF FI<I-1 THEN CALL QUICKSORT(FI,I-1,A,INDEX)
IF J+1<LA THEN CALL QUICKSORT(J+1,LA,A,INDEX)
END SUB
 
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時15分35秒
  シェルピンスキーの三角形を表示します(Zソート)

https://ja.wikipedia.org/wiki/シェルピンスキーのギャスケット

4面体を使用し、シェルピンスキーの三角形を表示します


OPTION ANGLE DEGREES
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
INPUT  PROMPT "LEVEL (1-4)=":LEV
DIM X0(4^(LEV+1)),Y0(4^(LEV+1)),Z0(4^(LEV+1)),X1(4^(LEV+1)),Y1(4^(LEV+1)),Z1(4^(LEV+1)),X2(4^(LEV+1)),Y2(4^(LEV+1)),Z2(4^(LEV+1)),KEY(4^(LEV+1)),INDEX(4^(LEV+1))
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT 3:SCALE
LOCATE VALUE NOWAIT(2),RANGE -360 TO 360,AT 0:XTH
LOCATE VALUE NOWAIT(3),RANGE -360 TO 360,AT 0:YTH
LOCATE VALUE NOWAIT(4),RANGE -360 TO 360,AT 0:ZTH
DO
   LOCATE VALUE NOWAIT(1):SCALE
   LOCATE VALUE NOWAIT(2):XTH
   LOCATE VALUE NOWAIT(3):YTH
   LOCATE VALUE NOWAIT(4):ZTH
   SET WINDOW -SCALE,SCALE,-SCALE,SCALE
   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 Q=ROTATE(ZTH)
   MAT Q=Q*ROTY*ROTX
   LET NUM=0
   CALL RECURSIVE(LEV,0,0,0,1)
   LET MX=0
   LET MY=0
   LET MZ=0
   FOR I=1 TO NUM !'重心を求める
      LET MX=MX+X0(I)
      LET MY=MY+Y0(I)
      LET MZ=MZ+Z0(I)
      LET MX=MX+X1(I)
      LET MY=MY+Y1(I)
      LET MZ=MZ+Z1(I)
      LET MX=MX+X2(I)
      LET MY=MY+Y2(I)
      LET MZ=MZ+Z2(I)
   NEXT I
   LET MX=MX/3/NUM
   LET MY=MY/3/NUM
   LET MZ=MZ/3/NUM
   FOR I=1 TO NUM
      LET P0(1)=X0(I)-MX
      LET P0(2)=Y0(I)-MY
      LET P0(3)=Z0(I)-MZ
      LET P1(1)=X1(I)-MX
      LET P1(2)=Y1(I)-MY
      LET P1(3)=Z1(I)-MZ
      LET P2(1)=X2(I)-MX
      LET P2(2)=Y2(I)-MY
      LET P2(3)=Z2(I)-MZ
      LET P0(4),P1(4),P2(4)=1
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      LET X0(I)=P0(1)
      LET Y0(I)=P0(2)
      LET Z0(I)=P0(3)
      LET X1(I)=P1(1)
      LET Y1(I)=P1(2)
      LET Z1(I)=P1(3)
      LET X2(I)=P2(1)
      LET Y2(I)=P2(2)
      LET Z2(I)=P2(3)
      LET KEY(I)=(Z0(I)+Z1(I)+Z2(I))/3 !'各頂点のZ座標値の平均
      LET INDEX(I)=I
   NEXT I
   CALL QUICKSORT(1,NUM,KEY,INDEX) !'Zソート
   SET DRAW MODE HIDDEN
   CLEAR
   FOR I=1 TO NUM
      LET P0(1)=X0(INDEX(I))
      LET P0(2)=Y0(INDEX(I))
      LET P0(3)=Z0(INDEX(I))
      LET P1(1)=X1(INDEX(I))
      LET P1(2)=Y1(INDEX(I))
      LET P1(3)=Z1(INDEX(I))
      LET P2(1)=X2(INDEX(I))
      LET P2(2)=Y2(INDEX(I))
      LET P2(3)=Z2(INDEX(I))
      MAT L=P2-P1
      MAT M=P1-P0
      CALL OUTER(N,L,M)
      CALL SETBRIGHTNESS(N)
      CALL PLOT3(P0,P1,P2)
   NEXT I
   SET DRAW MODE EXPLICIT
LOOP

SUB TETRAHEDRON(X,Y,Z,L) !'4面体
   LET XX1=X+L*COS(0)
   LET ZZ1=Z+L*SIN(0)
   LET YY1=Y
   LET XX2=X+L*COS(120)
   LET ZZ2=Z+L*SIN(120)
   LET YY2=Y
   LET XX3=X+L*COS(240)
   LET ZZ3=Z+L*SIN(240)
   LET YY3=Y
   LET XX4=X
   LET ZZ4=Z
   LET YY4=Y+L*SQR(2)
   LET NUM=NUM+1
   LET X0(NUM)=XX4
   LET Y0(NUM)=YY4
   LET Z0(NUM)=ZZ4
   LET X1(NUM)=XX1
   LET Y1(NUM)=YY1
   LET Z1(NUM)=ZZ1
   LET X2(NUM)=XX2
   LET Y2(NUM)=YY2
   LET Z2(NUM)=ZZ2
   LET NUM=NUM+1
   LET X0(NUM)=XX3
   LET Y0(NUM)=YY3
   LET Z0(NUM)=ZZ3
   LET X1(NUM)=XX2
   LET Y1(NUM)=YY2
   LET Z1(NUM)=ZZ2
   LET X2(NUM)=XX1
   LET Y2(NUM)=YY1
   LET Z2(NUM)=ZZ1
   LET NUM=NUM+1
   LET X0(NUM)=XX4
   LET Y0(NUM)=YY4
   LET Z0(NUM)=ZZ4
   LET X1(NUM)=XX3
   LET Y1(NUM)=YY3
   LET Z1(NUM)=ZZ3
   LET X2(NUM)=XX1
   LET Y2(NUM)=YY1
   LET Z2(NUM)=ZZ1
   LET NUM=NUM+1
   LET X0(NUM)=XX4
   LET Y0(NUM)=YY4
   LET Z0(NUM)=ZZ4
   LET X1(NUM)=XX2
   LET Y1(NUM)=YY2
   LET Z1(NUM)=ZZ2
   LET X2(NUM)=XX3
   LET Y2(NUM)=YY3
   LET Z2(NUM)=ZZ3
END SUB

SUB RECURSIVE(LEV,X,Y,Z,L) !'シェルピンスキー
   IF LEV=0 THEN
      CALL TETRAHEDRON(X,Y,Z,L*2)
   ELSE
      CALL RECURSIVE(LEV-1,X,Y+L*SQR(2),Z,L/2)
      CALL RECURSIVE(LEV-1,X+L*COS(0),Y,Z+L*SIN(0),L/2)
      CALL RECURSIVE(LEV-1,X+L*COS(120),Y,Z+L*SIN(120),L/2)
      CALL RECURSIVE(LEV-1,X+L*COS(240),Y,Z+L*SIN(240),L/2)
   END IF
END SUB
END

EXTERNAL  SUB PLOT3(P0(),P1(),P2()) !'3角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM A(3)
MAT READ A      ! 光源の向き
DATA 1,1,1
LET S=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB

EXTERNAL SUB QUICKSORT(FI,LA,A(),INDEX())
LET X=A(INDEX((FI+LA)/2))
LET I=FI
LET J=LA
DO
   DO WHILE A(INDEX(I))<X
      LET I=I+1
   LOOP
   DO WHILE X<A(INDEX(J))
      LET J=J-1
   LOOP
   IF I>=J THEN EXIT DO
   SWAP INDEX(I),INDEX(J)
   LET I=I+1
   LET J=J-1
LOOP
IF FI<I-1 THEN CALL QUICKSORT(FI,I-1,A,INDEX)
IF J+1<LA THEN CALL QUICKSORT(J+1,LA,A,INDEX)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時16分18秒
  メンガースポンジを表示します(Zソート)

https://ja.wikipedia.org/wiki/メンガーのスポンジ

立方体を大量に使用して、レベル4のメンガーを表示します。
表示が速いZソートですが、データ量が非常に多く処理が重いため表示のみです。


OPTION ANGLE DEGREES
LET ZTH=0           ! z軸のまわりの回転角
LET XTH=20          ! x軸のまわりの回転角初期値
LET YTH=10          ! y軸のまわりの回転角初期値
FOR I=0 TO 7
   SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
LET LEV=4
DIM X0(6*20^LEV),Y0(6*20^LEV),Z0(6*20^LEV),X1(6*20^LEV),Y1(6*20^LEV),Z1(6*20^LEV),X2(6*20^LEV),Y2(6*20^LEV),Z2(6*20^LEV)
DIM X3(6*20^LEV),Y3(6*20^LEV),Z3(6*20^LEV),KEY(6*20^LEV),INDEX(6*20^LEV)
DIM P0(4),P1(4),P2(4),P3(4)
DIM L(4),M(4),N(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
CALL RECURSIVE(LEV,0,0,0,2)
SET WINDOW -1.5,1.5,-1.5,1.5
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 Q=ROTATE(ZTH)
MAT Q=Q*ROTY*ROTX
FOR I=1 TO NUM
   LET P0(1)=X0(I)
   LET P0(2)=Y0(I)
   LET P0(3)=Z0(I)
   LET P1(1)=X1(I)
   LET P1(2)=Y1(I)
   LET P1(3)=Z1(I)
   LET P2(1)=X2(I)
   LET P2(2)=Y2(I)
   LET P2(3)=Z2(I)
   LET P3(1)=X3(I)
   LET P3(2)=Y3(I)
   LET P3(3)=Z3(I)
   LET P0(4),P1(4),P2(4),P3(4)=1
   MAT P0=P0*Q
   MAT P1=P1*Q
   MAT P2=P2*Q
   MAT P3=P3*Q
   LET X0(I)=P0(1)
   LET Y0(I)=P0(2)
   LET Z0(I)=P0(3)
   LET X1(I)=P1(1)
   LET Y1(I)=P1(2)
   LET Z1(I)=P1(3)
   LET X2(I)=P2(1)
   LET Y2(I)=P2(2)
   LET Z2(I)=P2(3)
   LET X3(I)=P3(1)
   LET Y3(I)=P3(2)
   LET Z3(I)=P3(3)
   LET KEY(I)=(Z0(I)+Z1(I)+Z2(I)+Z3(I))/4 !'各頂点のZ座標値の平均
   LET INDEX(I)=I
NEXT I
CALL QUICKSORT(1,NUM,KEY,INDEX) !'Zソート
SET DRAW MODE HIDDEN
CLEAR
FOR I=1 TO NUM
   LET P0(1)=X0(INDEX(I))
   LET P0(2)=Y0(INDEX(I))
   LET P0(3)=Z0(INDEX(I))
   LET P1(1)=X1(INDEX(I))
   LET P1(2)=Y1(INDEX(I))
   LET P1(3)=Z1(INDEX(I))
   LET P2(1)=X2(INDEX(I))
   LET P2(2)=Y2(INDEX(I))
   LET P2(3)=Z2(INDEX(I))
   LET P3(1)=X3(INDEX(I))
   LET P3(2)=Y3(INDEX(I))
   LET P3(3)=Z3(INDEX(I))
   MAT L=P3-P1
   MAT M=P1-P0
   CALL OUTER(N,L,M)
   CALL SETBRIGHTNESS(N)
   CALL PLOT4(P0,P1,P2,P3)
NEXT I
SET DRAW MODE EXPLICIT

SUB CUBE(X,Y,Z,L) !'立方体
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y+L/2
   LET Z0(NUM)=Z-L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y+L/2
   LET Z1(NUM)=Z-L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y+L/2
   LET Z2(NUM)=Z+L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y+L/2
   LET Z3(NUM)=Z+L/2
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y+L/2
   LET Z0(NUM)=Z+L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y+L/2
   LET Z1(NUM)=Z+L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y-L/2
   LET Z2(NUM)=Z+L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y-L/2
   LET Z3(NUM)=Z+L/2
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y-L/2
   LET Z0(NUM)=Z+L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y-L/2
   LET Z1(NUM)=Z+L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y-L/2
   LET Z2(NUM)=Z-L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y-L/2
   LET Z3(NUM)=Z-L/2
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y-L/2
   LET Z0(NUM)=Z-L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y-L/2
   LET Z1(NUM)=Z-L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y+L/2
   LET Z2(NUM)=Z-L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y+L/2
   LET Z3(NUM)=Z-L/2
   LET NUM=NUM+1
   LET X0(NUM)=X+L/2
   LET Y0(NUM)=Y+L/2
   LET Z0(NUM)=Z-L/2
   LET X1(NUM)=X+L/2
   LET Y1(NUM)=Y-L/2
   LET Z1(NUM)=Z-L/2
   LET X2(NUM)=X+L/2
   LET Y2(NUM)=Y-L/2
   LET Z2(NUM)=Z+L/2
   LET X3(NUM)=X+L/2
   LET Y3(NUM)=Y+L/2
   LET Z3(NUM)=Z+L/2
   LET NUM=NUM+1
   LET X0(NUM)=X-L/2
   LET Y0(NUM)=Y-L/2
   LET Z0(NUM)=Z-L/2
   LET X1(NUM)=X-L/2
   LET Y1(NUM)=Y+L/2
   LET Z1(NUM)=Z-L/2
   LET X2(NUM)=X-L/2
   LET Y2(NUM)=Y+L/2
   LET Z2(NUM)=Z+L/2
   LET X3(NUM)=X-L/2
   LET Y3(NUM)=Y-L/2
   LET Z3(NUM)=Z+L/2
END SUB

SUB RECURSIVE(N,X,Y,Z,L) !'メンガー
   IF N=0 THEN
      CALL CUBE(X,Y,Z,L)
   ELSE
      CALL RECURSIVE(N-1,X-L/3,Y+L/3,Z+L/3,L/3)
      CALL RECURSIVE(N-1,X,Y+L/3,Z+L/3,L/3)
      CALL RECURSIVE(N-1,X+L/3,Y+L/3,Z+L/3,L/3)
      CALL RECURSIVE(N-1,X-L/3,Y,Z+L/3,L/3)
      CALL RECURSIVE(N-1,X+L/3,Y,Z+L/3,L/3)
      CALL RECURSIVE(N-1,X-L/3,Y-L/3,Z+L/3,L/3)
      CALL RECURSIVE(N-1,X,Y-L/3,Z+L/3,L/3)
      CALL RECURSIVE(N-1,X+L/3,Y-L/3,Z+L/3,L/3)
      CALL RECURSIVE(N-1,X-L/3,Y+L/3,Z-L/3,L/3)
      CALL RECURSIVE(N-1,X,Y+L/3,Z-L/3,L/3)
      CALL RECURSIVE(N-1,X+L/3,Y+L/3,Z-L/3,L/3)
      CALL RECURSIVE(N-1,X-L/3,Y,Z-L/3,L/3)
      CALL RECURSIVE(N-1,X+L/3,Y,Z-L/3,L/3)
      CALL RECURSIVE(N-1,X-L/3,Y-L/3,Z-L/3,L/3)
      CALL RECURSIVE(N-1,X,Y-L/3,Z-L/3,L/3)
      CALL RECURSIVE(N-1,X+L/3,Y-L/3,Z-L/3,L/3)
      CALL RECURSIVE(N-1,X-L/3,Y+L/3,Z,L/3)
      CALL RECURSIVE(N-1,X+L/3,Y+L/3,Z,L/3)
      CALL RECURSIVE(N-1,X-L/3,Y-L/3,Z,L/3)
      CALL RECURSIVE(N-1,X+L/3,Y-L/3,Z,L/3)
   END IF
END SUB
END

EXTERNAL  SUB PLOT4(P0(),P1(),P2(),P3()) !'4角形描画
PLOT AREA :P0(1),P0(2);P1(1),P1(2);P2(1),P2(2);P3(1),P3(2)
END SUB

EXTERNAL SUB SETBRIGHTNESS(N())
DIM A(3)
MAT READ A      ! 光源の向き
DATA 1,1,1
LET S=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET S=(S+1)/2
SET COLOR MIX(8) S,S,S
SET AREA COLOR 8
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB

EXTERNAL SUB QUICKSORT(FI,LA,A(),INDEX())
LET X=A(INDEX((FI+LA)/2))
LET I=FI
LET J=LA
DO
   DO WHILE A(INDEX(I))<X
      LET I=I+1
   LOOP
   DO WHILE X<A(INDEX(J))
      LET J=J-1
   LOOP
   IF I>=J THEN EXIT DO
   SWAP INDEX(I),INDEX(J)
   LET I=I+1
   LET J=J-1
LOOP
IF FI<I-1 THEN CALL QUICKSORT(FI,I-1,A,INDEX)
IF J+1<LA THEN CALL QUICKSORT(J+1,LA,A,INDEX)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時20分41秒
  Zバッファと呼ばれる方法で3次元図形表示をします。
現在では主流な方法のようです。

Zバッファとは、Zバッファと呼ばれるメモリーを用意し
Z値を比較しながら、より手前にある場合にZ値を更新しながら描画していく方法です。


このプログラムでは、オブジェクト内を走査する必要があり
座標値は3D陽関数によって与えられている必要があります。


メインループにおいてステップ数が1/8となっていますが
これは隙間ができないようにするためで、計算量は増大しますが
手抜き処理なのでご了承下さい。

※本来はもっと複雑なアルゴリズムを用いてオブジェクト内を走査する必要があります。


ドット単位の描画のため処理に時間がかかります。
2進モードで実行してください。


プログラムが簡単な割に比較的高品位な画像が得られました。
下記のサンプル画像はY値を用いて青から赤へのグラデーションをかけています。



※Zバッファでは半透明(ガラス等)などは正しく描画できません。



3D陽関数を表示します(Zバッファ)


OPTION ANGLE DEGREES
LET ZTH=0          ! z軸のまわりの回転角
LET XTH=30         ! x軸のまわりの回転角初期値
LET YTH=0          ! y軸のまわりの回転角初期値
SET COLOR MIX(0) 0,0,0
CLEAR
SET COLOR MODE "NATIVE"
LET XS,YS,ZS=-5
LET XE,YE,ZE=5
SET WINDOW XS,XE,YS,YE
ASK BITMAP SIZE XSIZE,YSIZE
DIM ZBUFF(0 TO XSIZE,0 TO YSIZE),COLORMAP(0 TO XSIZE,0 TO YSIZE)
MAT ZBUFF=(-1000000000)*CON !' Zバッファー 無限遠 ∞
DIM P0(4),P1(4),P2(4)
DIM L(4),M(4),N(3)
DIM Q(4,4),ROTX(4,4),ROTY(4,4)
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 Q=ROTATE(ZTH)
MAT Q=Q*ROTY*ROTX
SET TEXT HEIGHT (YE-YS)/10
SET TEXT BACKGROUND "OPAQUE"
SET COLOR COLORINDEX(1,1,1)
LET YMIN=-1
LET YMAX=1
LET RMIN=0
LET RMAX=1
LET GMIN,GMAX=0
LET BMIN=1
LET BMAX=0
FOR I=0 TO YSIZE STEP 1/8
   PLOT TEXT ,AT XS,YS:USING$("###.##",I/YSIZE*100)&"%"
   FOR J=0 TO XSIZE STEP 1/8
      LET P0(1)=XS+(XE-XS)/XSIZE*J
      LET P0(3)=ZS+(ZE-ZS)/YSIZE*I
      LET P0(2)=FUNC(P0(1),P0(3))
      LET P1(1)=XS+(XE-XS)/XSIZE*(J+1)
      LET P1(3)=ZS+(ZE-ZS)/YSIZE*I
      LET P1(2)=FUNC(P1(1),P1(3))
      LET P2(1)=XS+(XE-XS)/XSIZE*(J+1)
      LET P2(3)=ZS+(ZE-ZS)/YSIZE*(I+1)
      LET P2(2)=FUNC(P2(1),P2(3))
      LET P0(4),P1(4),P2(4)=1
      LET Y0=P0(2)
      MAT P0=P0*Q
      MAT P1=P1*Q
      MAT P2=P2*Q
      LET XX=PIXELX(P0(1))
      LET YY=PIXELY(P0(2))
      LET ZZ=P0(3)
      IF XX>=0 AND XX<=XSIZE AND YY>=0 AND YY<=YSIZE THEN
         IF ZBUFF(XX,YY)<ZZ THEN !'手前なら
            LET ZBUFF(XX,YY)=ZZ !'Zバッファー値更新
            MAT L=P2-P1
            MAT M=P1-P0
            CALL OUTER(N,L,M)
            CALL SHADE(N,COLORMAP(XX,YY))
            !'CALL GRADATION(Y0,YMIN,YMAX,RMIN,RMAX,GMIN,GMAX,BMIN,BMAX,COLORMAP(XX,YY))
         END IF
      END IF
   NEXT  J
NEXT I
MAT PLOT CELLS, IN XS,YS ; XE,YE : COLORMAP
END

EXTERNAL FUNCTION FUNC(X,Z) !'3D陽関数
OPTION ANGLE RADIANS
LET FUNC=COS(3*SQR(X*X+Z*Z))
END FUNCTION

EXTERNAL  SUB GRADATION(X,SMIN,SMAX,RMIN,RMAX,GMIN,GMAX,BMIN,BMAX,COL)
LET T=(X-SMIN)/(SMAX-SMIN)
LET R=RMIN+T*(RMAX-RMIN)
LET G=GMIN+T*(GMAX-GMIN)
LET B=BMIN+T*(BMAX-BMIN)
LET COL=COLORINDEX(R,G,B)
END SUB

EXTERNAL SUB SHADE(N(),COL)
DIM LIGHT(3),CPOS(3),LA(3),KD(3),KS(3),KA(3),LC(3)
DIM VR(3),BR(3)
MAT READ CPOS !'視線ベクトル
DATA 0,0,1
MAT READ LA !'背景の色
DATA .2,.5,.8
MAT READ KD !'拡散反射係数
DATA 0.6,0.3,0.4
MAT READ KS !'鏡面反射係数
DATA 0.8,0.7,0.6
MAT READ KA !'環境光係数
DATA 0.3,0.2,0.1
MAT READ LC !'光源の色
DATA 1,.8,.7
MAT READ LIGHT !'光線ベクトル
DATA 1,1,1
LET NS=16
IF DOT(N,N)<>0 THEN MAT N=(1/SQR(DOT(N,N)))*N
MAT LIGHT=(1/SQR(DOT(LIGHT,LIGHT)))*LIGHT
LET COSTHETA=DOT(N,LIGHT)
IF COSTHETA<0 THEN
   IF BACK<>0 THEN LET COSTHETA=-COSTHETA ELSE LET COSTHETA=0
END IF
FOR I=1 TO 3
   LET VR(I)=2*COSTHETA*N(I)-LIGHT(I)
NEXT I
MAT CPOS=(1/SQR(DOT(CPOS,CPOS)))*CPOS
MAT VR=(1/SQR(DOT(VR,VR)))*VR
LET COSALPHA=DOT(CPOS,VR)
IF COSALPHA>0 THEN LET EA=COSALPHA^NS ELSE LET EA=0
FOR I=1 TO 3
   LET BR(I)=LC(I)*KD(I)*COSTHETA+LA(I)*KA(I)+LC(I)*KS(I)*EA
   LET BR(I)=MIN(1,MAX(0,BR(I)))
NEXT I
LET COL=COLORINDEX(BR(1),BR(2),BR(3))
END SUB

EXTERNAL SUB OUTER(C(),A(),B()) !'外積
LET C(1)=A(2)*B(3)-A(3)*B(2)
LET C(2)=A(3)*B(1)-A(1)*B(3)
LET C(3)=A(1)*B(2)-A(2)*B(1)
END SUB
 

3次元図形表示

 投稿者:しばっち  投稿日:2019年 3月30日(土)20時22分23秒
  メインループ内で球を(螺旋状に)移動させます。
すると、残像として描かれます。(※描いて消してないだけです)
移動させるためにループを追加しています。


実行時間にご注意ください。
このプログラムはBASIC Acc 又は Paract BASICの2進モードで実行してください。
※但し、最新のパワーマシン(ハイスペックPC)を除く(笑)

https://hp.vector.co.jp/authors/VA008683/BASICAccJa.htm
https://hp.vector.co.jp/authors/VA008683/BASICAcc2Ja.htm


最新鋭のモンスターマシンをお持ちの方は、更にループを加えて
2重、3重、4重螺旋等にしてみるのもおもしろいかと思います。
(計算時間が更に2倍、3倍、4倍になります)


螺旋を表示します(Zバッファ)
(球を360個表示しているだけです)


OPTION ANGLE DEGREES
LET ZTH=10          ! z軸のまわりの回転角
LET XTH=20          ! x軸のまわりの回転角初期値
LET YTH=0           ! y軸のまわりの回転角初期値
SET COLOR MIX(0) 0,0,0
CLEAR
SET COLOR MODE "NATIVE"
LET XS,YS=-5
LET XE,YE=5
SET WINDOW XS,XE,YS,YE
ASK BITMAP SIZE XSIZE,YSIZE
DIM ZBUFF(0 TO XSIZE,0 TO YSIZE),COLORMAP(0 TO XSIZE,0 TO YSIZE)
MAT ZBUFF=(-1000000000)*CON !' Zバッファー 無限遠 ∞
DIM P0(4)
DIM L(4),M(4),N(3)
DIM Q(4,4),Q0(4),ROTX(4,4),ROTY(4,4)
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 Q=ROTATE(ZTH)
MAT Q=Q*ROTY*ROTX
SET TEXT HEIGHT (YE-YS)/10
SET TEXT BACKGROUND "OPAQUE"
SET COLOR COLORINDEX(1,1,1)
LET YMIN=-.5
LET YMAX=.5
LET RMIN=0
LET RMAX=1
LET GMIN=0
LET GMAX=0
LET BMIN=1
LET BMAX=0
FOR I=0 TO 180 STEP 1/8
   PLOT TEXT ,AT XS,YS:USING$("###.##",I/180*100)&"%"
   FOR J=0 TO 360 STEP 1/8
      FOR K=0 TO 359 !'オブジェクトを移動させる
         LET X=COS(3*K)*RAD(K)/1.5
         LET Z=SIN(3*K)*RAD(K)/1.5
         LET Y=RAD(360-K)/2
         LET P0(1)=-.5*SIN(I)*COS(J)+X
         LET P0(2)=.5*COS(I)+Y
         LET P0(3)=.5*SIN(I)*SIN(J)+Z
         LET P0(4)=1
         LET Y0=P0(2)-Y
         MAT Q0=P0*Q
         LET XX=PIXELX(Q0(1))
         LET YY=PIXELY(Q0(2))
         LET ZZ=Q0(3)
         IF XX>=0 AND XX<=XSIZE AND YY>=0 AND YY<=YSIZE THEN
            IF ZBUFF(XX,YY)<ZZ THEN !'手前なら
               LET ZBUFF(XX,YY)=ZZ !'Zバッファー値更新
               CALL GRADATION(Y0,YMIN,YMAX,RMIN,RMAX,GMIN,GMAX,BMIN,BMAX,COLORMAP(XX,YY))
            END IF
         END IF
      NEXT K
   NEXT  J
NEXT I
MAT PLOT CELLS, IN XS,YS ; XE,YE : COLORMAP
END

EXTERNAL  SUB GRADATION(X,SMIN,SMAX,RMIN,RMAX,GMIN,GMAX,BMIN,BMAX,COL)
LET T=(X-SMIN)/(SMAX-SMIN)
LET R=RMIN+T*(RMAX-RMIN)
LET G=GMIN+T*(GMAX-GMIN)
LET B=BMIN+T*(BMAX-BMIN)
LET COL=COLORINDEX(R,G,B)
END SUB
 

戻る