(***********************************************************************
Mathematica-Compatible Notebook
This notebook can be used on any computer system with Mathematica 4.0,
MathReader 4.0, or any compatible application. The data for the notebook
starts with the line containing stars above.
To get the notebook into a Mathematica-compatible application, do one of
the following:
* Save the data starting with the line of stars above into a file
with a name ending in .nb, then open the file inside the application;
* Copy the data starting with the line of stars above to the
clipboard, then use the Paste menu command inside the application.
Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode. Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).
NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the
word CacheID, otherwise Mathematica-compatible applications may try to
use invalid cache data.
For more information on notebooks and Mathematica-compatible
applications, contact Wolfram Research:
web: http://www.wolfram.com
email: info@wolfram.com
phone: +1-217-398-0700 (U.S.)
Notebook reader applications are available free of charge from
Wolfram Research.
***********************************************************************)
(*CacheID: 232*)
(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[ 54780, 1647]*)
(*NotebookOutlinePosition[ 129965, 4294]*)
(* CellTagsIndexPosition[ 129894, 4288]*)
(*WindowFrame->Normal*)
Notebook[{
Cell[TextData[{
"The ",
Cell[BoxData[
\(TraditionalForm\`Mathematica\^\[RegisteredTrademark]\)]],
" ",
"Journal"
}], "OnlineHeader"],
Cell[CellGroupData[{
Cell["Luge Ride", "Title",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[StyleBox["Robert Rudd",
Evaluatable->False,
AspectRatioFixed->True,
FontWeight->"Bold",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}]], "Subtitle",
Evaluatable->False,
AspectRatioFixed->True,
FontWeight->"Bold",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData[StyleBox["rrudd@aisvt.bfg.com",
Evaluatable->False,
AspectRatioFixed->True,
FontSize->12,
FontSlant->"Italic"]], "Subtitle",
Evaluatable->False,
AspectRatioFixed->True],
Cell["\<\
A model of a luge run is constructed. A slider races down the luge run at 60 \
miles an hour. A camera capable of generating the illusion of passing through \
a scene is designed. Finally, an animation from the perspective of the slider \
is presented.\
\>", "Abstract"],
Cell[CellGroupData[{
Cell["Introduction", "SectionFirst"],
Cell[TextData[{
"This notebook presents functions which will allow the reader to experience \
a 60-mile-per-hour luge ride. A luge is a sled which slides down an \
ice-covered cement structure on a mountain slope. High banked corners keep \
the slider in the track and allow high speeds to be maintained. The view the \
slider has during a run is quite exhilarating. Since he is on his back, with \
his neck nearly straight to minimize wind resistance, only his feet are \
visible as he takes high-",
StyleBox["G",
FontSlant->"Italic"],
" turns. In this notebook, we will construct a model of a luge run, slider, \
and surroundings. We will place a video camera on the slider during a run and \
provide an animation of the experience."
}], "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell["The Luge World", "Section"],
Cell["\<\
The luge world consists of the luge run, slider, and Christmas tree \
which are all three dimensional. A two dimensional base and mountain provide \
background.\
\>", "Text"],
Cell[CellGroupData[{
Cell["The Luge Run", "Subsection"],
Cell["\<\
A luge run is an ice-covered cement structure. A steel-bladed sled, \
with a slider on top, glides down. Speeds of up to 80 miles an hour are \
possible. The run is flat on the bottom and curves up to near vertical in the \
corners.\
\>", "Text"],
Cell[TextData[{
"Our luge run will be flat on the bottom and curve up parabolically in the \
corners. The three-part function ",
StyleBox["channel", "InlineInput"],
" is used to describe this profile."
}], "Text"],
Cell[BoxData[{
\(channel[x_ /; \(-b\) \[LessEqual] x \[LessEqual] b] := 0.0\), "\n",
\(channel[x_ /; x < \(-b\)] := h\ \((\(x + b\)\/\(a - b\))\)\^2\), "\n",
\(channel[x_ /; x > b] :=
h\ \((\(x - b\)\/\(a - b\))\)\^2\)}], "InputOnly"],
Cell[TextData[{
"In this function, the ",
StyleBox["b", "InlineInput"],
" parameter gives the width of the horizontal portion of the run, the ",
StyleBox["h", "InlineInput"],
" parameter gives the height, and the ",
StyleBox["a", "InlineInput"],
" parameter sets the slope. Here is a plot of the profile with the \
parameters given in units of feet."
}], "Text"],
Cell[BoxData[{
\(b = 1. ; \), "\n",
\(h = 8. ; \), "\n",
\(a = 4.5; \)}], "InputOnly"],
Cell[BoxData[
\(\(Plot[channel[x], {x, \(-a\), a}];\)\)], "InputOnly"],
Cell[TextData[{
"We will generate our three-dimensional luge run by extruding this shape \
along a sinusoidal path. An amplitude, ",
StyleBox["ampy", "InlineInput"],
", of 25 feet with a period, ",
StyleBox["perx", "InlineInput"],
", of 125 feet gives a corner with a typical radius of curvature. "
}], "Text"],
Cell[BoxData[{
\(\(perx = 125. ;\)\), "\n",
\(\(ampy = 25. ;\)\)}], "InputOnly"],
Cell[TextData[{
"The function ",
StyleBox["path", "InlineInput"],
" provides the backbone for extrusion."
}], "Text"],
Cell[BoxData[
\(path[x_] := {x, ampy\ Sin[\(2\ \[Pi]\ x\)\/perx], 0}\)], "InputOnly"],
Cell[TextData[{
"We want our extrusion to occur normal to the path so we need the angle \
about the vertical axis. This is given by differentiating ",
StyleBox["path", "InlineInput"],
"."
}], "Text"],
Cell[BoxData[
RowBox[{\(yawangle[x_]\), ":=",
RowBox[{"ArcTan", "[",
RowBox[{"-",
RowBox[{
RowBox[{
SuperscriptBox["path", "\[Prime]",
MultilineFunction->None], "[", "x", "]"}],
"\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}]}],
"]"}]}]], "InputOnly"],
Cell[TextData[{
"The rotation matrix is provided by ",
StyleBox["RotationMatrix3D", "InlineInput"],
" (from ",
StyleBox["Geometry`Rotations`", "InlineInput"],
")"
}], "Text"],
Cell[BoxData[
\(Needs["\"]\)], "InputOnly"],
Cell[TextData[{
"The vector which forms the luge run is constructed by rotating the profile \
",
StyleBox["channel", "InlineInput"],
" through the angle ",
StyleBox["yawangle", "InlineInput"],
" and translating by the ",
StyleBox["path", "InlineInput"],
" function. The corners are made higher on one side than the other by a \
translation in the argument to ",
StyleBox["channel", "InlineInput"],
". The run sides are reduced by amplitude modulating the function in \
between the corners. This all occurs in the function ",
StyleBox["run", "InlineInput"],
"."
}], "Text"],
Cell[BoxData[
\(\(run[x_, y_] :=
path[x] +
RotationMatrix3D[0, 0, yawangle[x]] . {0, a\ y,
1\/3\ \((1 - .375\ Cos[\(4\ \[Pi]\ x\)\/perx])\)\ channel[
a\ y + 2\ Sin[\(2\ \[Pi]\ x\)\/perx]]};\)\)], "InputOnly"],
Cell["\<\
The color of the luge run is generally blue but the constant \
passage of the sled blades cracks the ice. These small cracks make it whiter \
where the sleds pass most often. A function which gives the common line is \
given below.\
\>", "Text"],
Cell[BoxData[
\(pos[x_, dy_] :=
run[x, dy + .875\ Sin[\(2\ \[Pi]\ x\)\/perx]]\)], "InputOnly"],
Cell[TextData[{
"In this function, ",
StyleBox["dy", "InlineInput"],
" is a distance normal to the path that will be useful in determining the \
roll of the sled later on. "
}], "Text"],
Cell[TextData[{
"Our run color will be given by the function ",
StyleBox["Hue", "InlineInput"],
" where the saturation is decreased as the position moves away from the \
common line. This distance is given with the aid of the Pythagorean theorem."
}], "Text"],
Cell[BoxData[
\(length[p2_, p1_] := \@\(\((p2 - p1)\) . \((p2 - p1)\)\)\)], "InputOnly"],
Cell[TextData[{
"The track color function, ",
StyleBox["tcf", "InlineInput"],
", is computed as:"
}], "Text"],
Cell[BoxData[
\(tcf[x_, y_] :=
Hue[ .65, .09\ length[run[x, y], pos[x, 0]], 1]\)], "InputOnly"],
Cell[TextData[{
"We will find it necessary later on to set the colors and edge widths of \
the different graphics. The function ",
StyleBox["editgr", "InlineInput"],
" inserts graphic directives in graphics objects."
}], "Text"],
Cell[BoxData[
\(editgr[gr_, dir_List] :=
Fold[Insert[#1, #2, {1, 1}] &, gr, dir]\)], "InputOnly"],
Cell["Here is a plot of the track.", "Text"],
Cell[BoxData[
\(\(track =
editgr[ParametricPlot3D[
Append[run[x, y], tcf[x, y]], {x, 0, \(-1.6\)\ perx}, {y, \(-1\),
1}, PlotPoints \[Rule] {65, 17}, Lighting \[Rule] False,
DisplayFunction \[Rule] Identity], {EdgeForm[
AbsoluteThickness[1], Black]}];\)\)], "InputOnly"],
Cell[BoxData[
\(\(Show[track, ViewPoint \[Rule] {2, 2, .5}, PlotRange \[Rule] All,
AxesLabel \[Rule] {"\", "\", "\"},
DisplayFunction \[Rule] $DisplayFunction];\)\)], "Input",
AspectRatioFixed->True],
Cell["\<\
The animation occurs over one cycle of the track but two cycles are \
included in the graphics since the next cycle can be seen from the \
first.\
\>", "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell["The Base", "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
"The track sits on a base. Its color is ",
StyleBox["White", "InlineInput"],
" (from the package ",
StyleBox["Graphics`Colors`", "InlineInput"],
") to suggest snow."
}], "Text"],
Cell[BoxData[
\(\(Needs["\"];\)\)], "InputOnly"],
Cell["The base is a plane.", "Text"],
Cell[BoxData[
\(\(base =
editgr[ParametricPlot3D[{x, y, \(- .001\)}, {x,
0, \(-300\)}, {y, \(-187.5\), 187.5},
PlotPoints \[Rule] {33, 2},
DisplayFunction \[Rule] Identity], {White,
EdgeForm[AbsoluteThickness[1], Black]}];\)\)], "InputOnly"]
}, Closed]],
Cell[CellGroupData[{
Cell["The Mountain", "Subsection"],
Cell["\<\
The mountain appears in the background. It is two dimensional. The \
bottom of the mountain is green while the top is a snow-covered white. The \
graphics are generated in two steps. First, the mountain up to the snow line \
is generated. Then the polygons below the snow-covered areas are replaced \
with two polygons. The first is the original while the second is white and \
fills out the distance to the skyline.\
\>", "Text"],
Cell["\<\
The skyline is a two-dimensional amplitude-modulated sinusoid with \
a height of 80. \
\>", "Text"],
Cell[BoxData[
\(\(mhgt = 78. ;\)\)], "InputOnly"],
Cell[BoxData[
\(skyline[y_] :=
N[\(1\/3.6\) \((mhgt\ \((1 +
Cos[\(-\(\(\[Pi]\ y\)\/300\)\)])\)\ \((1 + .8\ \
Cos[\(-\(\(2\ \[Pi]\ y\)\/\(300\/4\)\)\)])\))\)]\)], "InputOnly"],
Cell["\<\
The mountain is snow covered starting at about the following \
height.\
\>", "Text"],
Cell[BoxData[
\(\(snowhgt = 48. ;\)\)], "InputOnly"],
Cell["\<\
We will first define a function that gives the height to the \
snowline. It is the skyline height up to the snow height and the snow height \
plus a random number after that.\
\>", "Text"],
Cell[BoxData[{
\(mtnhgt[y_] :=
skyline[y] /; N[skyline[y]] \[LessEqual] snowhgt\), "\n",
\(mtnhgt[y_] :=
snowhgt + 8. \ \((Random[] - 1. )\) /;
N[skyline[y]] > snowhgt\)}], "InputOnly"],
Cell[TextData[{
"The color below the snow line is ",
StyleBox["OliveDrab", "InlineInput"],
" (from the package ",
StyleBox["Graphics`Colors`", "InlineInput"],
")."
}], "Text"],
Cell[BoxData[
\(\(mcf = OliveDrab;\)\)], "InputOnly"],
Cell[TextData[{
"The replacement rule ",
StyleBox["snowline", "InlineInput"],
" looks for a polygon that does not reach the skyline and adds a white \
polygon that does."
}], "Text"],
Cell[BoxData[
\(\(snowline =
Polygon[{p1_, p2_, p3_, p4_}] \[RuleDelayed] {mcf,
Polygon[{p1, p2, p3, p4}], White,
Polygon[{{p1\[LeftDoubleBracket]1\[RightDoubleBracket],
p1\[LeftDoubleBracket]2\[RightDoubleBracket],
p4\[LeftDoubleBracket]3\[RightDoubleBracket]}, {p2\
\[LeftDoubleBracket]1\[RightDoubleBracket],
p2\[LeftDoubleBracket]2\[RightDoubleBracket],
p3\[LeftDoubleBracket]3\[RightDoubleBracket]}, {p3\
\[LeftDoubleBracket]1\[RightDoubleBracket],
p3\[LeftDoubleBracket]2\[RightDoubleBracket],
skyline[
p3\[LeftDoubleBracket]2\[RightDoubleBracket]]}, {p4\
\[LeftDoubleBracket]1\[RightDoubleBracket],
p4\[LeftDoubleBracket]2\[RightDoubleBracket],
skyline[
p4\[LeftDoubleBracket]2\[RightDoubleBracket]]}}]} /;
N[p3\[LeftDoubleBracket]3\[RightDoubleBracket] <
skyline[p3\[LeftDoubleBracket]2\[RightDoubleBracket]]] ||
N[p4\[LeftDoubleBracket]3\[RightDoubleBracket] <
skyline[
p4\[LeftDoubleBracket]2\[RightDoubleBracket]]];\)\)], \
"InputOnly"],
Cell[BoxData[
\(mtsinai =
editgr[ParametricPlot3D[{\(-300\), y, z\ mtnhgt[y]}, {y, \(-187.5\),
187.5}, {z, 0, 1}, PlotPoints \[Rule] {79, 2},
DisplayFunction \[Rule] Identity], {mcf, EdgeForm[]}] /.
snowline; \)], "InputOnly"],
Cell["Here is a plot of the track, mountain, and base.", "Text"],
Cell[BoxData[
\(Show[track, mtsinai, base, ViewPoint \[Rule] 2\ {1, 1, .5},
Background \[Rule] SkyBlueDeep, PlotRange \[Rule] All,
AxesLabel \[Rule] {"\", "\", "\"},
DisplayFunction \[Rule] $DisplayFunction]; \)], "InputOnly"]
}, Closed]],
Cell[CellGroupData[{
Cell["The Tree", "Subsection"],
Cell["\<\
A Christmas tree is placed on the inside of the second corner to \
give a sense of scale and speed. The tree has a whorl for each year of growth \
and a stump. Both the stump and whorls use cylindrical coordinates in their \
definition.\
\>", "Text"],
Cell[BoxData[
\(cylinder[r_, th_, z_] := {r\ Cos[th], r\ Sin[th], z}\)], "InputOnly"],
Cell[TextData[{
"In this function, ",
StyleBox["r", "InlineInput"],
" is the radius, ",
StyleBox["th", "InlineInput"],
" is the angle about the vertical axis, and ",
StyleBox["z", "InlineInput"],
" is the location along the vertical axis."
}], "Text"],
Cell[TextData[{
"The function ",
StyleBox["whorls", "InlineInput"],
" creates the foliage of the tree. In this function, ",
StyleBox["h", "InlineInput"],
" is the height of the tree in feet, ",
StyleBox["slope", "InlineInput"],
" sets the taper of the individual whorls, ",
StyleBox["offset", "InlineInput"],
" sets the change in diameter from whorl to whorl and ",
StyleBox["pos", "InlineInput"],
" is the overall position. The height should be two or greater."
}], "Text"],
Cell[BoxData[
\(whorls[h_, slope_, offset_, pos_] :=
editgr[ParametricPlot3D[
Evaluate[
Table[pos + {0, 0, h} +
cylinder[slope\ z - offset\ i, th, z - i], {i, 0,
h - 2}]], {th, 0, 2\ \[Pi]}, {z, \(-1\), 0},
PlotPoints \[Rule] {13, 2},
DisplayFunction \[Rule] Identity], {ForestGreen,
EdgeForm[AbsoluteThickness[1], Black]}]; \)], "InputOnly"],
Cell["The stump is formed by a cylinder.", "Text"],
Cell[BoxData[
\(stump[h_, pos_] :=
editgr[ParametricPlot3D[
pos + cylinder[ .035\ h, th, z], {z, 0, 1}, {th, 0, 2\ \[Pi]},
PlotPoints \[Rule] {2, 13},
DisplayFunction \[Rule] Identity], {Wheat,
EdgeForm[AbsoluteThickness[1], Black]}]; \)], "InputOnly"],
Cell[TextData[{
"The ",
StyleBox["stump", "InlineInput"],
" and ",
StyleBox["whorls", "InlineInput"],
" are combined into the function ",
StyleBox["xmastree", "InlineInput"],
". The origin of the tree is at the bottom of the stump and is given by ",
StyleBox["pos", "InlineInput"],
"."
}], "Text"],
Cell[BoxData[
\(xmastree[h_, slope_, offset_, pos_] :=
Show[stump[h, pos], whorls[h, slope, offset, pos],
Lighting \[Rule] False]\)], "InputOnly"],
Cell["\<\
For the luge ride, we will have a seven foot tree at the inside of \
the second corner. \
\>", "Text"],
Cell[BoxData[
\(tree = xmastree[7, .55, .3, {\(-80\), 7, 0}]; \)], "InputOnly"],
Cell["Here is a plot of our tree.", "Text"],
Cell[BoxData[
\(Show[tree, ViewPoint \[Rule] 3\ {1, .2, .1}, Axes \[Rule] False,
Boxed \[Rule] False,
DisplayFunction \[Rule] $DisplayFunction]; \)], "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell["The Slider", "Subsection"],
Cell["\<\
A luge rider lies feet first with his back on the sled. The rider \
steers by rolling his toes in the direction he wishes to go. The foot is \
pointed to minimize wind resistance. Only the feet and lower portions of the \
legs are visible during the run.\
\>", "Text"],
Cell[TextData[{
"The graphics of the slider consist of cylinder for each leg and an \
irregularly shaped polygon for each foot. The function ",
StyleBox["limb", "InlineInput"],
" produces a leg using the ",
StyleBox["cylinder", "InlineInput"],
" function. "
}], "Text"],
Cell[BoxData[
\(limb =
ParametricPlot3D[
cylinder[ .25 - \( .125\ z\)\/3, th,
z], {th, \[Pi]\/4, \(7\ \[Pi]\)\/4}, {z, \(- .3\), 3},
PlotPoints \[Rule] {9, 3},
DisplayFunction \[Rule] Identity]; \)], "InputOnly"],
Cell["\<\
If you trace the outline of your foot on a piece of graph paper, you might \
get the following set of points.\
\>", "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[BoxData[
\(ftpts = .016\ {{0, \(-8\), 0}, {0, 8, 0}, {\(-25\), 11, 0}, {\(-32\),
11, 0}, {\(-39\), 8, 0}, {\(-44\), 4, 0}, {\(-46\), \(-2\),
0}, {\(-46\), \(-4\), 0}, {\(-42\), \(-7\), 0}, {\(-32\), \(-8\),
0}, {\(-23\), \(-6\), 0}, {\(-14\), \(-6\), 0}, {0, \(-8\),
0}}; \)], "InputOnly"],
Cell[TextData[{
"These points are used to generate a polygon which is then rotated to point \
the toes and translated to the end of the limb (by the functions ",
StyleBox["RotateShape", "InlineInput"],
" and ",
StyleBox["TranslateShape", "InlineInput"],
" from ",
StyleBox["Graphics`Shapes`", "InlineInput"],
")."
}], "Text"],
Cell[BoxData[
\(Needs["\"]; \)], "InputOnly"],
Cell[BoxData[
\(foot =
TranslateShape[
RotateShape[
Graphics3D[
Polygon[ftpts]], \[Pi]\/2, \(-\(\[Pi]\/4\)\), \(-\(\[Pi]\/2\)\)], \
{0, 0, 3.01}]; \)], "InputOnly"],
Cell[TextData[{
"The left leg is created by combining the ",
StyleBox["foot", "InlineInput"],
" and ",
StyleBox["limb", "InlineInput"],
". The leg is then rotated by the angle ",
StyleBox["lroll", "InlineInput"],
" (to suggest steering of the luge) and then translating it off center. \
Mirroring the left leg using ",
StyleBox["AffineShape", "InlineInput"],
" (from ",
StyleBox["Graphics`Shapes`", "InlineInput"],
") creates the right leg. The right and left legs are combined and colored \
in the function ",
StyleBox["legs", "InlineInput"],
". "
}], "Text"],
Cell[BoxData[{
\(lleg[lroll_] =
TranslateShape[
RotateShape[{limb, foot}, lroll, 0, 0], {0, .375, 0}]; \), "\n",
\(rleg[lroll_] =
AffineShape[lleg[\(-lroll\)], {1, \(-1\), 1}]; \), "\n",
\(legs[lroll_] =
editgr[Show[
RotateShape[
Flatten[{lleg[lroll],
rleg[lroll]}], \(-\(\[Pi]\/2\)\), \[Pi]\/2, \
\(-\(\[Pi]\/2\)\)], DisplayFunction \[Rule] Identity], {Firebrick,
EdgeForm[AbsoluteThickness[1], Black]}]; \)}], "InputOnly"],
Cell[TextData[{
"In the animation, the legs will require full-motion capability in position \
and attitude. The function ",
StyleBox["slider", "InlineInput"],
" positions the legs to ",
StyleBox["spos", "InlineInput"],
" with the angles of ",
StyleBox["roll", "InlineInput"],
", ",
StyleBox["pt", "InlineInput"],
" (pitch), and yaw. "
}], "Text"],
Cell[BoxData[
\(slider[spos_, lroll_, roll_, pt_, yaw_] :=
TranslateShape[
RotateShape[
RotateShape[
RotateShape[legs[lroll], 0, \(-roll\),
0], \[Pi]\/2, \(-pt\), \(-\(\[Pi]\/2\)\)], \(-yaw\), 0, 0],
spos]\)], "InputOnly"],
Cell["Here is a plot of the slider at his origin.", "Text"],
Cell[BoxData[
\(Show[slider[{0, 0, 0}, 0, 0, 0, 0],
DisplayFunction \[Rule] $DisplayFunction,
AxesLabel \[Rule] {"\", "\", "\"},
Lighting \[Rule] False, ViewPoint \[Rule] 3\ { .5, 1, 1}]; \)], "Input"],
Cell["\<\
Since the backsides of the legs are not visible during the \
animation, a few polygons were saved by only plotting three quarters of the \
perimeter.\
\>", "Text"]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell["The Trajectories", "Section"],
Cell[TextData[{
"In this section we will calculate the trajectory of the slider and camera \
as a function of time. Three positions (",
StyleBox["x",
FontSlant->"Italic"],
", ",
StyleBox["y",
FontSlant->"Italic"],
", ",
StyleBox["z",
FontSlant->"Italic"],
") and three attitudes (roll, pitch, and yaw) are required for a complete \
trajectory description. The origin of the luge is at the center of mass of \
the luge. The ",
StyleBox["x",
FontSlant->"Italic"],
" axis of the luge is tangent to the path the luge takes. The luge ",
StyleBox["y",
FontSlant->"Italic"],
" axis is normal to the ",
StyleBox["x",
FontSlant->"Italic"],
" axis and tangent to the track. The luge ",
StyleBox["z",
FontSlant->"Italic"],
" axis is orthogonal to the luge ",
StyleBox["x",
FontSlant->"Italic"],
" and ",
StyleBox["y",
FontSlant->"Italic"],
" axes. The roll, pitch, and yaw angles describe the relationship between \
the luge and the global (luge world) coordinate systems. A climbing right \
hand turn gives positive attitudes. A level luge traveling along the global \
",
StyleBox["x",
FontSlant->"Italic"],
" axis has an attitude of zero. The camera and slider share attitudes but \
are offset along the luge ",
StyleBox["z",
FontSlant->"Italic"],
" axis."
}], "Text"],
Cell["\<\
We will first calculate the trajectory at track level. Using this \
trajectory, we will then calculate the position of the camera by applying the \
appropriate translations and rotations. The transformation from global to \
sled coordinates occurs via a series of Euler angle transformation in yaw, \
pitch, and roll, respectively. The sliders position is then determined by \
interpolating between the two.\
\>", "Text"],
Cell[TextData[{
"Our luge run is defined in spatial coordinates but we need temporal \
trajectory functions for the animation. We will first calculate the path \
length of the luge at track level by numerically integrating the position \
function (in ",
StyleBox["x",
FontSlant->"Italic"],
"). The Pythagorean theorem is applied repeatedly to points along the path \
and the individual lengths are summed. "
}], "Text"],
Cell[BoxData[{
\(ptsx =
N[Table[pos[x, 0], {x, 0, \(-perx\), \(-\(perx\/50. \)\)}]]; \), "\n",
\(pathlength = \[Sum]\+\(i = 2\)\%\(Length[ptsx]\)length[
ptsx\[LeftDoubleBracket]i\[RightDoubleBracket],
ptsx\[LeftDoubleBracket]i - 1\[RightDoubleBracket]]\)}], "InputOnly"],
Cell["\<\
A typical velocity during a luge run is 60 miles per hour which is \
88 feet per second.\
\>", "Text"],
Cell[BoxData[
\(vel = 88. ; \)], "InputOnly"],
Cell["\<\
At this velocity, the time to traverse one cycle of the luge track \
(and one cycle of the animation) can be calculated.\
\>", "Text"],
Cell[BoxData[
\(tmax := pathlength\/vel\)], "InputOnly"],
Cell[TextData[{
"We will calculate the ",
StyleBox["x",
FontSlant->"Italic"],
" position of the slider at 72 position increments of ",
StyleBox["deltap", "InlineInput"],
" and time increments of ",
StyleBox["deltat", "InlineInput"],
"."
}], "Text"],
Cell[BoxData[{
\(npts = 72; \), "\n",
\(deltap = \(vel\ tmax\)\/npts\), "\n",
\(deltat = deltap\/vel\)}], "Input"],
Cell[TextData[{
" The Pythagorean theorem is used to calculate the ",
StyleBox["x",
FontSlant->"Italic"],
" position for a constant velocity."
}], "Text"],
Cell[BoxData[{
\(xn[0] = 0; \), "\n",
\(xn[n_] := \(xn[n] =
x /. FindRoot[
length[pos[x, 0], pos[xn[n - 1], 0]] ==
deltap, {x, {xn[
n - 1], \(pos[xn[n - 1] - deltap,
0]\)\[LeftDoubleBracket]1\[RightDoubleBracket]}}]\)\)}], \
"Input"],
Cell[TextData[{
"The ",
StyleBox["x",
FontSlant->"Italic"],
" position is transformed from index based to time based using an \
interpolation function. The ",
StyleBox["y",
FontSlant->"Italic"],
" and ",
StyleBox["z",
FontSlant->"Italic"],
" position functions are also calculated. "
}], "Text"],
Cell[BoxData[{
\({tposx, tposy, tposz} =
Table[Interpolation[
Table[N[{n\ deltat, \(pos[xn[n], 0]\)\[LeftDoubleBracket]
i\[RightDoubleBracket]}], {n, 0, npts + 10}],
InterpolationOrder \[Rule] 1], {i, 1, 3}]; \), "\n",
\(tpos[t_] = {tposx[t], tposy[t], tposz[t]}; \)}], "InputOnly"],
Cell[TextData[{
"Here is a plot of the track level position functions (",
StyleBox["x",
FontSlant->"Italic"],
", ",
StyleBox["y",
FontSlant->"Italic"],
", ",
StyleBox["z",
FontSlant->"Italic"],
") in black, blue, and red respectively."
}], "Text"],
Cell[BoxData[
\(Plot[Evaluate[tpos[t]], {t, 0, tmax},
PlotStyle \[Rule] {GrayLevel[0], Hue[ .65], Hue[1]},
PlotRange \[Rule] All]; \)], "Input"],
Cell[TextData[{
"The attitude of the sled is determined by its contact with the track. The \
sled has length in the fore/aft and side to side directions. Therefore, the \
angle of the sled is calculated as the difference in the sled\
\[CloseCurlyQuote]s position rather than the instantaneous slope of the \
track. The luge\[CloseCurlyQuote]s fore/aft (",
StyleBox["x",
FontSlant->"Italic"],
") and side to side (",
StyleBox["y",
FontSlant->"Italic"],
") widths are given below."
}], "Text"],
Cell[BoxData[{
\(wfa = 4. ; \), "\n",
\(wss = 1. ; \)}], "InputOnly"],
Cell[TextData[{
"The attitudes are calculated using vector geometry. For the yaw and pitch \
angles, a vector which runs the length of the luge ",
StyleBox["x",
FontSlant->"Italic"],
" axis is created at track level. This vector is projected to the \
horizontal. The angle the projected vector makes with the luge world ",
StyleBox["x",
FontSlant->"Italic"],
" axis gives the yaw angle. The pitch angle is the angle between the luge \
",
StyleBox["x",
FontSlant->"Italic"],
" axis with the projected vector. For the roll angle, a vector which runs \
the width of the luge ",
StyleBox["y",
FontSlant->"Italic"],
" axis is created. Roll is given by the angle this vector makes with the \
horizontal."
}], "Text"],
Cell[BoxData[
\(yawx[p_, wfa_] :=
ArcTan[\((\((#1\ {1, 1, 0})\)\[LeftDoubleBracket]2\[RightDoubleBracket]\
\/\((#1\ {1, 1, 0})\)\[LeftDoubleBracket]1\[RightDoubleBracket] &)\)[
pos[p + wfa\/2, 0] - pos[p - wfa\/2, 0]]]\)], "InputOnly"],
Cell[BoxData[
\(ptx[p_, wfa_] :=
ArcTan[\((\(-\(#1\[LeftDoubleBracket]3\[RightDoubleBracket]\/\@\(\((#1\ \
{1, 1, 0})\) . \((#1\ {1, 1, 0})\)\)\)\) &)\)[
pos[p + wfa\/2, 0] - pos[p - wfa\/2, 0]]]\)], "InputOnly"],
Cell[BoxData[
\(rollx[p_, wss_] :=
ArcTan[\((#1 . {0, 0, 1}\/\@\(\((#1\ {1, 1, 0})\) . \((#1\ {1, 1, 0})\)\
\) &)\)[pos[p, wss\/2] - pos[p, \(-\(wss\/2\)\)]]]\)], "InputOnly"],
Cell[TextData[{
"The attitudes as a function of ",
StyleBox["x",
FontSlant->"Italic"],
" are converted to functions of time by substitution of the ",
StyleBox["x",
FontSlant->"Italic"],
" position."
}], "Text"],
Cell[BoxData[{
\(yawt[t_] = N[yawx[tposx[t], wfa]]; \), "\n",
\(ptt[t_] = N[ptx[tposx[t], wfa]]; \), "\n",
\(rollt[t_] = N[rollx[tposx[t], wss]]; \)}], "InputOnly"],
Cell["\<\
Here is a plot of yaw, pitch, and roll in black, blue, and, red, \
respectively, in units of degrees.\
\>", "Text"],
Cell[BoxData[
\(Plot[{57.3\ yawt[t], 57.3\ ptt[t], 57.3\ rollt[t]}, {t, 0, tmax},
PlotStyle \[Rule] {GrayLevel[0], Hue[ .65], Hue[1]}]; \)], "Input"],
Cell[TextData[{
"The camera position, ",
StyleBox["cpos", "InlineInput"],
", will be located at the midpoint of the sled at 1.25 feet off the track \
surface. A vertical vector of this length is transformed through roll, pitch, \
and yaw rotation matrices (from ",
StyleBox["Geometry`Rotations`", "InlineInput"],
") to obtain the correction ",
StyleBox["dct", "InlineInput"],
" which is added to the surface position."
}], "Text"],
Cell[BoxData[
\(dct[t_] :=
Rotate3D[Rotate3D[
Rotate3D[{0, 0, 1.25}, 0, \(-rollt[t]\), 0], \[Pi]\/2,
ptt[t], \(-\(\[Pi]\/2\)\)], \(-yawt[t]\), 0, 0]; \)], "InputOnly"],
Cell[BoxData[
\(cpos[t_] := dct[t] + tpos[t]; \)], "InputOnly"],
Cell[TextData[{
"The slider\[CloseCurlyQuote]s position, ",
StyleBox["spos", "InlineInput"],
", is midway between the track position and the camera position."
}], "Text"],
Cell[BoxData[
\(spos[t_] := .375\ tpos[t] + .625\ cpos[t]; \)], "InputOnly"],
Cell["\<\
Here is a plot of the track, camera position, and the slider in freeze frame.\
\
\>", "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[BoxData[
\(cposplt =
editgr[ParametricPlot3D[cpos[t], {t, 0, tmax\/3},
PlotPoints \[Rule] 65, DisplayFunction \[Rule] Identity], {Red,
Thickness[ .0035]}]; \)], "InputOnly"],
Cell[BoxData[
\(Show[cposplt, track,
Table[slider[spos[t], 0, rollt[t], ptt[t], yawt[t]], {t, 0, tmax\/3,
tmax\/24}], ViewPoint \[Rule] 2\ { .5, 1, .1},
Lighting \[Rule] False, Axes \[Rule] False, Boxed \[Rule] False,
PlotRange \[Rule] {{\(-37\), 4}, {\(-30\), 4}, All},
DisplayFunction \[Rule] $DisplayFunction]; \)], "InputOnly"]
}, Closed]],
Cell[CellGroupData[{
Cell["The Camera", "Section"],
Cell["\<\
This section defines a function which behaves like a hand-held \
video camera. The camera captures an image from the perspective of the viewer \
and has the ability to move throughout a scene. For our animation, the camera \
moves with the slider.\
\>", "Text"],
Cell[TextData[{
"Figure 1 illustrates our method of designing this camera. The box shown \
represents ",
StyleBox["Mathematica",
FontSlant->"Italic"],
"\[CloseCurlyQuote]s bounding box for three-dimensional graphics. At the \
plane ",
Cell[BoxData[
\(TraditionalForm\`x = 0\)]],
" is a red circle which represents the lens of our camera. Inscribed in \
this lens is a blue rectangle. This will represent our viewport or the area \
where the image of interest will occur. You may wish to interpret this \
viewport as your monitor."
}], "Text"],
Cell[TextData[{
"Also shown is ",
StyleBox["Mathematica",
FontSlant->"Italic"],
"\[CloseCurlyQuote]s viewpoint (green) in a global or user coordinate \
system. Dashed lines connect the viewpoint to the corners of the viewport and \
the back corners of the bounding box. The tetrahedron from the back corner of \
the bounding box to the viewport is our view volume. Anything within this \
volume will be visible in the viewport. This represents our camera."
}], "Text"],
Cell[BoxData[
\(\(figure1;\)\)], "Input"],
Cell["\<\
Our camera is fixed in space. If we had decided instead to move our \
viewpoint, the clipping planes defined by the bounding box could sometimes \
delete portions of the image we wish to see. Instead motion is provided by \
moving the objects we wish to view to the viewport and providing the proper \
angular orientation. The viewer sitting at a computer monitor will not be \
able to tell the difference.\
\>", "Text"],
Cell[TextData[{
"A simple example shows how the camera operates. Our example will have two \
graphics objects. One will be a rectangle the size of the viewport at ",
Cell[BoxData[
\(TraditionalForm\`x = 0\)]],
". The other will be a rectangle at the far end of the bounding box. These \
planes represent the front and rear clipping planes, respectively. With our \
camera properly oriented, the front clipping plane should just eclipse the \
back clipping plane."
}], "Text"],
Cell[TextData[{
"Our rectangles are dependant on the location of the viewpoint. The \
viewpoint, ",
StyleBox["vp", "InlineInput"],
", is defined to be on the ",
StyleBox["x",
FontSlant->"Italic"],
" axis but the ",
StyleBox["x",
FontSlant->"Italic"],
" location, ",
StyleBox["xvp", "InlineInput"],
", can be anywhere greater than zero. "
}], "Text"],
Cell[BoxData[
\(xvp = .5; \)], "InputOnly"],
Cell[BoxData[
\(vp := {xvp, 0, 0}; \)], "InputOnly"],
Cell[TextData[{
"To give a visually pleasing display, we will choose the aspect ratio of \
the viewport to be the ",
StyleBox["GoldenRatio", "InlineInput"],
". We can now define the lines connecting the viewpoint to the corner of \
the viewport as a function of position along the ",
StyleBox["x",
FontSlant->"Italic"],
" axis."
}], "Text"],
Cell[BoxData[{
\(ycp[
x_] := .5\ \((x\ \((xvp\/\(1 + xvp\) - 1)\) +
xvp\/\(1 + xvp\))\); \), "\n",
\(zcp[x_] := ycp[x]\/GoldenRatio; \)}], "InputOnly"],
Cell["Here is the definition of our rectangles.", "Text"],
Cell[BoxData[
\(xcp[x_] :=
Polygon[{{x, \(-ycp[x]\), \(-zcp[x]\)}, {x, ycp[x], \(-zcp[x]\)}, {x,
ycp[x], zcp[x]}, {x, \(-ycp[x]\), zcp[x]}}]; \)], "InputOnly"],
Cell["\<\
Here is a plot of our two rectangles. The blue rectangle represents \
the viewport and the red rectangle represents the rear clipping plane. They \
are located at zero and 10 in this example.\
\>", "Text"],
Cell[BoxData[{
\(xfcp = 0.0; \), "\n",
\(xrcp = \(-9.9\); \)}], "InputOnly"],
Cell[BoxData[
\(demo1 =
Show[WireFrame[Graphics3D[{Hue[1], xcp[xrcp], Hue[ .65], xcp[xfcp]}]],
AxesLabel \[Rule] {"\", "\", "\"},
BoxRatios \[Rule] {1, 1, 1\/GoldenRatio},
ViewPoint \[Rule] {2, 1, 1}, Axes \[Rule] True]; \)], "InputOnly"],
Cell[TextData[{
"Our next step will be to map the display data to be between ",
StyleBox["x",
FontSlant->"Italic"],
" equals zero and minus one. The mapping will occur linearly along a line \
connecting the data to the viewpoint (the line of sight) so as to not alter \
the image in the viewport. The function ",
StyleBox["AffineShape", "InlineInput"],
" was used as a template for our function called ",
StyleBox["LOSAffineShape", "InlineInput"],
". To save execution time, only points with ",
StyleBox["x",
FontSlant->"Italic"],
" values less than zero are scaled. "
}], "Text"],
Cell[BoxData[
\(LOSAffineShape[shape_, scale_, xvp_] :=
Block[{tscale, txvp, ff}, tscale = N[scale]; txvp = N[xvp];
ff[pt_ /; N[
pt\[LeftDoubleBracket]1\[RightDoubleBracket]] \[LessEqual]
0.0] := \
{pt\[LeftDoubleBracket]1\[RightDoubleBracket]\/tscale, \(pt\
\[LeftDoubleBracket]2\[RightDoubleBracket]\ \((pt\[LeftDoubleBracket]1\
\[RightDoubleBracket]\/tscale - txvp)\)\)\/\(pt\[LeftDoubleBracket]1\
\[RightDoubleBracket] - txvp\), \
\(pt\[LeftDoubleBracket]3\[RightDoubleBracket]\ \((pt\[LeftDoubleBracket]1\
\[RightDoubleBracket]\/tscale - txvp)\)\)\/\(pt\[LeftDoubleBracket]1\
\[RightDoubleBracket] - txvp\)};
ff[pt_ /; N[pt\[LeftDoubleBracket]1\[RightDoubleBracket]] > 0.0] :=
pt; shape /. {poly : Polygon[_] \[RuleDelayed]
Map[ff[#1] &, poly, {2}],
line : Line[_] \[RuleDelayed] Map[ff[#1] &, line, {2}],
point : Point[_] \[RuleDelayed]
Map[ff[#1] &, point, {1}]}]\)], "InputOnly"],
Cell[TextData[{
"Values greater than zero are clipped by the function ",
StyleBox["Clip3D", "InlineInput"],
". This function is available in the package ",
StyleBox["ExtendGraphics`Geometry3D`", "InlineInput"],
". This is available from ",
StyleBox[ButtonBox["MathSource",
ButtonData:>{
URL[
"http://www.mathsource.com/Content22/Enhancements/Graphics/3D/0208-976"]\
, None},
ButtonStyle->"Hyperlink"],
FontSlant->"Italic"],
" or included in [",
ButtonBox["1",
ButtonData:>"ref",
ButtonStyle->"Hyperlink"],
"]. If you have a DOS/Windows based system you will have to execute the \
following lines after copying the package to the proper directories."
}], "Text"],
Cell[BoxData[
\(Needs["\"]; \)], "InputOnly"],
Cell["\<\
Since we are now in our normalized bounding box, we will fix the \
box ratios and plot range.\
\>", "Text"],
Cell[BoxData[{
\(prng := {{\(-1\), 0}, {\(-ycp[\(-1\)]\),
ycp[\(-1\)]}, {\(-zcp[\(-1\)]\), zcp[\(-1\)]}}; \), "\n",
\(box := {1, 1, 1\/GoldenRatio}\)}], "InputOnly"],
Cell["Here is a plot of our normalized data.", "Text"],
Cell[BoxData[
\(demo2 =
Show[LOSAffineShape[
Clip3D[demo1, Plane[{0.001, 0, 0}, {\(-1\), 0, 0}]], Abs[xrcp],
xvp], BoxRatios \[Rule] box,
PlotRange \[Rule] prng]; \)], "InputOnly"],
Cell[TextData[{
"Our next step is to move our viewpoint to the ",
StyleBox["x",
FontSlant->"Italic"],
" axis. Here is a plot of our data from this new viewpoint. Facegrids have \
been added for perspective and the axes have been turned off."
}], "Text"],
Cell[BoxData[
\(demo3 =
Show[demo2, ViewPoint \[Rule] {3, 0, 0},
FaceGrids \[Rule] {{0, 0, 1}, {0, 0, \(-1\)}, {0, 1, 0}, {0, \(-1\),
0}}, BoxRatios \[Rule] box, PlotRange \[Rule] prng,
Axes \[Rule] False]; \)], "InputOnly"],
Cell[TextData[{
"Our next step is to properly locate the viewpoint along the ",
StyleBox["x",
FontSlant->"Italic"],
" axis. This is accomplished by the function ",
StyleBox["ViewPointFromUser", "InlineInput"],
" in the package ",
StyleBox["ExtendGraphics`View3D'", "InlineInput"],
"."
}], "Text"],
Cell[BoxData[
\(Needs["\"]; \)], "InputOnly"],
Cell[TextData[{
"Our transformed viewpoint is given as ",
StyleBox["vpcam", "InlineInput"],
"."
}], "Text"],
Cell[BoxData[
\(vpcam := ViewPointFromUser[vp, prng, box]\)], "InputOnly"],
Cell["\<\
Here is our data viewed at the proper viewpoint. Clearly, the \
viewport is eclipsing the rear clipping plane.\
\>", "Text"],
Cell[BoxData[
\(demo4 =
Show[demo3, ViewPoint \[Rule] vpcam, BoxRatios \[Rule] box,
PlotRange \[Rule] prng, Axes \[Rule] False]; \)], "Input"],
Cell[TextData[{
"Our final step shall be to display only the viewport. This is accomplished \
by setting the ",
StyleBox["PlotRegion", "InlineInput"],
" with the function ",
StyleBox["pregn", "InlineInput"],
". In this function, ",
StyleBox["dm", "InlineInput"],
" is the change in magnification from one and ",
StyleBox["zf", "InlineInput"],
" is a zoom factor. You may consider this to be an aesthetic factor. A \
device factor less than one will show more of the image and is equivalent to \
having the lens inside the viewport rather than the converse."
}], "Text"],
Cell[BoxData[{
\(pregn[dm_,
zf_] := {{\(-dm\)\ zf, 1 + dm\ zf}, {\(-dm\)\ zf,
1 + dm\ zf}}\), "\n",
\(dm := 1\/2\ \((ycp[\(-1\)]\/ycp[0] - 1. )\)\)}], "InputOnly"],
Cell["\<\
Here is our final display. It is easily verified that our front \
clipping plane is just eclipsing our rear and that we are only displaying the \
contents of the viewport.\
\>", "Text"],
Cell[BoxData[
\(demo5 =
Show[demo4, ViewPoint \[Rule] vpcam, FaceGrids \[Rule] None,
Boxed \[Rule] False, BoxRatios \[Rule] box, PlotRange \[Rule] prng,
Axes \[Rule] False, PlotRegion \[Rule] pregn[dm, 1.00]]; \)], "Input"],
Cell["\<\
Comparison of this image to the previous shows that the edge \
thickness of the polygons also scale up as the magnification is increased. \
When the camera is used, it will be important to set the point, line, and \
edge thicknesses to a minimum or else they may overwrite the graphics.\
\>", \
"Text"],
Cell[TextData[{
"We capture the demonstration from above in the function ",
StyleBox["showcamera", "InlineInput"],
". "
}], "Text"],
Cell[BoxData[
\(showcamera[obj_, opts___] :=
Show[LOSAffineShape[Clip3D[obj, Plane[{0.001, 0, 0}, {\(-1\), 0, 0}]],
Abs[xrcp], xvp], PlotRange \[Rule] prng, Boxed \[Rule] False,
ViewPoint \[Rule] vpcam, Axes \[Rule] False,
PlotRegion \[Rule] pregn[dm, zf], Lighting \[Rule] False,
DisplayFunction \[Rule] $DisplayFunction, opts]; \)], "InputOnly"],
Cell[TextData[{
"Rather than moving the camera to the scene, we move the scene to the \
camera. The function ",
StyleBox["placeobj", "InlineInput"],
" translates the graphics to the center of the lens and then provides the \
proper attitude. The center of the lens is at the origin. The camera ",
StyleBox["y",
FontSlant->"Italic"],
" axis is to the right and the ",
StyleBox["z",
FontSlant->"Italic"],
" axis is up. The ",
StyleBox["x",
FontSlant->"Italic"],
" axis is toward the viewer. The order of transformation to the proper \
position and attitude is designed to be intuitive. The user of a hand-held \
video camera will first move to position and then rotate about the vertical \
axis to line up his subject. Then he will set the pitch angle followed by \
roll. The transformations embedded in ",
StyleBox["placeobj", "InlineInput"],
" occur in the same order. A positive camera yaw angle is equivalent to \
rotating the camera to the right. A positive camera pitch angle is the same \
as rotating the camera up. A positive camera roll angle rotates the camera \
clockwise about the axis of the lens."
}], "Text"],
Cell[BoxData[
\(placeobj[obj_, pos_, yaw_, pitch_, roll_] :=
RotateShape[
RotateShape[
RotateShape[TranslateShape[obj, \(-pos\)], yaw, 0, 0], \[Pi]\/2,
pitch, \(-\(\[Pi]\/2\)\)], 0, roll, 0]; \)], "InputOnly"],
Cell[TextData[{
"The camera and motion ability are combined giving the function ",
StyleBox["mathcam", "InlineInput"],
"."
}], "Text"],
Cell[BoxData[
\(mathcam[obj_, pos_, yaw_, pitch_, roll_, opts___] :=
showcamera[placeobj[obj, pos, yaw, pitch, roll], opts]\)], "InputOnly"]
}, Closed]],
Cell[CellGroupData[{
Cell["The Animation", "Section"],
Cell[TextData[{
"The graphic elements we have defined to this point are combined in the \
function ",
StyleBox["lugeworld", "InlineInput"],
". Since a good luge rider will anticipate corners and steer before \
entering the corner, we will shift the leg roll angle forward in time 100 \
milliseconds. The leg roll angle is taken as 40% of the roll angle of the \
luge."
}], "Text"],
Cell[BoxData[
\(lugeworld[t_] :=
Show[{track, base, mtsinai, tree,
slider[spos[t], .4\ rollt[t + .1], rollt[t], ptt[t], yawt[t]]},
DisplayFunction \[Rule] Identity]; \)], "InputOnly"],
Cell[TextData[{
"One frame of the animation is generated by the function ",
StyleBox["showluge", "InlineInput"],
". Since a good luge rider will anticipate corners and look ahead, we will \
shift the yaw angle forward in time 30 milliseconds. Similarly, the slider \
damps pitching motion by bending his neck. We capture this by reducing the \
camera\[CloseCurlyQuote]s pitch motion by 20%. The roll motion is completely \
omitted from the animation. While it may be more realistic, when one is \
sitting at one\[CloseCurlyQuote]s motionless computer monitor, it is just \
disorienting. A blue background color is specified to suggest sky."
}], "Text"],
Cell[BoxData[
\(showluge[t_] :=
mathcam[lugeworld[t], cpos[t], yawt[t + .03], .8\ ptt[t], 0. ,
Background \[Rule] SkyBlueDeep]\)], "InputOnly"],
Cell["\<\
A viewpoint located close to the front clipping plane will give a \
small viewport and a wide field of view. Since the slider\[CloseCurlyQuote]s \
legs are always close to the viewport, we will choose a viewpoint close to \
the front clipping plane.\
\>", "Text"],
Cell[BoxData[
\(xvp = .1875; \)], "InputOnly"],
Cell["\<\
The luge world has a depth of 300 feet so we will set the rear \
clipping plane at 700 feet to allow rotation and some margin.\
\>", "Text"],
Cell[BoxData[
\(xrcp = \(-700.0\); \)], "InputOnly"],
Cell["A zoom factor of .85 is used.", "Text"],
Cell[BoxData[
\(zf = .85; \)], "InputOnly"],
Cell["Here is one frame of the luge ride.", "Text"],
Cell[BoxData[
\(showluge[ .56]; \)], "Input"],
Cell[TextData[{
"The function ",
StyleBox["lugeride", "InlineInput"],
" generates the complete animation with ",
StyleBox["nf", "InlineInput"],
" frames."
}], "Text"],
Cell[BoxData[
\(lugeride[nf_] :=
Table[showluge[t], {t, 0, \(tmax\ \((nf - 1)\)\)\/nf,
tmax\/nf}]\)], "InputOnly"],
Cell["\<\
A minimum of 24 frames is recommended for a smooth animation.\
\>", \
"Text"],
Cell[BoxData[
\(lugeride[36]; \)], "Input",
AnimationDisplayTime->0.287615],
Cell[TextData[{
"On machines with limited memory, some steps can be taken to reduce the \
byte count. The tree can be omitted without seriously changing the animation. \
The track owns most of the polygons so the biggest gain can be obtained by \
lowering the resolution (",
StyleBox["PlotPoints", "InlineInput"],
") of this element. Omitting the track color function and using a fixed \
color (with ",
StyleBox["editgr", "InlineInput"],
") will also significantly reduce memory consumption as every polygon will \
not be preceded by a color directive."
}], "Text"],
Cell[TextData[{
"If you are willing to trade execution time to reduce memory loading, you \
can use ",
StyleBox["Clip3D", "InlineInput"],
" on all six sides of the view volume rather than just the front clipping \
plane. In [",
ButtonBox["1",
ButtonData:>"ref",
ButtonStyle->"Hyperlink"],
"] Wickham-Jones shows an example of clipping multiple planes."
}], "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell["Mathcam Discussion ", "Section"],
Cell[TextData[{
"If one is using the ",
StyleBox["mathcam", "InlineInput"],
" function for one\[CloseCurlyQuote]s own work he may find some of the \
following discussion helpful. I found some idiosyncrasies that degrade \
graphic quality that are most likely related to PostScript and/or the use of \
",
StyleBox["PlotRegion", "InlineInput"],
" to magnify the image. The animation was originally developed under \
Version 2.2 so some of the comments may not be valid under current versions."
}], "Text"],
Cell[TextData[{
"Theoretically, the function performed by ",
StyleBox["LOSAffineShape", "InlineInput"],
" should not be necessary. Simply setting the viewpoint to be very close to \
the view volume should give the same image (with the proper setting of the \
plot range and box ratios). For the luge run, which required a lot of depth, \
this gave a very large magnification. Practically, during development, I \
found that if I did not perform the ",
StyleBox["LOSAffineShape", "InlineInput"],
" step, I would receive polygons seemingly rotated by 90 degrees. Sometimes \
they would be rendered on the wrong side of each other. I even had the image \
render upside down on occasion (on a PC, but not UNIX workstation)! The final \
straw was when individual pixels mapped nonlinearly to the viewport. This \
resulted in very \[OpenCurlyDoubleQuote]crinkled\[CloseCurlyDoubleQuote] \
polygons. I suspect this was due to numerical round off error."
}], "Text"],
Cell[TextData[{
"Similarly, the use of ",
StyleBox["Clip3D", "InlineInput"],
" at the front clipping plane should not be necessary. Practically, I found \
that if I did not perform this step, polygons near the front clipping plane \
(the slider in my case) would sometimes be colored (filled) on the wrong \
side. Clipping at the front clipping plane seemed to reduce but not eliminate \
this. If you look at the limb function you will see three plot points where \
only two are required for the cone. The extra intermediate points seemed to \
give the rendering process a definite point to work with, which resulted with \
the proper image. "
}], "Text"],
Cell[TextData[{
"When I have completed an animation, I will typically make a ",
Cell[BoxData[
\(TraditionalForm\`4\[Cross]3\)]],
" graphics array for hardcopy display. I was not able to do this with the \
luge ride. The ",
StyleBox["PlotRegion", "InlineInput"],
" specification is also used by ",
StyleBox["GraphicsArray", "InlineInput"],
" which overrides the specification by ",
StyleBox["mathcam", "InlineInput"],
". All 12 frames were larger than desired and overlapped each other."
}], "Text"],
Cell["\<\
Under Version 2.2, I had to use a zoom factor of 1.06 to make the \
viewport fill the window provided by the notebook front end. Subsequent \
versions allowed the expected zoom factor of 1.0 to be used.\
\>", "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell["References", "Section"],
Cell[TextData[{
"\[ThickSpace]\[MediumSpace][",
CounterBox["Reference"],
"]\[ThickSpace]\[MediumSpace]T. Wickham-Jones, ",
StyleBox["Mathematica Graphics", "SO"],
", New York: TELOS (Springer-Verlag), 1994."
}], "Reference",
CellTags->"ref"]
}, Closed]],
Cell[CellGroupData[{
Cell["About the Author", "SectionAboutAuthor"],
Cell[TextData[{
"Robert Rudd works for BF Goodrich Aerospace in Vergennes, Vermont. He \
received Bachelors and Masters degrees in mechanical engineering from \
Rensselaer Polytechnic Institute in Troy, New York, and has worked at the \
Unisys and Singer Corporations. He has successfully completed the Lake \
Placid, New York 14-turn ",
ButtonBox["Olympic luge",
ButtonData:>{
URL[ "http://www.luge.com/tracks/LakePlac/trackfrm.htm"], None},
ButtonStyle->"Hyperlink"],
" run from turn five."
}], "TextAboutAuthor"]
}, Closed]],
Cell[CellGroupData[{
Cell["Implementation", "Section"],
Cell[CellGroupData[{
Cell["Figure 1 Graphics", "SubsectionNoSpace"],
Cell[BoxData[{
\(Off[ParametricPlot3D::"\"]\), "\n",
\(Off[General::"\"]\), "\n",
\(Off[General::"\"]\)}], "InputOnly",
InitializationCell->True],
Cell[BoxData[{
\(Needs["\"]\), "\n",
\(Needs["\"]\), "\n",
\(Needs["\"]\)}], "InputOnly",
InitializationCell->True],
Cell[BoxData[
\(bbox =
WireFrame[
AffineShape[
Polyhedron[Cube, {\(- .5\), 0, 0}, \@2. \/2. ], {1, 1,
1\/GoldenRatio}]]; \)], "InputOnly",
InitializationCell->True],
Cell[BoxData[
\(vport = Graphics3D[{Hue[ .65], xcp[0]}]; \)], "InputOnly",
InitializationCell->True],
Cell[BoxData[
\(xvp = .5; \)], "InputOnly",
InitializationCell->True],
Cell[BoxData[
\(vpt =
Graphics3D[{PointSize[ .02], ForestGreen,
Point[{xvp, 0, 0}]}]; \)], "InputOnly",
InitializationCell->True],
Cell[BoxData[{
\(\(ycp[
x_] := .5\ \((x\ \((xvp\/\(1 + xvp\) - 1)\) +
xvp\/\(1 + xvp\))\);\)\), "\n",
\(\(zcp[x_] := ycp[x]\/GoldenRatio;\)\)}], "InputOnly",
InitializationCell->True,
AspectRatioFixed->True],
Cell[BoxData[
\(xcp[x_] :=
Polygon[{{x, \(-ycp[x]\), \(-zcp[x]\)}, {x, ycp[x], \(-zcp[x]\)}, {x,
ycp[x], zcp[x]}, {x, \(-ycp[x]\), zcp[x]}}]; \)], "InputOnly",
InitializationCell->True],
Cell[BoxData[
\(editgr[gr_, dir_List] :=
Fold[Insert[#1, #2, {1, 1}] &, gr, dir]\)], "InputOnly",
InitializationCell->True],
Cell[BoxData[
\(lens =
editgr[ParametricPlot3D[\@\(ycp[0]\^2 + zcp[0]\^2\)\ {0, Sin[th],
Cos[th]}, {th, 0, 2\ \[Pi]},
DisplayFunction \[Rule] Identity], {Hue[1]}]; \)], "InputOnly",
InitializationCell->True],
Cell[BoxData[
\(vvol =
Graphics3D[{Dashing[{ .05, .025}],
Line[{{ .5, 0, 0}, {\(-1\), ycp[\(-1\)], zcp[\(-1\)]}}],
Line[{{ .5, 0, 0}, {\(-1\), \(-ycp[\(-1\)]\), zcp[\(-1\)]}}],
Line[{{ .5, 0, 0}, {\(-1\), ycp[\(-1\)], \(-zcp[\(-1\)]\)}}],
Line[{{ .5, 0,
0}, {\(-1\), \(-ycp[\(-1\)]\), \(-zcp[\(-1\)]\)}}]}]; \)], \
"InputOnly",
InitializationCell->True],
Cell[BoxData[
\(figure1 :=
Show[bbox, vport, vpt, lens, vvol, Axes \[Rule] False,
PlotLabel \[Rule] "\