球体を描くプログラム

 投稿者：9mm  投稿日：2009年 7月 8日(水)02時34分51秒
  三次元座標にたくさん座標をとって球体を作りたいんですが、どんな座標をとれば球体のように見えるんでしょうか？
さらにその球体がバウンドしているようなプログラムを作りたいんですが、可能でしょうか？
まだBASICを習ったばっかりなのであまり難しいことはできません…

ぜひ教えてください。 		 

Re: 球体を描くプログラム

 投稿者：白石　和夫  投稿日：2009年 7月 8日(水)07時56分27秒
  > No.436[元記事へ]

球面の描き方は，サンプルプログラムの
SAMPLE\SPHERICA.BAS
を参照してください。
バウンドしているように見せるためには，
描画中は
DRAW MODE HIDDEN
の状態で見せないようにして
描画が終わったら
DRAW MODE EXPLICIT
を実行します。
詳細は，
にあります。
また，毎度描くと遅くなるので，
ASK PIXEL ARRAY
で画素レベルで記憶し，
MAT PLOT CELLS
で位置をずらして描くことになると思います。 		 

Re: 球体を描くプログラム

 投稿者：白石　和夫  投稿日：2009年 7月 8日(水)08時59分24秒
  > No.437[元記事へ]

OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
LET theta0=-125
LET z0=10
REM z軸のまわりにtheta0度回転したsphreを，
REM 点(0,0,z0)から見たように描く。
DIM p(4,4)         ! 点 0,0,z0を中心とする射影
MAT p=IDN
LET p(3,4)=-1/z0
DIM rotx(4,4)      ! x軸のまわりの-90°回転
MAT rotx=IDN
LET rotx(2,2)=COS(-90)
LET rotx(2,3)=SIN(-90)
LET rotx(3,2)=-SIN(-90)
LET rotx(3,3)=COS(-90)

ASK PIXEL SIZE (0,1;1,0) a,b
DIM sp(a,b)

SET COLOR mode "NATIVE"
SET WINDOW -2, 2, -2, 2

DRAW sphere0 WITH ROTATE(theta0)  * rotx
ASK PIXEL ARRAY (-2,2) sp
FOR t = 0 TO 360*3 STEP 15   ! 球体を3回バウンドさせる
   SET DRAW mode hidden
   CLEAR
   DRAW sphere WITH SHIFT(0,SIN(t))
   SET DRAW mode explicit
NEXT t

PICTURE sphere
   MAT PLOT CELLS ,IN -2,2; 2,-2: sp
END PICTURE

END


! 単位球を描く
EXTERNAL PICTURE sphere0
OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES

DIM sz(4,4),ry(4,4)
MAT READ sz
DATA 1,0,0,0
DATA 0,1,0,0
DATA 0,0,1,0
DATA 0,0,1,1
MAT READ ry
DATA  0, 0,-1, 0
DATA  0, 1, 0, 0
DATA  1, 0, 0, 0
DATA  0, 0, 0, 1
! 球面を描く
SET AREA STYLE "SOLID"
FOR t=0 TO 180
   FOR p=0 TO 359
      LET ry(1,3)=-SIN(t)
      LET ry(3,1)=SIN(t)
      LET ry(1,1)=COS(t)
      LET ry(3,3)=COS(t)
      DRAW Trapezoid(t) WITH sz*ry*ROTATE(p)
   NEXT p
NEXT t

PICTURE Trapezoid(t)      ! tは天頂角
   DIM N(3)
   CALL makeNormal(N)
   IF N(3)>0 THEN     ! 外側が手前なら面を描く
      CALL setBrightness(N)
      PLOT AREA: -PI/360, -SIN(t-0.5)*PI/360; PI/360,-SIN(t+0.5)*PI/360; PI/360,SIN(t+0.5)*PI/360; -PI/360,SIN(t-0.5)*PI/360
   END IF
END PICTURE

END PICTURE

! 変換された座標系における法線ベクトルを求める
EXTERNAL SUB makeNormal(N())
OPTION ARITHMETIC NATIVE
DIM m(4,4),A(4),B(4),C(4)
MAT m=TRANSFORM
MAT READ A
DATA 0,0,0,1
MAT READ B
DATA 1,0,0,1
MAT READ C
DATA 1,1,0,1
MAT A=A*M
MAT B=B*M
MAT C=C*M
MAT A=(1/A(4))*A
MAT B=(1/B(4))*B
MAT C=(1/C(4))*C
MAT REDIM A(3)
MAT REDIM B(3)
MAT REDIM C(3)
MAT A=B-A
MAT B=C-B
MAT N=CROSS(A,B)
END SUB

EXTERNAL SUB setBrightness(N())
OPTION ARITHMETIC NATIVE
DIM A(3)
MAT READ A      ! 光源の向き
DATA -4,5,3
LET s=DOT(A,N)/(SQR(DOT(A,A))*SQR(DOT(N,N)))
LET s=(0.8*s+1)/2
SET AREA COLOR COLORINDEX(s,s,s)
END SUB 		 

先生のが、むずかしいとき・・

 投稿者：SECOND  投稿日：2009年 7月 8日(水)10時07分26秒
  > No.436[元記事へ]

!カラー・ボール
!-------------------------------
OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
DIM rotx(4,4)
MAT rotx=IDN

SET WINDOW -10,10,-10,10

! ｘｙ平面上の描点を、ｘ軸で回転する行列 rotx
LET ar0=35
!(x,y,z,1)| 1,        0,        0, 0 |
!         | 0, cos(ar0), sin(ar0), 0 |
!         | 0,-sin(ar0), cos(ar0), 0 |
!         | 0,        0,        0, 1 |
LET rotx(2,2)=COS(ar0)
LET rotx(3,2)=-SIN(ar0)
LET rotx(2,3)=SIN(ar0)
LET rotx(3,3)=COS(ar0)

LET r=5 !　半径５ｍのカラー・ボール
LET t0=TIME
DO
   LET t=TIME-t0
   SET DRAW mode hidden
   CLEAR
   LET y=5-4.9*t^2 !　頂点が５ｍの放物線
   DRAW ball WITH SHIFT(0,y)
   SET DRAW mode explicit
   IF y< -4 THEN LET t0=t0+2*SQR((5+4)/4.9) !( 5m → -4m )時間の２倍で平行移動。
LOOP

PICTURE ball
   FOR i=-r*0.9 TO r*0.9 STEP r*0.1
      SET AREA COLOR MOD(i-0.6, 0.2*r)*5
      DRAW disk WITH SCALE( SQR(r^2-i^2) )*rotx*SHIFT(0, SIN(ar0)*i)
   NEXT i
END PICTURE

END 		 

Re: 球体を描くプログラム

 投稿者：9mm  投稿日：2009年 7月 8日(水)14時14分57秒
  > No.439[元記事へ]

ありがとうございます。


作っていただき本当に申し訳ないんですが、球体だけを書きたいときはどうすればいいんでしょうか？
球面にせずに４つの座標をつないでなるべく球体に見えるようなものがいいんですが…

それがx軸周りで回転しているようなプログラムとか作れますかね？

初心者用の課題なんであまり高度なプログラミングをすると…(>_<)


何度も申し訳ないですｍ(。。）ｍ 		 

Re: 球体を描くプログラム

 投稿者：SECOND  投稿日：2009年 7月 8日(水)18時19分34秒
  > No.443[元記事へ]

差し出がましいとは、思いますが、先生は、たいへん多忙で、ご負担の大きい作業など
ありますので、できれば、この先は、sample\ フォルダーの方で、対処される事を期待
いたします。でしゃばりで、もうしわけないです。 		 

Re: 球体を描くプログラム

 投稿者：9mm  投稿日：2009年 7月 8日(水)18時37分16秒
  > No.444[元記事へ]

SAMPLEフォルダはどこにあるんでしょうか？

わからないんですが… 		 

Re: 球体を描くプログラム

 投稿者：SECOND  投稿日：2009年 7月 8日(水)18時50分8秒
  > No.445[元記事へ]

BASIC.EXE の有る所と同じフォルダーに同包されています。
大文字の、SAMPLE かもしれません。windows は、大小を区別しませんので。 		 

Re: 球体を描くプログラム

 投稿者：9mm  投稿日：2009年 7月 8日(水)19時19分4秒
  > No.446[元記事へ]

ありました。ありがとうございます。

ただ球面にしないようにするにはどうしたらいいんでしょうか？

点を結んで球体っぽく見せたいのですが、それらしいフォルダが見つかりません…。
何度も申し訳ないです。初心者過ぎて申し訳ないです。 		 
 

Re: 球体を描くプログラム

 投稿者：山中和義  投稿日：2009年 7月 8日(水)20時01分52秒
  > No.443[元記事へ]

9mmさんへのお返事です。

>三次元座標にたくさん座標をとって球体を作りたいんですが、

>球面にせずに４つの座標をつないでなるべく球体に見えるようなものがいいんですが…


一般に３Ｄグラフィックスでは、多面体を重ねます。
サッカーボールを想像するとよいでしょう。
６角形と５角形。（今のサッカーボールは違うかも！？）



また、地球の緯度と経度で台形分割（北極、南極は三角形）することもできます。
一般によくみるメルカトル図法の世界地図です。
これを地球儀にマップすることを想像してください。

!経線と緯線と使って、球体をワイヤーフレームで描画する

SET WINDOW -2,2,-2,2

FOR t=0 TO 90 STEP 15 !角度を等分割する
   LET a=SIN(RAD(t)) !端付近：密、中央付近：疎
   LET b=1
   FOR i=0 TO 360 !経線　※楕円を描く
      LET x=a*COS(RAD(i))
      LET y=b*SIN(RAD(i))
      PLOT LINES: x,y;
   NEXT i
   PLOT LINES
NEXT t

FOR i=-180 TO 180 STEP 10 !緯線　※水平線を描く
   LET y=SIN(RAD(i)) !角度を等分割する
   LET x=SQR(1-y^2) !極付近：密、０度付近：疎
   PLOT LINES: -x,y; x,y
NEXT i
PLOT LINES

END


私からサンプルとして、美術的手法（なぜ平面の画像が立体にみえるのか？）で表示したものです。
上記と合わせて考察してみてください。
!楕円を重ねると球体に見える！？

SET WINDOW -2,2,-2,2

LET b=1
FOR a=0 TO 1 STEP 0.25

   FOR i=0 TO 360 !楕円を描く
      LET x=a*COS(RAD(i))
      LET y=b*SIN(RAD(i))
      PLOT LINES: x,y;
   NEXT i
   PLOT LINES

NEXT a

LET a=1
FOR b=0 TO 1 STEP 0.25

   FOR i=0 TO 360 !楕円を描く
      LET x=a*COS(RAD(i))
      LET y=b*SIN(RAD(i))
      PLOT LINES: x,y;
   NEXT i
   PLOT LINES

NEXT b

END
 

Re: 球体を描くプログラム

 投稿者：9mm  投稿日：2009年 7月 8日(水)21時29分47秒
  > No.448[元記事へ]

山中和義さんへのお返事です。

ありがとうございます。

この図形が動いたりしませんかね？

できればこのサッカーボールのような図形が動いたらおもしろいと思うんですが・・ 		 

Re: 球体を描くプログラム

 投稿者：山中和義  投稿日：2009年 7月 9日(木)16時28分37秒
  > No.443[元記事へ]

9mmさんへのお返事です。

> 球面にせずに４つの座標をつないでなるべく球体に見えるようなものがいいんですが…
> それがx軸周りで回転しているようなプログラムとか作れますかね？
> 初心者用の課題なんであまり高度なプログラミングをすると…(>_<)

この質問がはっきりしませんので、正確な回答ができませんが、、、
!ワイヤーフレームで曲面を描く　SAMPLE\3DPLOT.BASを改修。

SUB rotx(x,y,z,a)
   LET y0=y*cos(a)-z*sin(a)
   LET z0=y*sin(a)+z*cos(a)
   LET y=y0
   LET z=z0
END SUB
SUB roty(x,y,z,a)
   LET x0=x*cos(a)+z*sin(a)
   LET z0=-x*sin(a)+z*cos(a)
   LET x=x0
   LET z=z0
END SUB
SUB rotz(x,y,z,a)
   LET x0=x*cos(a)-y*sin(a)
   LET y0=x*sin(a)+y*cos(a)
   LET x=x0
   LET y=y0
END SUB
SUB convert(x,y,z)
   CALL rotz(x,y,z,RAD(-30))
   CALL rotx(x,y,z,RAD(-70))
END SUB
SUB plotTo(x,y,z)
   LET x1=x
   LET y1=y
   LET z1=z
   CALL convert(x1,y1,z1)
   PLOT LINES:x1,y1;
END SUB
SUB PenUp
   PLOT LINES
END SUB
SUB PlotText(x,y,z,s$)
   CALL convert(x,y,z)
   PLOT TEXT ,AT x,y: s$
END SUB

!媒体変数表示
DEF fx(u,v)=COS(u)*SIN(v) !球　u=[0,2*PI],v=[0,PI]　※球座標(r,θ,φ)
DEF fy(u,v)=SIN(u)*SIN(v)
DEF fz(u,v)=COS(v)

SET WINDOW -2,2,-2,2

FOR f=0 TO 360 !フレーム・アニメーション
   SET DRAW mode hidden !ちらつき防止（開始）
   CLEAR

   ! 軸を描く
   CALL PlotTo(0,0,0)
   CALL PlotTo(2,0,0)
   CALL PlotTo(0,0,0)
   CALL PlotTo(0,2,0)
   CALL PlotTo(0,0,0)
   CALL PlotTo(0,0,2)
   CALL PenUp
   CALL PlotText(2,0,0,"x")
   CALL PlotText(0,2,0,"y")
   CALL PlotText(0,0,2,"z")

   ! 曲面を描く
   FOR u=0 TO 360 STEP 15
      FOR v=0 TO 180 STEP 15
         LET x=fx(RAD(u),RAD(v))
         LET y=fy(RAD(u),RAD(v))
         LET z=fz(RAD(u),RAD(v))
         CALL rotx(x,y,z,RAD(f))
         CALL PlotTo(x,y,z)
      NEXT v
      CALL PenUp
   NEXT u
   FOR v=0 TO 180 STEP 30
      FOR u=-1 TO 360 STEP 30
         LET x=fx(RAD(u),RAD(v))
         LET y=fy(RAD(u),RAD(v))
         LET z=fz(RAD(u),RAD(v))
         CALL rotx(x,y,z,RAD(f))
         CALL PlotTo(x,y,z)
      NEXT u
      call PenUp
   NEXT v

   SET DRAW mode explicit !ちらつき防止（終了）
   !WAIT DELAY 0.1
NEXT f

END
 

戻る