teacup. [ 掲示板 ] [ 掲示板作成 ] [ 有料掲示板 ] [ ブログ ]

 投稿者
  題名
  内容 入力補助画像・ファイル<IMG>タグが利用可能です。(詳細)
    
 URL
[ ケータイで使う ] [ BBSティッカー ] [ 書込み通知 ] [ 検索 ]

スレッド一覧

  1. スレッドが使えます(2)
  2. Paract BASIC(22)
  3. Amusement_Program(10)
  4. 改修予定のJIS非互換(3)
  5. 複数ページ長編プログラム(新規投稿)(16)
  6. 「十進BASIC第2掲示板」投稿記事リスト(17)
  7. Full BASIC互換ライブラリ(8)
  8. 「十進BASIC掲示板過去ログ」インデックス(トピック)(17)
  9. 人の色覚の数理(14)
  10. 「十進BASIC掲示板過去ログ」インデックス(ツリー)(91)
スレッド一覧(全10)  他のスレッドを探す  スレッド作成

*掲示板をお持ちでない方へ、まずは掲示板を作成しましょう。無料掲示板作成


十進BASIC Ver. 7.8.5.3

 投稿者:SHIRAISHI Kazuo  投稿日:2019年 4月 7日(日)14時30分9秒
返信・引用 編集済
  十進BASIC Ver. 7.8.5.3で2点変更しました。
1.MARGIN初期値を2400に変更しました。
 既存の環境を引き継いでいる場合は,オプション設定-初期化 の実行後に有効になります。
 古い型のWinodowsだと2400桁の表示ができず,途中で強制改行されるかも知れません。
 その場合は,Basic.iniをメモ帳で開いて,InitialMargin=2400 の値を小さく書き換えてください。
2. 十進1000桁モード時,有効数字部の桁数を増やし,E表現にならないようにしました。
補足
Ver. 8.0.1.6 も同様です。


 
 

Re: 関数の面積分

 投稿者:島村1243  投稿日:2019年 4月 1日(月)20時26分36秒
返信・引用
  しばっち様へのお返事です。

> 三角形の内部かどうかの判断をしたいのなら、以前作成していたもので下記にいくつか記してみました。
> 計算方法によって精度が違います。ぜひお試しください。

早速に素晴らしいプログラムをご教示頂き、有難う御座います。
プログラムを読み解き利用させていただきます。
感謝!感謝!です。
 

Re: 関数の面積分

 投稿者:しばっち  投稿日:2019年 4月 1日(月)19時54分21秒
返信・引用
  > No.4664[元記事へ]

島村1243さんへのお返事です。

>  (手順2)点(x,y)の位置が三角形の内部に在ることを判断する。
>  (手順3)(x,y)点におけるf(x,y)を計算する。
>  (手順4)Σ{f(x,y)*dS}を求める。
>
> とすれば良い様に思うのですが、三角形ABCの位置座標が任意の場合、(2)の判断方法が複雑で、プログラムが思い付きません。(座標変換等の考慮が必要???)
> 何か良いお知恵が有りましたらご教示お願い致します。


三角形の内部かどうかの判断をしたいのなら、以前作成していたもので下記にいくつか記してみました。
計算方法によって精度が違います。ぜひお試しください。


SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 1,1,1
CLEAR
SET POINT STYLE 1
RANDOMIZE
LET X1=RND
LET Y1=RND
LET X2=RND
LET Y2=RND
LET X3=RND
LET Y3=RND
SET LINE COLOR 1
PLOT LINES:X1,Y1;X2,Y2;X3,Y3;X1,Y1
FOR I=1 TO 10000
   LET PX=RND
   LET PY=RND
   IF AREA4(X1,Y1,X2,Y2,X3,Y3,PX,PY)<>0 THEN
      SET POINT COLOR 4
   ELSE
      SET POINT COLOR 3
   END IF
   PLOT POINTS: PX,PY
NEXT I
END

EXTERNAL FUNCTION AREA(X1,Y1,X2,Y2,X3,Y3,PX,PY) !'面積
LET T=TRIANGLE(X1,Y1,X2,Y2,X3,Y3)
LET A=TRIANGLE(X1,Y1,X2,Y2,PX,PY)
LET B=TRIANGLE(X2,Y2,X3,Y3,PX,PY)
LET C=TRIANGLE(X1,Y1,X3,Y3,PX,PY)
ASK BITMAP SIZE XSIZE,YSIZE
IF ABS(A+B+C-T)<1/SQR(XSIZE^2+YSIZE^2) THEN LET AREA=-1 ELSE LET AREA=0
END FUNCTION

EXTERNAL FUNCTION TRIANGLE(X1,Y1,X2,Y2,X3,Y3)
LET TRIANGLE=ABS(X1*Y2+X2*Y3+X3*Y1-X2*Y1-X3*Y2-Y3*X1)/2
END FUNCTION

EXTERNAL FUNCTION AREA2(OX,OY,AX,AY,BX,BY,X,Y) !'ベクトル
LET A=AX-OX
LET B=BX-OX
LET C=AY-OY
LET D=BY-OY
LET PX=X-OX
LET PY=Y-OY
LET DET=A*D-B*C
IF DET=0 THEN
   LET AREA2=0
   EXIT FUNCTION
END IF
LET S=(D*PX-B*PY)/DET
IF S<0 THEN
   LET AREA2=0
   EXIT FUNCTION
END IF
LET T=(A*PY-C*PX)/DET
IF T<0 THEN
   LET AREA2=0
   EXIT FUNCTION
END IF
IF S+T<=1 THEN LET AREA2=-1 ELSE LET AREA2=0
END FUNCTION

EXTERNAL FUNCTION AREA3(X1,Y1,X2,Y2,X3,Y3,PX,PY) !'外積
DIM P(3),P0(3),P1(3),P2(3),P3(3),N1(3),N2(3),N3(3),L(3),M(3)
LET P(1)=PX
LET P(2)=PY
LET P(3)=PZ
LET P1(1)=X1
LET P1(2)=Y1
LET P1(3)=Z1
LET P2(1)=X2
LET P2(2)=Y2
LET P2(3)=Z2
LET P3(1)=X3
LET P3(2)=Y3
LET P3(3)=Z3
MAT L=P1-P
MAT M=P2-P
MAT N1=CROSS(L,M)
MAT L=P2-P
MAT M=P3-P
MAT N2=CROSS(L,M)
MAT L=P3-P
MAT M=P1-P
MAT N3=CROSS(L,M)
LET AREA3=-1
FOR I=1 TO 3
   IF SGN(N1(I))<>SGN(N2(I)) OR SGN(N2(I))<>SGN(N3(I)) THEN LET AREA3=0
NEXT I
END FUNCTION

EXTERNAL  FUNCTION AREA4(X1,Y1,X2,Y2,X3,Y3,PX,PY) !'内角の和
OPTION ANGLE DEGREES
LET LX=X1-PX
LET LY=Y1-PY
LET MX=X2-PX
LET MY=Y2-PY
LET NX=X3-PX
LET NY=Y3-PY
LET S=ACOS((LX*MX+LY*MY)/SQR(LX*LX+LY*LY)/SQR(MX*MX+MY*MY))
LET S=S+ACOS((NX*MX+NY*MY)/SQR(NX*NX+NY*NY)/SQR(MX*MX+MY*MY))
LET S=S+ACOS((NX*LX+NY*LY)/SQR(NX*NX+NY*NY)/SQR(LX*LX+LY*LY))
IF ABS(S-360)<1 THEN LET AREA4=-1 ELSE LET AREA4=0
END FUNCTION
 

関数の面積分

 投稿者:島村1243  投稿日:2019年 4月 1日(月)17時26分42秒
返信・引用
  二次元のxy直交軸座標系において、三角形ABCの頂点座標が
 A点座標:(x1,y1)
 B点座標:(x2,y2)
 C点座標:(x3,y3)
で与えられ、かつ、その三角形ABC内の(x,y)点において関数f(x,y)が
 f(x,y)=1+x+y
で与えられているとき、その三角形内におけるf(x,y)の面積分
 Σf(x,y)dxdy
を近似計算するプログラムを次の様に考えています。

Nを大きい数に指定して
 (手順1)xの変動領域(x1~x3)の最大値をXmax、(x1~X3)の最小値をXminiとし、又、同様に
     yの変動領域(y1~y3)の最大値をYmax、(y1~y3)の最小値をYminiとして
     dx=(Xmax-Xmini)/N
     dy=(Ymax-Ymini)/N
  微小面積dS=dx*dy
   を求める。
 (手順2)点(x,y)の位置が三角形の内部に在ることを判断する。
 (手順3)(x,y)点におけるf(x,y)を計算する。
 (手順4)Σ{f(x,y)*dS}を求める。

とすれば良い様に思うのですが、三角形ABCの位置座標が任意の場合、(2)の判断方法が複雑で、プログラムが思い付きません。(座標変換等の考慮が必要???)
何か良いお知恵が有りましたらご教示お願い致します。
 

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
 

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時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時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時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時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時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時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時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時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時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時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時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時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時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時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
 

レンタル掲示板
/163