半透明の立体を描く

基本的な使い方の項でも述べたように、3DExplorer の GLShow[] 関数には Transparency というオプションがあり、半透明の図を描くことができます。ところが、オプションは図全体に作用するため、図の中の一部の立体のみを半透明にすることはできません。そこで、ここでは Transparency[] というグラフィックス・ディレクティブを新たに定義し、図の中の一部の立体だけを半透明に描くことをを試みます。

初期化

Clear["Global`*"];
Needs["GLExplorer`GLRenderer`"];
Needs["Graphics`Polyhedra`"];
Needs["Graphics`Shapes`"];
Needs["rotateGraphics`"];
GLOpenPalette["Motion"];

Transparency[] ディレクティブの定義

GLShow[] は Mathematica の標準のグラフィックスオブジェクトに対しては GLRender3D[] 関数で、GLGraphics オブジェクトに対しては GLRender[] 関数でレンダリングをします。従って、両方の関数に対して Transparency[] ディレクティブを定義します。ここで、gl･･･ で始まる関数は OpenGL の関数で、Gl･･･ で始まるものは OpenGL の定数です。

Unprotect[GLRender3D];
GLRender3D[Transparency[0]] := (glDisable[GlBlend]; 
          glDepthMask[True]);
GLRender3D[
          Transparency[t_]] := (glMaterial[GlFrontAndBack, 
            GlDiffuse, {1. , 1. , 1. , 1.  - t}]; 
          glBlendFunc[GlSrcAlpha, GlOneMinusSrcAlpha]; glEnable[GlBlend]; 
          glDepthMask[False]);
Protect[GLRender3D];
Unprotect[GLRender];
GLRender[Transparency[0]] := (glDisable[GlBlend]; 
          glDepthMask[True]);
GLRender[
          Transparency[t_]] := (glMaterial[GlFrontAndBack, 
            GlDiffuse, {1. , 1. , 1. , 1.  - t}]; 
          glBlendFunc[GlSrcAlpha, GlOneMinusSrcAlpha]; glEnable[GlBlend]; 
          glDepthMask[False]);
Protect[GLRender];

多面体の接触関係

上で定義した Transparency[] ディレクティブを使って、２つの多面体を表示する関数 showPolys[] を定義します。この関数は、内側の多面体は従来通り描き、外側の多面体は半透明で描きます。t（0＜t＜1）の値を大きくすると、より透明度が増し、デフォルトは 0.7 にしてあります。尚、ここでの Transparency[] ディレクティブは、GLRender3D[] 関数に対して定義された方が使われています。

showPolys[in_, out_, t_:  .7] := 
      GLShow[Graphics3D[
          Flatten[{First[in], Transparency[t], First[out], 
              Transparency[0]}]], Boxed -> False]

多面体の準備

Polyhedra.m に定義されている正多面体を呼び出します。各正多面体の大きさは、デフォルトでは中心から各辺の中点までの距離が１になっていますが、使いやすいように中心から各頂点までの距離１になるように縮小しておきます。

tet = Polyhedron[Tetrahedron, 0, (1/(Sqrt[3]))];
cub = Polyhedron[Cube, 0, (( 2)/(Sqrt[6]))];
oct = Polyhedron[Octahedron, 0, (1/(Sqrt[2]))];
dod = Polyhedron[Dodecahedron, 0, (Sqrt[((3 + (Sqrt[5]))/6)])];
ico = 
        Polyhedron[Icosahedron, 0, (Sqrt[(1/10) (5 + (Sqrt[5]))])];

次に、正多面体から星型正多面体を作ります。第１章「Polyhedra.m について」の Stellate[] 関数の項で述べたように、小星型正十二面体は正十二面体を星型化して、大星型正十二面体や大型正十二面体は正二十面体を星型化して作ることができます。

ssd = 
        AffineShape[
          Stellate[
            dod, (Sqrt[5])], (({1, 1, 1} (Sqrt[15 - 6 (Sqrt[5])]))/(Sqrt[5]))];
GLShow[ssd, Boxed -> False];
gsd = 
        AffineShape[Stellate[ico, 3], 
          (1/3) {1, 1, 1} (Sqrt[15 - 6 (Sqrt[5])])];
GLShow[gsd, Boxed -> False];
gdod = Stellate[ico, 3 (Sqrt[5]) - 6];
GLShow[gdod, Boxed -> False];

大型正二十面体については、小星型十二面体から作ることができますが、Stellate[] 関数は常に多面体をその中心に向かって星型化するので、この場合は使えません。そこで、ここでは各面を三角錐に置きかえる独自のルールを定義し、小星型正十二面体に適用します。

ssdtogic = 
        Polygon[{a_, b_, c_}] :> (p = 
              (1/5) (5 - 2 (Sqrt[5])) a + ((5 - (Sqrt[5]))/5) ((b + c)/2); 
            N[{Polygon[{p, a, b}], Polygon[{p, b, c}], 
                Polygon[{p, c, a}]}]);
gico = 
        Graphics3D[First[ssd] /. ssdtogic];
GLShow[gico, Boxed -> False];

次に、菱形多面体を作ります。菱形十二面体は、正六面体や正八面体を星型化して、菱形三十面体は正十二面体や正二十面体を星型化して作ることができます。ここではそれぞれ、正六面体、正十二面体を星型化して作りますが、各面の菱形に残った対角線を消すために、torhom1 や torhom2 といったルールを適用しています。

torhom1 = {s___, Polygon[{p1_, q_, r_}], t___, 
            Polygon[{p2_, q_, r_}], u___} -> {s, 
            Polygon[{p1, q, p2, r}], t, u};
torhom2 = {s___, Polygon[{p1_, q_, r_}], t___, 
            Polygon[{p2_, r_, q_}], u___} -> {s, 
            Polygon[{p1, q, p2, r}], t, u};
rhom12 = 
        GLShow[Graphics3D[Stellate[First[cub], 2] //. {torhom1, torhom2}], 
          Boxed -> False];
rhom30 = 
        GLShow[Graphics3D[
            Stellate[First[dod], (1/2) (5 - (Sqrt[5]))] //. {torhom1, 
                torhom2}], Boxed -> False];

正多面体の関係

２つの正四面体

tet2 = 
        AffineShape[RotateShape[tet, 0, π, 0], 
          (1/3) {1, 1, 1}];
showPolys[tet2, tet];

正六面体と正八面体の双対性

cub2 = AffineShape[cub, {1, 1, 1}/(Sqrt[3])];
oct2 = AffineShape[oct, {1, 1, 1}/(Sqrt[3])];
showPolys[oct2, cub];
showPolys[cub2, oct];

正十二面体と正二十面体の双対性

dod2 = AffineShape[dod, {1, 1, 1}/(Sqrt[15 - 6 (Sqrt[5])])];
ico2 = AffineShape[ico, {1, 1, 1}/(Sqrt[15 - 6 (Sqrt[5])])];
showPolys[ico2, dod];
showPolys[dod2, ico];

正四面体と正六面体
これより正六面体は正四面体を星型化して作れることが分かります。

tet3 = 
        RotateShape[tet, 0, -ArcTan[(Sqrt[2])], -(π/4)];
showPolys[tet3, cub];

正四面体と正十二面体

tet4 = 
        RotateShape[
          tet3, -(π/2), (π/4) - 
            ArcTan[(Sqrt[5]) - 2], (π/2)];
showPolys[tet4, dod];

正六面体と正十二面体

cub3 = 
        RotateShape[
          cub, -(π/2), (π/4) - 
            ArcTan[(Sqrt[5]) - 2], (π/2)];
showPolys[cub3, dod];

星型正多面体と正多面体の関係

小星型正十二面体と正二十面体

GLShow[ssd, Boxed -> False];
showPolys[ssd, ico];

大星型正十二面体と正十二面体

GLShow[gsd, Boxed -> False];
showPolys[gsd, dod];

大型正十二面体と正二十面体

GLShow[gdod, Boxed -> False];
showPolys[gdod, ico,  .3];

大型正二十面体と小星型正十二面体

GLShow[gico, Boxed -> False];
showPolys[gico, ssd,  .3];

菱形多面体と正多面体・星型正多面体の関係

菱形十二面体と正六面体・正八面体

GLShow[rhom12, Boxed -> False];
showPolys[cub, rhom12];
showPolys[oct, 
        AffineShape[rhom12, (1/2) {1, 1, 1} (Sqrt[3])]];

菱形三十面体と正十二面体・正二十面体

GLShow[rhom30, Boxed -> False];
showPolys[dod, rhom30];
showPolys[ico, 
        AffineShape[
          rhom30, (({1, 1, 1} 2 (Sqrt[15 - 6 (Sqrt[5])]))/(5 - (Sqrt[5])))]];

菱形三十面体と小星型正十二面体・大星型正十二面体

showPolys[ssd, 
        AffineShape[
          rhom30, (({1, 1, 1} 2 (Sqrt[15 - 6 (Sqrt[5])]))/(5 - (Sqrt[5])))]];
showPolys[gsd, rhom30];

菱形三十面体と大型正十二面体・大型正二十面体

showPolys[gdod, 
        AffineShape[
          rhom30, (({1, 1, 1} 2 (Sqrt[15 - 6 (Sqrt[5])]))/(5 - (Sqrt[5])))]];
showPolys[gico, 
        AffineShape[
          rhom30, (({1, 1, 1} 2 (Sqrt[15 - 6 (Sqrt[5])]))/(5 - (Sqrt[5])))]];

回転する正方形や正四面体のアニメーション

ここでは、第１章の「rotateGraphics.m について」の項で説明した回転体の中で、本当に正方形や正四面体が回転するアニメーションを作ります。

正方形の回転

まず、正方形と回転軸を用意し、回転体を作ります。

squ = 
        Graphics3D[
          Polygon[{{1, 1, 0}, {-1, 1, 0}, {-1, -1, 
                0}, {1, -1, 0}}]];
sv = {1, 1, Sqrt[2]};
squ1 = showAxis[squ, sv];
squ2 = rotateGraphics[squ, sv, 30];

回転体を半透明で描き、その中で正方形を回転させます。回転には、3DExplorer の Rotate[] ディレクティブを用います。glsqu1 が正方形と回転軸、glsqu2 が半透明の回転体の GLGraphics オブジェクトです。従って、ここでの Transparency[] ディレクティブは、GLRender[] 関数に対して定義された方が使われていることになります。

glsqu1 = GLGraphics[squ1];
glsqu2 = 
        GLGraphics[{Transparency[ .5], First[squ2], 
            Transparency[0]}];
rotsqu = 
      Table[GLGraphics[Rotate[t, sv]], {t, 0, 2  π, N[(π/12)]}]; 
    glclm = GLGraphics[ClearMatrix[]];
GLShow[{rotsqu, {glsqu1}, {glclm}, {glsqu2}}, 
        PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}, {-1.5, 
              1.5}}, AnimateFrames -> True];

正四面体の回転

正四面体と回転軸を用意し、回転体を作ります。

tet = Graphics3D[Tetrahedron[]];
tv = {(Sqrt[3]), 1, -(Sqrt[2])};
tet1 = showAxis[tet, tv];
tet2 = rotateGraphics[tet, tv, 30];

半透明の回転体の中を、正四面体が回転します。

gltet1 = GLGraphics[tet1];
gltet2 = 
        GLGraphics[{Transparency[ .5], First[tet2], 
            Transparency[0]}];
rottet = 
        Table[GLGraphics[Rotate[t, tv]], {t, 0, 2  π, 
            N[(π/12)]}];
glclm = GLGraphics[ClearMatrix[]];
GLShow[{rottet, {gltet1}, {glclm}, {gltet2}}, 
        PlotRange -> {{-1.8, 1.8}, {-1.8, 1.8}, {-1.8, 
              1.8}}, AnimateFrames -> True];