投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
投稿者:しばっち
投稿日: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
|
|
|
戻る