LiveGraphics3D Demo

Eric W. Weisstein
Wolfram Research, Inc.

Introduction

This package contains demonstration routines for using the package LiveGraphics3D.m.

Initialization

<< LiveGraphics3D`

WriteLiveForm: Sphere

WriteLiveForm["sphere.m", Show[Graphics3D[Sphere[]]]]

This creates the file "sphere.m" in your default directory.

NonIntersectingPolygons: Cube 3-Compound

cube[
        s_:  1] := {Polygon[{{s, s, s}, {-s, s, s}, {-s, -s, 
              s}, {s, -s, s}}], 
        Polygon[{{s, s, s}, {s, -s, s}, {s, -s, -s}, {s, 
              s, -s}}], 
        Polygon[{{s, s, s}, {s, s, -s}, {-s, s, -s}, {-s, s, 
              s}}], Polygon[{{-s, s, s}, {-s, 
              s, -s}, {-s, -s, -s}, {-s, -s, s}}], 
        Polygon[{{-s, -s, -s}, {-s, s, -s}, {s, 
              s, -s}, {s, -s, -s}}], 
        Polygon[{{-s, -s, 
              s}, {-s, -s, -s}, {s, -s, -s}, {s, -s, 
              s}}]}

Rot[m_, x_List] := 
      Module[{i, j}, 
Table[
          Table[m . x[[j]][[i]], {i, Length[x[[j]]]}], {j, 
            Length[x]}]
]

rotx[
        x_] := {{1, 0, 0}, {0, Cos[x], Sin[x]}, {0, -Sin[x], 
          Cos[x]}}
roty[
        x_] := {{Cos[x], 0, -Sin[x]}, {0, 1, 0}, {Sin[x], 0, 
          Cos[x]}}
rotz[
        x_] := {{Cos[x], Sin[x], 0}, {-Sin[x], Cos[x], 0}, {0, 0, 
          1}}

Cube3Compound := 
      Module[{c1, c2, c3, q = 45 Degree, 
          c = cube[1. ] /. Polygon :> Identity}, 
        c1 = Map[Polygon, Rot[rotx[q], c]]; 
c2 = 
          Map[Polygon, Rot[roty[q], c]]; 
c3 = 
          Map[Polygon, Rot[rotz[q], c]]; 
{c1, c2, 
          c3}
]

Show[Graphics3D[Cube3Compound]]

Show[
DropInnerPolygons[
        NonIntersectingPolygons[
Graphics3D[
            Cube3Compound]]]
]

WriteLiveAnimationForm: Cubical Billiards

\(BilliardMovie[s_, p0_List, c_, opts___] := 
      Module[{p = Append[p0, p0[\([1]\)]], l = 0, i = 1, j, ll, lu, 
          v = p0[\([1]\)], frame}, 
	
        ll = Table[
            Sqrt[\((p[\([j + 1]\)] - p[\([j]\)])\) . \((p[\([j + 1]\)] - 
                    p[\([j]\)])\)], {j, Length[p] - 1}]; 
	
        ltot = Plus @@ ll; 
	
        lu = Table[\((p[\([j + 1]\)] - p[\([j]\)])\)/ll[\([j]\)], {j, 
              Length[p] - 1}]; 
	
        frame = {Show[Graphics3D[{c, PointSize[ .05], Point[v]}], 
              Boxed -> False, opts]}; 
	
        While[l < ltot, 
		If[
            l < Sum[ll[\([j]\)], {j, i}], 
			v += 
              s\ lu[\([i]\)], 
			\(i++\); 
            v = p[\([i]\)] + 
                lu[\([i]\)] \((s - 
                      Sqrt[\((p[\([i]\)] - v)\) . \((p[\([i]\)] - 
                              v)\)])\);
		]; 
		l += s; 
		AppendTo[
            frame, Show[Graphics3D[{c, PointSize[ .05], Point[v]}], 
              Boxed -> False, opts]];
	]; 
	
        frame
]
\)
\(\(CubePathVerts = {{0, 2, 2}, {1, 3, 1}, {2, 2, 0}, {3, 1, 1}, {2, 0, 
              2}, {1, 1, 3}}/3;\)
\)
\(CubePath := 
      Module[{p = CubePathVerts}, Line[Append[p, p[\([1]\)]]]]
\)
\(\(CubeEdges := {
	
          Table[Line[{{x, 0, 0}, {x, 0, 1}, {x, 1, 1}, {x, 1, 0}, {x, 0, 
                  0}}], {x, 0, 1, 1/3}], 
Table[
            Line[{{0, y, 0}, {0, y, 1}, {1, y, 1}, {1, y, 0}, {0, y, 
                  0}}], {y, 0, 1, 1/3}], 
          Table[Line[{{0, 0, z}, {0, 1, z}, {1, 1, z}, {1, 0, z}, {0, 0, 
                  z}}], {z, 0, 1, 1/3}]
};\)
\)
\(\(CubeEdges := {
Table[
            Line[{{x, y, 0}, {x, y, 1}}], {x, 0, 1}, {y, 0, 
              1}], 
Table[
            Line[{{0, 0, z}, {1, 0, z}, {1, 1, z}, {0, 1, z}, {0, 0, 
                  z}}], {z, 0, 1}], 
Table[
            Line[{{x, 1/3, 1/3}, {x, 1/3, 2/3}, {x, 2/3, 2/3}, {x, 2/3, 
                  1/3}, {x, 1/3, 1/3}}], {x, 0, 1}], 
Table[
            Line[{{1/3, y, 1/3}, {1/3, y, 2/3}, {2/3, y, 2/3}, {2/3, y, 
                  1/3}, {1/3, y, 1/3}}], {y, 0, 1}], 
Table[
            Line[{{1/3, 1/3, z}, {1/3, 2/3, z}, {2/3, 2/3, z}, {2/3, 1/3, 
                  z}, {1/3, 1/3, z}}], {z, 0, 1}]
};\)
\)
\(\(cCube = {CubeEdges, 
	{Thickness[ .015], 
            CubePath}, 
	{PointSize[ .03], 
            Point /@ CubePathVerts}
};\)\)

\(WriteLiveAnimationForm["billiards.m", 
BilliardMovie[ .1, CubePathVerts, 
        cCube, 
ViewPoint -> {0.99, \ 0.96, \ 
            3.09}, 
ViewVertical -> {\(-0.06\), \ 
            0.96, \ \(-0.28\)}, 
PlotRange -> {{\(- .1\), 
              1.1}, {\(- .1\), 1.1}, {\(- .1\), 
              1.1}}]
]\)

This creates the file "billiards.m" in your default directory.