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

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

スレッド一覧

  1. スレッドが使えます(2)
  2. Paract BASIC(21)
  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 第2掲示板のアーカイブス」

 投稿者:SECOND  投稿日:2018年 4月14日(土)18時37分37秒
返信・引用 編集済
  > No.4293[元記事へ]

サイズが、約47MB もあるので、ダウンロードの際、注意! 解凍すると、約97MB 。
http://neutro.la.coocan.jp/asm/Decimal-Basic-bbs2-180415.lzh

※Firefox で見ると 付属スレッドの左マージンが無くなっているのを、修正しました。
  Decimal-Basic-bbs2-180413.lzh → Decimal-Basic-bbs2-180415.lzh

■保存されている範囲。
 メインスレッド
  開始 No.1 新掲示板開設 投稿者:白石 和夫  投稿日:2008年 7月21日(月)09時38分46秒
      (
      )
  近況 No.4556 レイマーチング 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時14分28秒

 付属スレッド
  ◇スレッドが使えます(2)
  ◇Paract BASIC(21)
  ◇Amusement_Program(10)
  ◇改修予定のJIS非互換(3)
  ◇複数ページ長編プログラム(新規投稿)(16)
  ◇「十進BASIC第2掲示板」投稿記事リスト(17)
  ◇Full BASIC互換ライブラリ(8)
  ◇「十進BASIC掲示板過去ログ」インデックス(トピック)(17)
  ◇人の色覚の数理(14)
  ◇「十進BASIC掲示板過去ログ」インデックス(ツリー)(91)

 
 

レイマーチング

 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時14分28秒
返信・引用
  ネット上のサンプルを基にレイマーチング法で球?をレンダリングしています。
二進モードで実行してください。

PUBLIC NUMERIC EPS,OFFSET
DIM POS(3),CPOS(3),CDIR(3),CUP(3),CSIDE(3),RAY(3),R1(3),R2(3),R3(3),LIGHTDIR(3)
DIM NORMAL(3),COL(3),C(3),V(3),R(3),CC(3),CAMERA(3)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
CALL VEC3(CDIR,0,0,1)
CALL VEC3(CUP,0,1,0)
CALL VEC3(CAMERA,0,1,0)
MAT CSIDE=CROSS(CDIR,CUP)
LET EPS=.01
LET TARGETDEPTH=1.3
LET OFFSET = EPS * 100
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      MAT R1=X*CSIDE
      MAT R2=Y*CUP
      MAT R3=TARGETDEPTH*CDIR
      MAT RAY=R1
      MAT RAY=RAY+R2
      MAT RAY=RAY+R3
      MAT CPOS=CAMERA
      CALL NORMALIZE(RAY)
      LET ALPHA=1
      MAT COL=ZER
      FOR I=0 TO 2
         CALL GETRAYCOLOR(CPOS, RAY, POS, NORMAL, HIT,CC)
         MAT C=ALPHA*CC
         MAT COL=COL+C
         LET ALPHA=ALPHA*.3
         CALL REFLECT(RAY, NORMAL ,R)
         CALL NORMALIZE(R)
         MAT RAY=R
         MAT CPOS=OFFSET*NORMAL
         MAT CPOS=CPOS+POS
         IF HIT=0 THEN EXIT FOR
      NEXT I
      CALL SETCOLOR(COL(1),COL(2),COL(3))
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  SUB  ONREP(P(), INTERVAL,PP())
DIM Q(2)
LET Q(1)=MOD(P(1),INTERVAL)- INTERVAL * 0.5
LET Q(2)=MOD(P(3),INTERVAL)- INTERVAL * 0.5
CALL VEC3(PP,Q(1),P(2),Q(2))
END SUB

EXTERNAL  FUNCTION SPHEREDIST(P(),R)
DIM PP(3)
CALL ONREP(P,3,PP)
LET SPHEREDIST=LENGTH(PP)-R
END FUNCTION

EXTERNAL  FUNCTION FLOORDIST(P())
DIM V(3)
CALL VEC3(V,0,1,0)
LET FLOORDIST=DOT(P,V)+1
END FUNCTION

EXTERNAL  SUB MINVEC4(A(),B(),C())
IF A(4)<B(4) THEN MAT C=A ELSE MAT C=B
END SUB

EXTERNAL  FUNCTION CHECKEREDPATTERN(P())
LET U=1-IP(MOD(P(1),2))
LET V=1-IP(MOD(P(3),2))
IF U=1 AND V<1 OR U<1 AND V=1 THEN LET CHECKEREDPATTERN=.2 ELSE LET CHECKEREDPATTERN=1
END FUNCTION

EXTERNAL  SUB HSV2RGB(C(),RGB())
DIM K(4),P(3)
CALL VEC4(K,1.0, 2.0 / 3.0, 1.0 / 3.0, 3.0)
FOR I=1 TO 3
   LET P(I)=ABS(FRACT(C(1)+K(I))*6-K(4))
NEXT I
FOR I=1 TO 3
   LET RGB(I)=C(3)*MIX(K(1),CLAMP(P(I)-K(1),0,1),C(2))
NEXT I
END SUB

EXTERNAL  FUNCTION SCENEDIST(P())
LET SCENEDIST=MIN(SPHEREDIST(P,1),FLOORDIST(P))
END FUNCTION

EXTERNAL  SUB SCENECOLOR(P(),PP())
DIM A(4),B(4),C(3),COL(3)
CALL VEC3(C,(P(3) + P(1)) / 9.0, 1.0, 1.0 )
CALL HSV2RGB(C,COL)
CALL VEC4(A,COL(1),COL(2),COL(3), SPHEREDIST(P,1.0))
LET L=CHECKEREDPATTERN(P)
CALL VEC4(B,.5*L,.5*L,.5*L,FLOORDIST(P))
CALL MINVEC4(A,B,PP)
END SUB

EXTERNAL  SUB GETNORMAL(P(),N())
DIM X1(3),X2(3),Y1(3),Y2(3),Z1(3),Z2(3),PX1(3),PX2(3),PY1(3),PY2(3),PZ1(3),PZ2(3)
CALL VEC3(X1,EPS,0,0)
CALL VEC3(X2,-EPS,0,0)
MAT PX1=P+X1
MAT PX2=P+X2
CALL VEC3(Y1,0,EPS,0)
CALL VEC3(Y2,0,-EPS,0)
MAT PY1=P+Y1
MAT PY2=P+Y2
CALL VEC3(Z1,0,0,EPS)
CALL VEC3(Z2,0,0,-EPS)
MAT PZ1=P+Z1
MAT PZ2=P+Z2
CALL VEC3(N,SCENEDIST(PX1)-SCENEDIST(PX2),SCENEDIST(PY1)-SCENEDIST(PY2),SCENEDIST(PZ1)-SCENEDIST(PZ2))
CALL NORMALIZE(N)
END SUB

EXTERNAL  FUNCTION GETSHADOW(RO(),RD())
DIM RAY(3),DMY(3)
LET R=1
LET SHADOWCOEF=.5
FOR T=0 TO 49
   MAT RAY=C*RD
   MAT RAY=RAY+RO
   LET H=SCENEDIST(RAY)
   IF H<EPS THEN
      LET GETSHADOW=SHADOWCOEF
      EXIT FUNCTION
   END IF
   IF C<>0 THEN LET R=MIN(R,H*16/C)
   LET C=C+H
NEXT T
LET GETSHADOW=1-SHADOWCOEF+R*SHADOWCOEF
END FUNCTION

EXTERNAL  SUB GETRAYCOLOR(ORIGIN(),RAY(),POS(),NORMAL(),HIT,COL())
DIM P(3),S(3),V(3),LIGHTDIR(3),CL(4)
MAT POS=ORIGIN
CALL VEC3(LIGHTDIR,-0.48666426339228763, 0.8111071056538127, -0.3244428422615251)
FOR I=0 TO 63
   LET DIST = SCENEDIST(POS)
   LET DEPTH =DEPTH+ DIST
   MAT POS=DEPTH*RAY
   MAT POS=POS+ORIGIN
   IF ABS(DIST)<EPS  THEN EXIT FOR
NEXT I
IF ABS(DIST)<EPS THEN
   CALL GETNORMAL(POS,NORMAL)
   LET DIFFUSE = CLAMP(DOT(LIGHTDIR, NORMAL), 0.1, 1.0 )
   CALL REFLECT(LIGHTDIR, NORMAL,V)
   LET SPECULAR = CLAMP(DOT(V,RAY),0, 1)^10
   CALL VEC3(S,SPECULAR*.8,SPECULAR*.8,SPECULAR*.8)
   MAT P=OFFSET*NORMAL
   MAT P=P+POS
   LET SHADOW = GETSHADOW(P, LIGHTDIR)
   CALL SCENECOLOR(POS ,CL)
   FOR I=1 TO 3
      LET COL(I)=CL(I)
   NEXT I
   MAT COL=DIFFUSE*COL
   MAT COL=COL+S
   MAT COL=(MAX(0.5,SHADOW))*COL
   LET HIT = 1
ELSE
   MAT COL=ZER
   LET HIT=0
END IF
LET K= CLAMP(.05 * DEPTH, 0, .6)^2
FOR I=1 TO 3
   LET COL(I)=COL(I)-K
NEXT I
END SUB

EXTERNAL  SUB REFLECT(I(),N(),V())
DIM C(3),VV(3)
LET K=2*DOT(N,I)
MAT C=K*N
MAT VV=I-C
MAT V=VV
END SUB

EXTERNAL  SUB NORMALIZE(RAY())
LET S=LENGTH(RAY)
IF S<>0 THEN
   MAT RAY=(1/S)*RAY
ELSE
   MAT RAY=ZER
END IF
END SUB

EXTERNAL  SUB SETCOLOR(R,G,B)
SET COLOR COLORINDEX(CLAMP(R,0,1),CLAMP(G,0,1),CLAMP(B,0,1))
END SUB

EXTERNAL  SUB VEC2(V(),X,Y)
LET V(1)=X
LET V(2)=Y
END SUB

EXTERNAL  SUB VEC3(V(),X,Y,Z)
LET V(1)=X
LET V(2)=Y
LET V(3)=Z
END SUB

EXTERNAL  SUB VEC4(V(),X,Y,Z,W)
LET V(1)=X
LET V(2)=Y
LET V(3)=Z
LET V(4)=W
END SUB

EXTERNAL  FUNCTION LENGTH(A())
FOR I=1 TO UBOUND(A,1)
   LET S=S+A(I)^2
NEXT I
LET LENGTH=SQR(S)
END FUNCTION

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION

EXTERNAL  FUNCTION FRACT(X)
LET FRACT=FP(X)
END FUNCTION

EXTERNAL  FUNCTION MIX(X,Y,A)
LET MIX=X*(1-A)+Y*A
END FUNCTION



上記プログラムの原版はこちら(※マウスでいじれます)
https://gam0022.net/webgl/#raymarching_reflect

GLSL言語でのGPUによるレンダリングです(WebGL)

※凄すぎるので上記BASICプログラム実行前のアクセス禁止です(笑)
 

レイマーチング

 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時13分32秒
返信・引用
  ネット上のサンプルを基にレイマーチング法で鉄骨?をレンダリングしています。
二進モードで実行してください。

DIM P(2),V(2),CPOS(3),CDIR(3),CUP(3),CSIDE(3),RAY(3),R1(3),R2(3),R3(3),LIGHTDIR(3),DPOS(3)
DIM NORMAL(3),COL(3)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
CALL VEC3(CPOS,5,5,.5)
CALL VEC3(CUP,.1,.4,0)
CALL NORMALIZE(CUP)
CALL VEC3(CDIR,-1,0,0)
MAT CDIR=CROSS(CUP,CDIR)
CALL VEC3(LIGHTDIR,1,1,-2)
CALL NORMALIZE(LIGHTDIR)
MAT CSIDE=CROSS(CDIR,CUP)
LET TARGETDEPTH=1
LET EPS=.001
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      MAT R1=X*CSIDE
      MAT R2=Y*CUP
      MAT R3=TARGETDEPTH*CDIR
      MAT RAY=R1
      MAT RAY=RAY+R2
      MAT RAY=RAY+R3
      CALL NORMALIZE(RAY)
      LET DEPTH=0
      MAT DPOS=CPOS
      FOR I=0 TO 63
         LET DIST=DISTANCEFUNC(DPOS)
         LET DEPTH=DEPTH+DIST
         MAT DPOS=DEPTH*RAY
         MAT DPOS=DPOS+CPOS
         IF ABS(DIST)<EPS THEN EXIT FOR
      NEXT I
      IF ABS(DIST)<EPS THEN
         CALL GETNORMAL(DPOS,NORMAL)
         LET DIFFUSE=CLAMP(DOT(LIGHTDIR,NORMAL),.1,1)
         CALL VEC3(COL,1,.1,.1)
         MAT COL=DIFFUSE*COL
         CALL SETCOLOR(COL(1)+.05*DEPTH,COL(2)+.05*DEPTH,COL(3)+.05*DEPTH)
      ELSE
         CALL SETCOLOR(.05*DEPTH,.05*DEPTH,.05*DEPTH)
      END IF
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  SUB  ONREP(P(), INTERVAL,PP())
FOR I=1 TO UBOUND(P,1)
   LET PP(I)=MOD(P(I),INTERVAL)- INTERVAL * 0.5
NEXT I
END SUB

EXTERNAL  FUNCTION BARDIST(X,Y,INTERVAL,WIDTH)
DIM PP(2),P(2)
CALL VEC2(P,X,Y)
CALL ONREP(P, INTERVAL,PP)
CALL VABS(PP)
FOR I=1 TO 2
   LET PP(I)=PP(I)-WIDTH
NEXT I
CALL VMAX(PP,0)
LET BARDIST=LENGTH(PP)
END FUNCTION

EXTERNAL  FUNCTION TUBEDIST(X,Y, INTERVAL, WIDTH)
DIM PP(2),P(2)
CALL VEC2(P,X,Y)
CALL ONREP(P, INTERVAL,PP)
LET TUBEDIST=LENGTH(PP) - WIDTH
END FUNCTION

EXTERNAL  FUNCTION DISTANCEFUNC(P())
LET BARX=BARDIST(P(2),P(3),1,.1)
LET BARY=BARDIST(P(1),P(3),1,.1)
LET BARZ=BARDIST(P(1),P(2),1,.1)
LET TUBEX=TUBEDIST(P(2),P(3),.1,.025)
LET TUBEY=TUBEDIST(P(1),P(3),.1,.025)
LET TUBEZ=TUBEDIST(P(1),P(2),.1,.025)
LET DISTANCEFUNC=MAX(MAX(MAX(MIN(MIN(BARX, BARY),BARZ), -TUBEX), -TUBEY), -TUBEZ)
END FUNCTION

EXTERNAL  SUB GETNORMAL(P(),N())
DIM X1(3),X2(3),Y1(3),Y2(3),Z1(3),Z2(3),PX1(3),PX2(3),PY1(3),PY2(3),PZ1(3),PZ2(3)
LET D=.001
CALL VEC3(X1,D,0,0)
CALL VEC3(X2,-D,0,0)
MAT PX1=P+X1
MAT PX2=P+X2
CALL VEC3(Y1,0,D,0)
CALL VEC3(Y2,0,-D,0)
MAT PY1=P+Y1
MAT PY2=P+Y2
CALL VEC3(Z1,0,0,D)
CALL VEC3(Z2,0,0,-D)
MAT PZ1=P+Z1
MAT PZ2=P+Z2
CALL VEC3(N,DISTANCEFUNC(PX1)-DISTANCEFUNC(PX2),DISTANCEFUNC(PY1)-DISTANCEFUNC(PY2),DISTANCEFUNC(PZ1)-DISTANCEFUNC(PZ2))
CALL NORMALIZE(N)
END SUB

EXTERNAL  SUB NORMALIZE(RAY())
LET S=LENGTH(RAY)
IF S<>0 THEN
   MAT RAY=(1/S)*RAY
ELSE
   MAT RAY=ZER
END IF
END SUB

EXTERNAL  SUB SETCOLOR(R,G,B)
SET COLOR COLORINDEX(CLAMP(R,0,1),CLAMP(G,0,1),CLAMP(B,0,1))
END SUB

EXTERNAL  SUB VEC2(V(),X,Y)
LET V(1)=X
LET V(2)=Y
END SUB

EXTERNAL  SUB VEC3(V(),X,Y,Z)
LET V(1)=X
LET V(2)=Y
LET V(3)=Z
END SUB

EXTERNAL  FUNCTION LENGTH(A())
FOR I=1 TO UBOUND(A,1)
   LET S=S+A(I)^2
NEXT I
LET LENGTH=SQR(S)
END FUNCTION

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION

EXTERNAL  SUB VABS(A())
FOR I=1 TO UBOUND(A,1)
   LET A(I)=ABS(A(I))
NEXT I
END SUB

EXTERNAL  SUB VMAX(A(),N)
FOR I=1 TO UBOUND(A,1)
   LET A(I)=MAX(A(I),N)
NEXT I
END SUB


このプログラムの原版はこちら(※マウスでいじれます)
https://gam0022.net/webgl/#raymarching_steel-frame

GLSL言語でのGPUによるレンダリングです(WebGL)

※凄すぎるので上記BASICプログラム実行前のアクセス禁止です(笑)
 

レイマーチング

 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時12分42秒
返信・引用
  ネット上のサンプルを基にレイマーチング法によりトーラス(ドーナツ型)をレンダリングしています。
二進モードで実行してください。

DIM CPOS(3),CDIR(3),CUP(3),CSIDE(3),RAY(3),R1(3),R2(3),R3(3),LIGHTDIR(3),RPOS(3),HALF(3)
DIM NORMAL(3),DPOS(3),COL(3)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
CALL VEC3(CPOS,0,5,5)         !'カメラ
CALL VEC3(CDIR,0,-.707,-.707) !'カメラの向き(視線)
CALL VEC3(CUP,0,.707,-.707)   !'カメラの上方向
CALL VEC3(LIGHTDIR,-.577,.577,.577)
MAT CSIDE=CROSS(CDIR,CUP)     !'横方向
LET TARGETDEPTH=1             !'フォーカス深度
CALL NORMALIZE(LIGHTDIR)
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      MAT R1=X*CSIDE
      MAT R2=Y*CUP
      MAT R3=TARGETDEPTH*CDIR
      MAT RAY=R1
      MAT RAY=RAY+R2
      MAT RAY=RAY+R3
      CALL NORMALIZE(RAY) !'レイの定義
      LET DIST=0
      LET RLEN=0
      MAT RPOS=CPOS
      LET SHADOW=1
      FOR I=0 TO 255 !'マーチングループ(marching loop)
         CALL DISTANCE(RPOS,DIST,COL)
         LET RLEN=RLEN+DIST
         MAT RPOS=RLEN*RAY
         MAT RPOS=RPOS+CPOS
         IF DIST<.001 THEN EXIT FOR
      NEXT I
      IF ABS(DIST)<.001 THEN !'レイとの距離
         CALL GETNORMAL(RPOS,NORMAL)
         MAT HALF=LIGHTDIR-RAY
         CALL NORMALIZE(HALF)
         LET DIFF=CLAMP(DOT(LIGHTDIR,NORMAL),.1,1)
         LET SPEC=CLAMP(DOT(HALF,NORMAL),0,1)^50
         MAT DPOS=(1/1000)*NORMAL
         MAT DPOS=DPOS+RPOS
         LET SHADOW=GENSHADOW(DPOS,LIGHTDIR) !'シャドウ
         FOR I=1 TO 3
            LET COL(I)=COL(I)*DIFF+SPEC
         NEXT I
      ELSE
         CALL VEC3(COL,0,0,0)
      END IF
      FOR I=1 TO 3
         LET COL(I)=COL(I)*MAX(.5,SHADOW)
      NEXT I
      CALL SETCOLOR(COL(1),COL(2),COL(3))
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  FUNCTION TORUS(P()) !'距離関数(トーラス)
DIM T(3),R(3)
CALL VEC2(T,3,1)
CALL VEC2(R,LENGTH2(P(1),P(3),0)-T(1),P(2))
LET TORUS=LENGTH(R)-T(2)
END FUNCTION

EXTERNAL  FUNCTION FLOOR(P()) !'距離関数(床)
DIM V(3)
CALL VEC3(V,0,1,0)
LET FLOOR=DOT(P,V)+1
END FUNCTION

EXTERNAL  SUB DISTANCE(P(),DIST,COL())
LET D1=TORUS(P)
LET D2=FLOOR(P)
IF D1<D2 THEN
   LET DIST=D1
   CALL VEC3(COL,1,1,.25) !'色
ELSE
   LET DIST=D2
   LET U=1-IP(MOD(P(1),2))
   LET V=1-IP(MOD(P(3),2))
   IF U+V=1 THEN CALL VEC3(COL,.7,.7,.7) ELSE CALL VEC3(COL,1,1,1) !'色(市松模様)
END IF
END SUB

EXTERNAL  SUB NMAX(A(),B(),N)
FOR I=1 TO 3
   LET A(I)=MAX(B(I),N)
NEXT I
END SUB

EXTERNAL  SUB GETNORMAL(P(),N()) !'法線ベクトル
DIM X1(3),X2(3),Y1(3),Y2(3),Z1(3),Z2(3),PX1(3),PX2(3),PY1(3),PY2(3),PZ1(3),PZ2(3),DMY(3)
LET D=.0001
CALL VEC3(X1,D,0,0)
CALL VEC3(X2,-D,0,0)
MAT PX1=P+X1
MAT PX2=P+X2
CALL VEC3(Y1,0,D,0)
CALL VEC3(Y2,0,-D,0)
MAT PY1=P+Y1
MAT PY2=P+Y2
CALL VEC3(Z1,0,0,D)
CALL VEC3(Z2,0,0,-D)
MAT PZ1=P+Z1
MAT PZ2=P+Z2
CALL DISTANCE(PX1,XS,DMY)
CALL DISTANCE(PX2,XE,DMY)
CALL DISTANCE(PY1,YS,DMY)
CALL DISTANCE(PY2,YE,DMY)
CALL DISTANCE(PZ1,ZS,DMY)
CALL DISTANCE(PZ2,ZE,DMY)
CALL VEC3(N,XS-XE,YS-YE,ZS-ZE)
CALL NORMALIZE(N)
END SUB

EXTERNAL  SUB NORMALIZE(RAY()) !'正規化
LET S=LENGTH(RAY)
IF S<>0 THEN
   MAT RAY=(1/S)*RAY
ELSE
   MAT RAY=ZER
END IF
END SUB

EXTERNAL  SUB VABS(A(),B())
FOR I=1 TO 3
   LET A(I)=ABS(B(I))
NEXT I
END SUB

EXTERNAL  SUB SETCOLOR(R,G,B)
SET COLOR COLORINDEX(CLAMP(R,0,1),CLAMP(G,0,1),CLAMP(B,0,1))
END SUB

EXTERNAL  SUB VEC3(V(),X,Y,Z)
LET V(1)=X
LET V(2)=Y
LET V(3)=Z
END SUB

EXTERNAL  SUB VEC2(A(),X,Y)
LET A(1)=X
LET A(2)=Y
END SUB

EXTERNAL  FUNCTION LENGTH(A()) !'長さ
LET LENGTH=SQR(A(1)^2+A(2)^2+A(3)^2)
END FUNCTION

EXTERNAL  FUNCTION LENGTH2(X,Y,Z)
LET LENGTH2=SQR(X^2+Y^2+Z^2)
END FUNCTION

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION

EXTERNAL  FUNCTION GENSHADOW(RO(),RD()) !'シャドウ
DIM RAY(3),DMY(3)
LET R=1
LET C=.001
LET SHADOWCOEF=.5
FOR T=0 TO 49
   MAT RAY=C*RD
   MAT RAY=RAY+RO
   CALL DISTANCE(RAY,H,DMY)
   IF H<.001 THEN
      LET GENSHADOW=SHADOWCOEF
      EXIT FUNCTION
   END IF
   LET R=MIN(R,H*32/C)
   LET C=C+H
NEXT T
LET GENSHADOW=1-SHADOWCOEF+R*SHADOWCOEF
END FUNCTION
 

レイマーチング

 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時11分57秒
返信・引用
  ネット上のサンプルを基にしてレイマーチング法(ray marching)で箱(box)をレンダリングしています。
レイ・マーチング法はレイ・トレーシング法(ray tracing)の一種です。

※厳密にはレイマーチング法の中のスフィアトレーシング法(sphere tracing)です。
二進モードで実行してください。

DIM P(2),V(2),CPOS(3),CDIR(3),CUP(3),CSIDE(3),RAY(3),R1(3),R2(3),R3(3),LIGHTDIR(3),RPOS(3)
DIM NORMAL(3)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
CALL VEC3(CPOS,0,0,2)
CALL VEC3(LIGHTDIR,-.577,.577,.577)
LET ANG=60            !'視野角
LET FOV=ANG*.5*PI/180
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      CALL VEC3(RAY,SIN(FOV)*X,SIN(FOV)*Y,-COS(FOV))
      CALL NORMALIZE(RAY)
      LET DISTANCE=0
      LET RLEN=0
      MAT RPOS=CPOS
      FOR I=0 TO 127
         LET DISTANCE=DISTANCEFUNC(RPOS)
         LET RLEN=RLEN+DISTANCE
         MAT RPOS=RLEN*RAY
         MAT RPOS=RPOS+CPOS
         IF ABS(DISTANCE)<.001 THEN EXIT FOR
      NEXT I
      IF ABS(DISTANCE)<.001 THEN
         CALL GETNORMAL(RPOS,NORMAL)
         LET DIFF=CLAMP(DOT(LIGHTDIR,NORMAL),.1,1)
         CALL SETCOLOR(DIFF,DIFF,DIFF)
      ELSE
         CALL SETCOLOR(0,0,0)
      END IF
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  SUB TRANS(P())
FOR I=1 TO 3
   LET P(I)=MOD(P(I),4)-2
NEXT I
END SUB

EXTERNAL  FUNCTION DISTANCEFUNC(PP())
DIM V(3),A(3),B(3),P(3)
CALL VEC3(B,.5,.5,.5)
MAT P=PP
CALL TRANS(P)
CALL VABS(V,P)
MAT V=V-B
CALL NMAX(A,V,0)
LET DISTANCEFUNC=LENGTH(A)-.5
END FUNCTION

EXTERNAL  SUB GETNORMAL(P(),N())
DIM X1(3),X2(3),Y1(3),Y2(3),Z1(3),Z2(3),PX1(3),PX2(3),PY1(3),PY2(3),PZ1(3),PZ2(3)
LET D=.0001
CALL VEC3(X1,D,0,0)
CALL VEC3(X2,-D,0,0)
MAT PX1=P+X1
MAT PX2=P+X2
CALL VEC3(Y1,0,D,0)
CALL VEC3(Y2,0,-D,0)
MAT PY1=P+Y1
MAT PY2=P+Y2
CALL VEC3(Z1,0,0,D)
CALL VEC3(Z2,0,0,-D)
MAT PZ1=P+Z1
MAT PZ2=P+Z2
CALL VEC3(N,DISTANCEFUNC(PX1)-DISTANCEFUNC(PX2),DISTANCEFUNC(PY1)-DISTANCEFUNC(PY2),DISTANCEFUNC(PZ1)-DISTANCEFUNC(PZ2))
CALL NORMALIZE(N)
END SUB

EXTERNAL  SUB NORMALIZE(RAY())
LET S=LENGTH(RAY)
IF S<>0 THEN
   MAT RAY=(1/S)*RAY
ELSE
   MAT RAY=ZER
END IF
END SUB

EXTERNAL  SUB SETCOLOR(R,G,B)
SET COLOR COLORINDEX(CLAMP(R,0,1),CLAMP(G,0,1),CLAMP(B,0,1))
END SUB

EXTERNAL  SUB VEC3(V(),X,Y,Z)
LET V(1)=X
LET V(2)=Y
LET V(3)=Z
END SUB

EXTERNAL  FUNCTION LENGTH(A())
LET LENGTH=SQR(A(1)^2+A(2)^2+A(3)^2)
END FUNCTION

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION

EXTERNAL  SUB VABS(A(),B())
FOR I=1 TO 3
   LET A(I)=ABS(B(I))
NEXT I
END SUB

EXTERNAL  SUB NMAX(A(),B(),N)
FOR I=1 TO 3
   LET A(I)=MAX(B(I),N)
NEXT I
END SUB
 

フラグメントシェーダー

 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時11分8秒
返信・引用
  フラグメントシェーダーによるプログラムです。
ネット上のサンプルを基にアンパンマン?を描画しています。

https://qiita.com/doxas/items/a366eafc498c8269934c

PUBLIC NUMERIC LIGHTCOLOR(3),BACKCOLOR(3),FACECOLOR(3),NOSECOLOR(3),CHEEKCOLOR(3),EYESCOLOR(3),HIGHLIGHT(3),LINECOLOR(3),T
DIM P(2),M(2,2),V(2),W(2),Q(2),QQ(2),DESTCOLOR(3)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
CALL VEC3(LIGHTCOLOR,0.95, 0.95, 0.5)!'  // 背景の後光の色
CALL VEC3(BACKCOLOR,0.95, 0.25, 0.25)!'  // 背景の下地の色
CALL VEC3(FACECOLOR,0.95, 0.75, 0.5)!'   // 顔の色
CALL VEC3(NOSECOLOR,0.95, 0.25, 0.25)!'  // 鼻の色
CALL VEC3(CHEEKCOLOR,1.0, 0.55, 0.25)!'  // 頬の色
CALL VEC3(EYESCOLOR,0.15, 0.05, 0.05)!'  // 目の色
CALL VEC3(HIGHLIGHT,0.95, 0.95, 0.95)!'  // ハイライトの色
CALL VEC3(LINECOLOR,0.3, 0.2, 0.2)!'     // ラインの色
LET T=INT(TIME)
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      CALL VEC2(P,X,Y)
      CALL SUNRISE(P,DESTCOLOR)
      LET S=SIN(SIN(T*2)*.75)
      LET C=COS(SIN(T*2))
      CALL MAT2(M,C,-S,S,C)
      MAT Q=P*M
      !    circle(q, vec2(0.0), 0.5, faceColor, destColor);
      CALL VEC2(V,0,0)
      CALL CIRCLE(Q,V,.5,FACECOLOR,DESTCOLOR)
      !    circle(q, vec2(0.0, -0.05), 0.15, noseColor, destColor);
      CALL VEC2(V,0,-.05)
      CALL CIRCLE(Q,V,.15,NOSECOLOR,DESTCOLOR)
      !    circle(q, vec2(0.325, -0.05), 0.15, cheekColor, destColor);
      CALL VEC2(V,.325,-.05)
      CALL CIRCLE(Q,V,.15,CHEEKCOLOR,DESTCOLOR)
      !    circle(q, vec2(-0.325, -0.05), 0.15, cheekColor, destColor);
      CALL VEC2(V,-.325,-.05)
      CALL CIRCLE(Q,V,.15,CHEEKCOLOR,DESTCOLOR)
      !    ellipse(q, vec2(0.15, 0.135), vec2(0.75, 1.0), 0.075, eyesColor, destColor);
      CALL VEC2(V,.15,.135)
      CALL VEC2(W,.75,1)
      CALL ELLIPSE(Q,V,W,.075,EYESCOLOR,DESTCOLOR)
      !    ellipse(q, vec2(-0.15, 0.135), vec2(0.75, 1.0), 0.075, eyesColor, destColor);
      CALL VEC2(V,-.15,.135)
      CALL ELLIPSE(Q,V,W,.075,EYESCOLOR,DESTCOLOR)
      !    circleLine(q, vec2(0.0), 0.5, 0.525, lineColor, destColor);
      CALL VEC2(V,0,0)
      CALL CIRCLELINE(Q,V,.5,.525,LINECOLOR,DESTCOLOR)
      !    circleLine(q, vec2(0.0, -0.05), 0.15, 0.17, lineColor, destColor);
      CALL VEC2(V,0,-.05)
      CALL CIRCLELINE(Q,V,.15,.17,LINECOLOR,DESTCOLOR)
      !    arcLine(q, vec2(0.325, -0.05), 0.15, 0.17, PI * 1.5, 0.0, lineColor, destColor);
      CALL VEC2(V,.325,-.05)
      CALL ARCLINE(Q,V,.15,.17,PI*.5,0,LINECOLOR,DESTCOLOR)
      !    arcLine(q, vec2(-0.325, -0.05), 0.15, 0.17, PI * 0.5, 0.0, lineColor, destColor);
      CALL VEC2(V,-.325,-.05)
      CALL ARCLINE(Q,V,.15,.17,PI*1.5,0,LINECOLOR,DESTCOLOR)
      !    arcLine(q * vec2(1.2, 1.0), vec2(0.19, 0.2), 0.125, 0.145, 0.0, 0.02, lineColor, destColor);
      CALL VEC2(V,1.2,1)
      CALL VEC2(W,.19,.2)
      FOR I=1 TO 2
         LET QQ(I)=Q(I)*V(I)
      NEXT I
      CALL ARCLINE(QQ,W,.125,.145,0,.02,LINECOLOR,DESTCOLOR)
      !    arcLine(q * vec2(1.2, 1.0), vec2(-0.19, 0.2), 0.125, 0.145, 0.0, 0.02, lineColor, destColor);
      CALL VEC2(V,1.2,1)
      CALL VEC2(W,-.19,.2)
      FOR I=1 TO 2
         LET QQ(I)=Q(I)*V(I)
      NEXT I
      CALL ARCLINE(QQ,W,.125,.145,0,.02,LINECOLOR,DESTCOLOR)
      !    arcLine(q * vec2(0.9, 1.0), vec2(0.0, -0.15), 0.2, 0.22, PI, 0.055, lineColor, destColor);
      CALL VEC2(V,.9,1)
      CALL VEC2(W,0,-.15)
      FOR I=1 TO 2
         LET QQ(I)=Q(I)*V(I)
      NEXT I
      CALL ARCLINE(QQ,W,0.2, 0.22, PI, 0.055,LINECOLOR,DESTCOLOR)
      !    rect(q, vec2(-0.025, 0.0), 0.035, highlight, destColor);
      CALL VEC2(V,-.025,0)
      CALL RECT(Q,V,.035,HIGHLIGHT,DESTCOLOR)
      !    rect(q, vec2(-0.35, 0.0), 0.035, highlight, destColor);
      CALL VEC2(V,-.35,0)
      CALL RECT(Q,V,.035,HIGHLIGHT,DESTCOLOR)
      !    rect(q, vec2(0.3, 0.0), 0.035, highlight, destColor);
      CALL VEC2(V,.3,0)
      CALL RECT(Q,V,.035,HIGHLIGHT,DESTCOLOR)
      CALL SETCOLOR(DESTCOLOR)
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  SUB CIRCLE(P(),OFFSET(),SIZE,COL(),I())
DIM PP(2)
MAT PP=P-OFFSET
LET L=LENGTH(PP)
IF L<SIZE THEN MAT I=COL
END SUB

EXTERNAL  SUB ELLIPSE(P(),OFFSET(),PROP(),SIZE,COL(),I())
DIM PP(2),Q(2)
MAT PP=P-OFFSET
FOR J=1 TO 2
   LET Q(J)=PP(J)/PROP(J)
NEXT J
IF LENGTH(Q)<SIZE THEN MAT I=COL
END SUB

EXTERNAL  SUB CIRCLELINE(P(),OFFSET(),ISIZE,OSIZE,COL(),I())
DIM Q(2)
MAT Q=P-OFFSET
LET L=LENGTH(Q)
IF L>ISIZE AND L<OSIZE THEN MAT I=COL
END SUB

EXTERNAL  SUB ARCLINE(P(),OFFSET(),ISIZE,OSIZE,RAD,HEIGHT,COL(),I())
DIM ROT(2,2),Q(2)
LET S=SIN(RAD)
LET C=COS(RAD)
CALL MAT2(ROT,C,-S,S,C)
MAT Q=P-OFFSET
MAT Q=Q*ROT
LET L=LENGTH(Q)
IF L>ISIZE AND L<OSIZE AND Q(2)>HEIGHT THEN MAT I=COL
END SUB

EXTERNAL  SUB RECT(P(),OFFSET(),SIZE,COL(),I())
DIM Q(2)
MAT Q=P-OFFSET
MAT Q=(1/SIZE)*Q
IF ABS(Q(1))<1 AND ABS(Q(2))<1 THEN MAT I=COL
END SUB

EXTERNAL  SUB SUNRISE(P(),I())
LET F=ATAN(P(1),P(2))+T
LET FS=SIN(F*10)
FOR J=1 TO 2
   LET I(J)=MIX(LIGHTCOLOR(J),BACKCOLOR(J),FS)
NEXT J
END SUB

EXTERNAL  SUB SETCOLOR(A())
SET COLOR COLORINDEX(CLAMP(A(1),0,1),CLAMP(A(2),0,1),CLAMP(A(3),0,1))
END SUB

EXTERNAL  SUB VEC2(A(),X,Y)
LET A(1)=X
LET A(2)=Y
END SUB

EXTERNAL  SUB VEC3(A(),X,Y,Z)
LET A(1)=X
LET A(2)=Y
LET A(3)=Z
END SUB

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION

EXTERNAL  FUNCTION LENGTH(A())
LET LENGTH=SQR(A(1)^2+A(2)^2)
END FUNCTION

EXTERNAL  FUNCTION MIX(X,Y,A)
LET MIX=X*(1-A)+Y*A
END FUNCTION

EXTERNAL  SUB MAT2(X(,),A,B,C,D)
LET X(1,1)=A
LET X(1,2)=B
LET X(2,1)=C
LET X(2,2)=D
END SUB

EXTERNAL FUNCTION ATAN(X,Y)
IF ABS(X)>1E-4 THEN
   LET TH=ATN(Y/X)
   IF Y<>0 THEN
      IF X>0 AND Y<0 THEN LET TH=TH+PI*2
      IF X<0 THEN LET TH=TH+PI
   ELSE !' Y=0
      IF X<0 THEN LET TH=PI ELSE LET TH=0
   END IF
ELSE !' X=0
   LET TH=PI/2
   IF Y<0 THEN LET TH=TH+PI
END IF
LET ATAN=TH
END FUNCTION
 

フラグメントシェーダー

 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時10分27秒
返信・引用
  フラグメントシェーダーによるプログラムです。
ネット上のサンプルを基にきらきら? を描画しています。

https://qiita.com/doxas/items/5d6e39c54e16f352488c

DIM Q(2),M(2,2)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
LET T=INT(TIME)
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      LET Q(1)=MOD(X,.2)-.1
      LET Q(2)=MOD(Y,.2)-.1
      LET S=SIN(T)
      LET C=COS(T)
      CALL MAT2(M,C,S,-S,C)
      MAT Q=Q*M
      IF Q(1)*Q(2)=0 THEN
         LET V=1
      ELSE
         LET V=.1/ABS(Q(2))*ABS(Q(1))
      END IF
      LET R=V*ABS(SIN(T*6)+1.5)
      LET G=V*ABS(SIN(T*4.5)+1.5)
      LET B=V*ABS(SIN(T*3)+1.5)
      CALL SETCOLOR(R,G,B)
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  SUB SETCOLOR(R,G,B)
SET COLOR COLORINDEX(CLAMP(R,0,1),CLAMP(G,0,1),CLAMP(B,0,1))
END SUB

EXTERNAL  SUB MAT2(X(,),A,B,C,D)
LET X(1,1)=A
LET X(1,2)=B
LET X(2,1)=C
LET X(2,2)=D
END SUB

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION
 

フラグメントシェーダー

 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時09分55秒
返信・引用
  フラグメントシェーダーによるプログラムです。
このプログラムでは円を10個描いて花模様?を描いています。

https://qiita.com/doxas/items/25bb50a3db85129e2980

DIM P(2),COL(3),PP(2),Q(2),D(2)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
LET T=INT(TIME)
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      CALL VEC2(P,X,Y)
      CALL VEC3(COL,1,.3,.7)
      LET F=0
      FOR I=0 TO 9
         LET S=SIN(T+I*PI/5)*.5
         LET C=COS(T+I*PI/5)*.5
         CALL VEC2(PP,C,S)
         MAT D=P+PP
         LET LL=ABS(LENGTH(D)-.5)
         IF LL<>0 THEN LET F=F+.0025/LL ELSE F=F+1
      NEXT I
      MAT COL=F*COL
      CALL SETCOLOR(COL)
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  SUB SETCOLOR(A())
SET COLOR COLORINDEX(CLAMP(A(1),0,1),CLAMP(A(2),0,1),CLAMP(A(3),0,1))
END SUB

EXTERNAL  SUB VEC2(A(),X,Y)
LET A(1)=X
LET A(2)=Y
END SUB

EXTERNAL  SUB VEC3(A(),X,Y,Z)
LET A(1)=X
LET A(2)=Y
LET A(3)=Z
END SUB

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION

EXTERNAL  FUNCTION LENGTH(A())
LET LENGTH=SQR(A(1)^2+A(2)^2)
END FUNCTION
 

フラグメントシェーダー

 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時09分10秒
返信・引用
  フラグメントシェーダーによるプログラムです。
このプログラムでは十字架?を描画します。

https://qiita.com/doxas/items/25bb50a3db85129e2980

DIM P(2),COL(3),PP(2),Q(2),D(2)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      IF X*Y=0 THEN
         LET F=1
      ELSE
         LET F=.001/ABS(X*Y)
      END IF
      CALL SETCOLOR(F,F,F)
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  SUB SETCOLOR(R,G,B)
SET COLOR COLORINDEX(CLAMP(R,0,1),CLAMP(G,0,1),CLAMP(B,0,1))
END SUB

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION
 

フラグメントシェーダー

 投稿者:しばっち  投稿日:2018年 4月 9日(月)20時08分37秒
返信・引用
  フラグメントシェーダー(Fragment Shader)では、PLOT LINES文やDRAW CIRCLE文、PLOT AREA文といった描画コマンドは
使用せず、各ピクセル毎に色を定義しながら描画していきます。
その為、描画コマンドは色を決めるSET COLOR命令と点を打つPLOT POINTS文しか使用しません。

ネット上のサンプルを基にGLSL言語(シェーディング言語)を十進BASICに移植してみました。
このプログラムでは光の玉を定義し、描画します。

https://qiita.com/doxas/items/f3f8bf868f12851ea143

DIM P(2)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE) !'範囲を-1~1に正規化(描画領域が正方形の時)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      CALL VEC2(P,X,Y)
      LET L=LENGTH(P)
      IF L<>0 THEN LET C=.1/L ELSE LET C=1
      CALL SETCOLOR(C,C,C)
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  SUB SETCOLOR(R,G,B)
SET COLOR COLORINDEX(CLAMP(R,0,1),CLAMP(G,0,1),CLAMP(B,0,1))
END SUB

EXTERNAL  SUB VEC2(A(),X,Y)
LET A(1)=X
LET A(2)=Y
END SUB

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION

EXTERNAL  FUNCTION LENGTH(A())
LET LENGTH=SQR(A(1)^2+A(2)^2)
END FUNCTION
----------------------------------------------------------------------------------------------------------------
このプログラムでも光の玉(オーブ)を描画しています。
https://qiita.com/doxas/items/00567758621bb506e584

DIM P(2),COL(3),PP(2),Q(2)
ASK BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW -XSIZE/MIN(XSIZE,YSIZE),XSIZE/MIN(XSIZE,YSIZE),-YSIZE/MIN(XSIZE,YSIZE),YSIZE/MIN(XSIZE,YSIZE)
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      MAT COL=ZER
      LET X=(XX*2-XSIZE)/MIN(XSIZE,YSIZE)
      LET Y=(YY*2-YSIZE)/MIN(XSIZE,YSIZE)
      CALL VEC2(P,X,Y)
      FOR I=0 TO 5
         LET J=I+1
         CALL VEC2(PP,COS(J)*.5,SIN(J)*.5)
         MAT Q=P+PP
         LET L=LENGTH(Q)
         FOR K=1 TO 3
            IF L<>0 THEN LET COL(K)=COL(K)+.05/L ELSE LET COL(K)=1
         NEXT K
      NEXT I
      CALL SETCOLOR(COL)
      PLOT POINTS:X,Y
   NEXT XX
NEXT YY
END

EXTERNAL  SUB SETCOLOR(A())
SET COLOR COLORINDEX(CLAMP(A(1),0,1),CLAMP(A(2),0,1),CLAMP(A(3),0,1))
END SUB

EXTERNAL  SUB VEC2(A(),X,Y)
LET A(1)=X
LET A(2)=Y
END SUB

EXTERNAL  FUNCTION CLAMP(X,A,B)
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION

EXTERNAL  FUNCTION LENGTH(A())
LET LENGTH=SQR(A(1)^2+A(2)^2)
END FUNCTION
 

動作報告です。

 投稿者:たろさ  投稿日:2018年 4月 8日(日)08時58分21秒
返信・引用
  ■ パソコン環境
 ウィンドウズ : Microsoft Windows 10 Pro
 サービスパック : なし
 システムの種類 : 64 ビット
 プロセッサー : Intel(R) Core(TM) i5 CPU       M 560  @ 2.67GHz
 周波数 : 2.67 GHz
 メモリー : 3.73 GB

■ パソコンメーカー
 メーカー : TOSHIBA
 機種名 : dynabook RX3 TN266E/3HD

■ その他
 ハードディスクドライブ 空き容量
  C:ドライブ : 16.1 GB (合計 : 106.3 GB)

 CD/DVD ドライブ
  D:ドライブ : MATSHITA DVD-RAM UJ892ES

 言語設定
  システム言語 : 日本語 (日本)
  ユーザー設定言語 : 日本語 (日本)

 インターネット環境
  Internet Explorer : 11
  ネットワーク接続 : 可能


BASIC783setup.exe (1,577,609 bytes)をインストールさせて頂きました。


行列式、逆行列、連立方程式  投稿者:しばっち  投稿日:2014年11月26日(水)18時10分49秒
http://6317.teacup.com/basic/bbs/3557

掲示板からコピーして実行ボタン ポチットしました。

https://blogs.yahoo.co.jp/donald_stinger

 

紹介求む

 投稿者:kikiriri  投稿日:2018年 4月 6日(金)16時05分35秒
返信・引用
  僕に、どちら様か、このページをご覧の方、線形代数と、basic での処理方法を、
ご伝授お願いできませんでしょうか???
また参考書等ご紹介お願いできませんか。すみませんが・・・
白石先生にもよろしくお願いします。
ご助言いただければ嬉しいです。
 

MAC, Linux版 十進BASIC ver.8.0

 投稿者:SHIRAISHI Kazuo  投稿日:2018年 4月 2日(月)18時01分12秒
返信・引用 編集済
  マルチコアプロセッサが普通になってきたので,
計算と描画を別スレッドに分離することで高速化を図りました。
十進BASICのホームページからダウンロードしてください。
Mac OS 10.13で動作することを確認しています。

http://hp.vector.co.jp/authors/VA008683/

 

Re: 2進モードで整数が実数表示されるバグ報告

 投稿者:nagram  投稿日:2018年 4月 1日(日)18時53分17秒
返信・引用
  > No.4543[元記事へ]

SHIRAISHI Kazuoさんへのお返事です。

> 修正版を作成しました。
> 完全な解決にはなっていない可能性があります。
> 不具合が残るようであれば報告をお願いします。

早々に対応していただき、ありがとうございます。
11~16桁の整数を各桁3億個ずつ抽出し調査しましたが、エラーは発見されませんでした。

OPTION ARITHMETIC NATIVE  ! [表示桁数を多く]にチェックを入れる
LET z$="."&REPEAT$("0",19)
LET s$=REPEAT$("#",16)&"."&REPEAT$("#",19)
DIM ex(11 TO 16)
FOR i=11 TO 16
   LET ex(i)=10^i
NEXT i
RANDOMIZE
PRINT TIME$
LET t=TIME
FOR k=1 TO 3E8
   FOR d=11 TO 16
      LET a=INT(RND*ex(d))
      LET a$=USING$(s$,a)
      IF a$(17:36)<>z$ THEN
         PRINT a$
         PRINT a
      END IF
   NEXT d
NEXT k
PRINT TIME-t;"sec"  ! 約5時間55分
END
 

Re: 2進モードで整数が実数表示されるバグ報告

 投稿者:SHIRAISHI Kazuo  投稿日:2018年 3月31日(土)17時10分22秒
返信・引用
  > No.4542[元記事へ]

修正版を作成しました。
完全な解決にはなっていない可能性があります。
不具合が残るようであれば報告をお願いします。

>
>
> > 2進モードで書式指定を利用して整数を表示すると、一部の整数が実数で表示されます。
> > 十進BASICのバージョンは7.8.2
> >
> >
> > 調査しましたが、誤表示される最小の整数はおそらく16000000001(=1.6E10+1)です。
> >
> > OPTION ARITHMETIC NATIVE
> > FOR a=1.6E10 TO 1.6E10+10
> >    PRINT USING " ###########.###########" : a
> > NEXT a
> > END
> >
> >
> > 上記の方法で誤表示される整数の一部は、書式指定を利用しなくとも[オプション][数値][表示桁数を多く]にチェックを入れると、やはり実数で表示されます。
> > これで誤表示される最小の整数はおそらく64000000001(=6.4E10+1)です。
> >
> > OPTION ARITHMETIC NATIVE   ! [表示桁数を多く]にチェックを入れる
> > FOR a=6.4E10 TO 6.4E10+20
> >    PRINT USING " ###########.###########" : a
> >    PRINT a
> > NEXT a
> > END
> >
> >
> > 誤表示される数値の出現には規則性があり、1.6E10を元にして倍々するごとに出現パターンが変化します。
> > 1.6E10を2の累乗倍し、それより小さな値を50個、大きな値を100個出力させました。
> >
> > OPTION ARITHMETIC NATIVE   ! [表示桁数を多く]にチェックを入れる
> > LET a0=1.6E10
> > FOR i=0 TO 5   ! 1.6E10, 3.2E10, 6.4E10, 1.28E11, 2.56E11, 5.12E11
> >    LET a1=2^i*a0
> >    LET d=CEIL(LOG10(a1))
> >    LET u$=USING$("#.##^^^^",a1)
> >    PRINT u$;"(=2^";STR$(i);"*1.6E10)  整数部";STR$(d);"桁"
> >    FOR a=a1-50 TO a1+100
> >       LET a$=USING$(REPEAT$("#",d)&".###########",a)
> >       LET f=VAL(a$(d+1:d+12))  ! 小数部分 VAL(".###########")
> >       IF f=0 THEN
> >          PRINT a               ! 問題なし
> >       ELSE
> >          IF POS(STR$(a),".")=0 THEN
> >             PRINT " ";a$       ! 書式指定による誤表示
> >          ELSE
> >             PRINT " ";a$ ; a   ! 書式指定と[表示桁数を多く]による誤表示
> >          END IF
> >       END IF
> >    NEXT a
> >    PRINT
> > NEXT i
> > END
 

Re: 2進モードで整数が実数表示されるバグ報告

 投稿者:白石和夫  投稿日:2018年 3月30日(金)18時17分5秒
返信・引用
  > No.4541[元記事へ]

ご報告ありがとうございました。
至急,調べてみます。


> 2進モードで書式指定を利用して整数を表示すると、一部の整数が実数で表示されます。
> 十進BASICのバージョンは7.8.2
>
>
> 調査しましたが、誤表示される最小の整数はおそらく16000000001(=1.6E10+1)です。
>
> OPTION ARITHMETIC NATIVE
> FOR a=1.6E10 TO 1.6E10+10
>    PRINT USING " ###########.###########" : a
> NEXT a
> END
>
>
> 上記の方法で誤表示される整数の一部は、書式指定を利用しなくとも[オプション][数値][表示桁数を多く]にチェックを入れると、やはり実数で表示されます。
> これで誤表示される最小の整数はおそらく64000000001(=6.4E10+1)です。
>
> OPTION ARITHMETIC NATIVE   ! [表示桁数を多く]にチェックを入れる
> FOR a=6.4E10 TO 6.4E10+20
>    PRINT USING " ###########.###########" : a
>    PRINT a
> NEXT a
> END
>
>
> 誤表示される数値の出現には規則性があり、1.6E10を元にして倍々するごとに出現パターンが変化します。
> 1.6E10を2の累乗倍し、それより小さな値を50個、大きな値を100個出力させました。
>
> OPTION ARITHMETIC NATIVE   ! [表示桁数を多く]にチェックを入れる
> LET a0=1.6E10
> FOR i=0 TO 5   ! 1.6E10, 3.2E10, 6.4E10, 1.28E11, 2.56E11, 5.12E11
>    LET a1=2^i*a0
>    LET d=CEIL(LOG10(a1))
>    LET u$=USING$("#.##^^^^",a1)
>    PRINT u$;"(=2^";STR$(i);"*1.6E10)  整数部";STR$(d);"桁"
>    FOR a=a1-50 TO a1+100
>       LET a$=USING$(REPEAT$("#",d)&".###########",a)
>       LET f=VAL(a$(d+1:d+12))  ! 小数部分 VAL(".###########")
>       IF f=0 THEN
>          PRINT a               ! 問題なし
>       ELSE
>          IF POS(STR$(a),".")=0 THEN
>             PRINT " ";a$       ! 書式指定による誤表示
>          ELSE
>             PRINT " ";a$ ; a   ! 書式指定と[表示桁数を多く]による誤表示
>          END IF
>       END IF
>    NEXT a
>    PRINT
> NEXT i
> END
 

2進モードで整数が実数表示されるバグ報告

 投稿者:nagaram  投稿日:2018年 3月30日(金)16時27分45秒
返信・引用
  2進モードで書式指定を利用して整数を表示すると、一部の整数が実数で表示されます。
十進BASICのバージョンは7.8.2


調査しましたが、誤表示される最小の整数はおそらく16000000001(=1.6E10+1)です。

OPTION ARITHMETIC NATIVE
FOR a=1.6E10 TO 1.6E10+10
   PRINT USING " ###########.###########" : a
NEXT a
END


上記の方法で誤表示される整数の一部は、書式指定を利用しなくとも[オプション][数値][表示桁数を多く]にチェックを入れると、やはり実数で表示されます。
これで誤表示される最小の整数はおそらく64000000001(=6.4E10+1)です。

OPTION ARITHMETIC NATIVE   ! [表示桁数を多く]にチェックを入れる
FOR a=6.4E10 TO 6.4E10+20
   PRINT USING " ###########.###########" : a
   PRINT a
NEXT a
END


誤表示される数値の出現には規則性があり、1.6E10を元にして倍々するごとに出現パターンが変化します。
1.6E10を2の累乗倍し、それより小さな値を50個、大きな値を100個出力させました。

OPTION ARITHMETIC NATIVE   ! [表示桁数を多く]にチェックを入れる
LET a0=1.6E10
FOR i=0 TO 5   ! 1.6E10, 3.2E10, 6.4E10, 1.28E11, 2.56E11, 5.12E11
   LET a1=2^i*a0
   LET d=CEIL(LOG10(a1))
   LET u$=USING$("#.##^^^^",a1)
   PRINT u$;"(=2^";STR$(i);"*1.6E10)  整数部";STR$(d);"桁"
   FOR a=a1-50 TO a1+100
      LET a$=USING$(REPEAT$("#",d)&".###########",a)
      LET f=VAL(a$(d+1:d+12))  ! 小数部分 VAL(".###########")
      IF f=0 THEN
         PRINT a               ! 問題なし
      ELSE
         IF POS(STR$(a),".")=0 THEN
            PRINT " ";a$       ! 書式指定による誤表示
         ELSE
            PRINT " ";a$ ; a   ! 書式指定と[表示桁数を多く]による誤表示
         END IF
      END IF
   NEXT a
   PRINT
NEXT i
END
 

Re: VTKファイルをつくる23

 投稿者:しばっち  投稿日:2018年 3月21日(水)13時03分23秒
返信・引用
  > No.4534[元記事へ]

ParaViewのボリュームレンダリング機能を使用しています。
表示を「volume」にしてください。
カプセル型を定義しています。
マシンパワーによって各格子のサイズを調整してください。

LET XSIZE=100
LET YSIZE=100
LET ZSIZE=100
DIM A(3),B(3),P(3)
CALL VEC3(A,.75,0,1)
CALL VEC3(B,-.75,0,1)
FILE GETSAVENAME F$,"vtkファイル|*.vtk"
IF F$="" THEN STOP
IF POS(UCASE$(F$),".VTK")=0 THEN LET F$=F$&".vtk"
OPEN #1:NAME F$
ERASE #1
PRINT #1:"# vtk DataFile Version 2.0"
PRINT #1:"capsule"
PRINT #1:"ASCII"
PRINT #1:"DATASET STRUCTURED_POINTS"
PRINT #1:"DIMENSIONS";XSIZE;YSIZE;ZSIZE
PRINT #1:"ORIGIN 0 0 0"
PRINT #1:"SPACING 1 1 1"
PRINT #1:"POINT_DATA";XSIZE*YSIZE*ZSIZE
PRINT #1:"SCALARS scalar float"
PRINT #1:"LOOKUP_TABLE default"
FOR ZZ=0 TO ZSIZE-1
   FOR YY=0 TO YSIZE-1
      FOR XX=0 TO XSIZE-1
         LET X=-2.5+5/XSIZE*XX
         LET Y=-2.5+5/YSIZE*YY
         LET Z=-2.5+5/ZSIZE*ZZ
         CALL VEC3(P,X,Y,Z)
         IF CAPSULE(P,A,B,1)<.1 THEN LET DA=255 ELSE LET DA=0
         PRINT #1:DA
      NEXT  XX
   NEXT  YY
NEXT  ZZ
CLOSE #1
END

EXTERNAL  FUNCTION CAPSULE(P(),A(),B(),R) !'float sdCapsule( vec3 p, vec3 a, vec3 b, float r ){
DIM PA(3),BA(3),D(3)
MAT PA=P-A                                !'vec3 pa = p - a, ba = b - a;
MAT BA=B-A
LET H=CLAMP(DOT(PA,BA)/DOT(BA,BA),0,1)    !'float h = clamp( dot(pa,ba)/dot(ba,ba), 0.0, 1.0 );
MAT D=H*BA
MAT PA=PA-D
LET CAPSULE=LENGTH(PA)-R                  !'return length( pa - ba*h ) - r;}
END FUNCTION

EXTERNAL  FUNCTION LENGTH(A())
LET LENGTH=SQR(A(1)^2+A(2)^2+A(3)^2)
END FUNCTION

EXTERNAL  SUB VABS(A(),B())
FOR I=1 TO 3
   LET A(I)=ABS(B(I))
NEXT I
END SUB

EXTERNAL  SUB VEC3(A(),X,Y,Z)
LET A(1)=X
LET A(2)=Y
LET A(3)=Z
END SUB

EXTERNAL  FUNCTION CLAMP(X,A,B) !' A<=X<=B
LET CLAMP=MIN(B,MAX(X,A))
END FUNCTION
 

Re: VTKファイルをつくる23

 投稿者:しばっち  投稿日:2018年 3月21日(水)13時02分43秒
返信・引用
  > No.4534[元記事へ]

ParaViewのボリュームレンダリング機能を使用しています。
表示を「volume」にしてください。
円錐形を定義しています。
マシンパワーによって各格子のサイズを調整してください。

LET XSIZE=100
LET YSIZE=100
LET ZSIZE=100
DIM P(3),C(3)
CALL VEC3(C,.5,.7,.5)
FILE GETSAVENAME F$,"vtkファイル|*.vtk"
IF F$="" THEN STOP
IF POS(UCASE$(F$),".VTK")=0 THEN LET F$=F$&".vtk"
OPEN #1:NAME F$
ERASE #1
PRINT #1:"# vtk DataFile Version 2.0"
PRINT #1:"cone"
PRINT #1:"ASCII"
PRINT #1:"DATASET STRUCTURED_POINTS"
PRINT #1:"DIMENSIONS";XSIZE;YSIZE;ZSIZE
PRINT #1:"ORIGIN 0 0 0"
PRINT #1:"SPACING 1 1 1"
PRINT #1:"POINT_DATA";XSIZE*YSIZE*ZSIZE
PRINT #1:"SCALARS scalar float"
PRINT #1:"LOOKUP_TABLE default"
FOR ZZ=0 TO ZSIZE-1
   FOR YY=0 TO YSIZE-1
      FOR XX=0 TO XSIZE-1
         LET X=-1+2/XSIZE*XX
         LET Y=-1+2/YSIZE*YY
         LET Z=-1+2/ZSIZE*ZZ
         CALL VEC3(P,X,Y,Z)
         IF CAPPEDCONE(P,C)<.1 THEN LET DA=255 ELSE LET DA=0
         PRINT #1:DA
      NEXT  XX
   NEXT  YY
NEXT  ZZ
CLOSE #1
END

EXTERNAL  FUNCTION CAPPEDCONE(P(),C())       !'float sdCappedCone( in vec3 p, in vec3 c ){
DIM Q(3),V(3),W(3),VV(3),QV(3),D(3),K(3)
CALL VEC2(Q,LENGTH2(P(1),P(3),0),P(2))       !'vec2 q = vec2( length(p.xz), p.y );
CALL VEC2(V,C(3)*C(2)/C(1),-C(3))            !'vec2 v = vec2( c.z*c.y/c.x, -c.z );
MAT W=V-Q                                    !'vec2 w = v - q;
CALL VEC2(VV,DOT(V,V),V(1)^2)                !'vec2 vv = vec2( dot(v,v), v.x*v.x );
CALL VEC2(QV,DOT(V,W),V(1)*W(1))             !'vec2 qv = vec2( dot(v,w), v.x*w.x );
CALL NMAX(K,QV,0)                            !'vec2 d = max(qv,0.0)*qv/vv;
LET D(1)=K(1)*QV(1)/VV(1)
LET D(2)=K(2)*QV(2)/VV(2)
WHEN EXCEPTION IN
   LET CAPPEDCONE=SQR(DOT(W,W)-MAX(D(1),D(2)))*SGN(MAX(Q(2)*V(1)-Q(1)*V(2),W(2))) !'return sqrt( dot(w,w) - max(d.x,d.y) ) * sign(max(q.y*v.x-q.x*v.y,w.y));}
USE
   LET CAPPEDCONE=100000
END WHEN
END FUNCTION

EXTERNAL  FUNCTION LENGTH2(A,B,C)
LET LENGTH2=SQR(A^2+B^2+C^2)
END FUNCTION

EXTERNAL  SUB VEC2(A(),X,Y)
LET A(1)=X
LET A(2)=Y
END SUB

EXTERNAL  SUB VEC3(A(),X,Y,Z)
LET A(1)=X
LET A(2)=Y
LET A(3)=Z
END SUB

EXTERNAL  SUB NMAX(A(),B(),N)
FOR I=1 TO 3
   LET A(I)=MAX(B(I),N)
NEXT I
END SUB

 

Re: VTKファイルをつくる23

 投稿者:しばっち  投稿日:2018年 3月21日(水)13時01分45秒
返信・引用
  > No.4534[元記事へ]

ParaViewのボリュームレンダリング機能を使用しています。
表示を「volume」にしてください。
円柱を定義しています。
マシンパワーによって各格子のサイズを調整してください。

LET XSIZE=100
LET YSIZE=100
LET ZSIZE=100
DIM P(3),H(3)
CALL VEC2(H,.8,.5)
FILE GETSAVENAME F$,"vtkファイル|*.vtk"
IF F$="" THEN STOP
IF POS(UCASE$(F$),".VTK")=0 THEN LET F$=F$&".vtk"
OPEN #1:NAME F$
ERASE #1
PRINT #1:"# vtk DataFile Version 2.0"
PRINT #1:"cylinder"
PRINT #1:"ASCII"
PRINT #1:"DATASET STRUCTURED_POINTS"
PRINT #1:"DIMENSIONS";XSIZE;YSIZE;ZSIZE
PRINT #1:"ORIGIN 0 0 0"
PRINT #1:"SPACING 1 1 1"
PRINT #1:"POINT_DATA";XSIZE*YSIZE*ZSIZE
PRINT #1:"SCALARS scalar float"
PRINT #1:"LOOKUP_TABLE default"
FOR ZZ=0 TO ZSIZE-1
   FOR YY=0 TO YSIZE-1
      FOR XX=0 TO XSIZE-1
         LET X=-1+2/XSIZE*XX
         LET Y=-1+2/YSIZE*YY
         LET Z=-1+2/ZSIZE*ZZ
         CALL VEC3(P,X,Y,Z)
         IF CAPPEDCYLINDER(P,H)<.1 THEN LET DA=255 ELSE LET DA=0
         PRINT #1:DA
      NEXT  XX
   NEXT  YY
NEXT  ZZ
CLOSE #1
END

EXTERNAL  FUNCTION CAPPEDCYLINDER(P(),H())            !'float sdCappedCylinder( vec3 p, vec2 h ){
DIM V(3),S(3),DD(3),D(3)
LET L=LENGTH2(P(1),P(3),0)
CALL VEC2(V,L,P(2))
CALL VABS(S,V)
MAT D=S-H                                             !'vec2 d = abs(vec2(length(p.xz),p.y)) - h;
CALL NMAX(DD,D,0)
LET CAPPEDCYLINDER=MIN(MAX(D(1),D(2)) ,0)+LENGTH(DD)  !' return min(max(d.x,d.y),0.0) + length(max(d,0.0));}
END FUNCTION

EXTERNAL  FUNCTION LENGTH(A())
LET LENGTH=SQR(A(1)^2+A(2)^2+A(3)^2)
END FUNCTION

EXTERNAL  FUNCTION LENGTH2(A,B,C)
LET LENGTH2=SQR(A^2+B^2+C^2)
END FUNCTION

EXTERNAL  SUB NMAX(A(),B(),N)
FOR I=1 TO 3
   LET A(I)=MAX(B(I),N)
NEXT I
END SUB

EXTERNAL  SUB VABS(A(),B())
FOR I=1 TO 3
   LET A(I)=ABS(B(I))
NEXT I
END SUB

EXTERNAL  SUB VEC3(A(),X,Y,Z)
LET A(1)=X
LET A(2)=Y
LET A(3)=Z
END SUB

EXTERNAL  SUB VEC2(A(),X,Y)
LET A(1)=X
LET A(2)=Y
END SUB
 

レンタル掲示板
/158