(*^

::[	frontEndVersion = "Microsoft Windows Mathematica Notebook Front End Version 2.2";
	microsoftWindowsStandardFontEncoding;
	fontset = title, "Times", 24, L0, center, nohscroll, bold;
	fontset = subtitle, "Times", 18, L0, center, nohscroll, bold;
	fontset = subsubtitle, "Times", 14, L0, center, nohscroll, italic;
	fontset = section, "Times", 18, L0, nohscroll, bold, grayBox;
	fontset = subsection, "Times", 14, L0, nohscroll, bold, blackBox;
	fontset = subsubsection, "Times", 13, L0, nohscroll, B65535;
	fontset = text, "Times", 12, L0, nohscroll, cellOutline;
	fontset = smalltext, "Times", 10, L0, nohscroll;
	fontset = input, "Courier", 12, L-5, nowordwrap, bold;
	fontset = output, "Courier", 12, L-5, nowordwrap;
	fontset = message, "Courier", 12, L-5, nowordwrap, R65535;
	fontset = print, "Courier", 12, L-5, nowordwrap;
	fontset = info, "Courier", 12, L-5, nowordwrap, B65535;
	fontset = postscript, "Courier", 12, L0, nowordwrap;
	fontset = name, "Geneva", 10, L0, nohscroll, italic;
	fontset = header, "Times", 12, L0;
	fontset = footer, "Times", 12, L0, center;
	fontset = help, "Times", 10, L0, nohscroll;
	fontset = clipboard, "Times", 12, L0, nohscroll;
	fontset = completions, "Times", 12, L0, nohscroll;
	fontset = graphics, "Courier New", 10, L0, nowordwrap, nohscroll;
	fontset = special1, "Times", 12, L0, nohscroll;
	fontset = special2, "Times", 12, L0, nohscroll;
	fontset = special3, "Times", 12, L0, nohscroll;
	fontset = special4, "Times", 12, L0, nohscroll;
	fontset = special5, "Times", 12, L0, nohscroll;
	fontset = leftheader, "Times", 12, L2;
	fontset = leftfooter, "Times", 12, L2;
	fontset = reserved1, "Courier New", 10, L0, nowordwrap, nohscroll;]
:[font = title; inactive; preserveAspect; nohscroll; center; ]
MathLive Professional
:[font = subsubtitle; inactive; initialization; preserveAspect; startGroup; nohscroll; center; ]
Ferris Wheel Example
Original by L.Angrave 1995
Last Update: 20/4/96
:[font = section; inactive; initialization; preserveAspect; startGroup; nohscroll; ]
Introductory Notes
:[font = subsubsection; inactive; initialization; preserveAspect; endGroup; nohscroll; ]
This notebook creates a Ferris wheel complete with rocking seats. You will need to move the camera manually to obtain this view. The initialisation cells will create the model and run the animation.
:[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ]
Initialisation
:[font = input; initialization; preserveAspect; endGroup; nowordwrap; ]
*)
Needs["MathLive`MathLive`"];
LaunchLive[];
ResetLive[];
(*
:[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ]
Define the graphics
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ]
Set the object parameters
:[font = input; initialization; preserveAspect; endGroup; nowordwrap; ]
*)
nCarriages =			 9;

bigWheelAngleStep 		= 2. Pi / nCarriages;

bigWheelRadius 			= 10;
bigWheelSmallRadius 	= 0.6 bigWheelRadius;
bigWheelCentreRadius 	= 0.02 bigWheelRadius;

bigWheelHalfHeight 		= 2 + bigWheelRadius;
bigWheelHalfWidth 		= 2;

supportHalfLengh		= 0.6 bigWheelHalfHeight;
supportHalfWidth 		= 1.1 bigWheelHalfWidth;

groundHalfWidth 		= 8;
groundHalfLength		= 8; 
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ]
Define the ground graphics
:[font = input; initialization; preserveAspect; endGroup; nowordwrap; ]
*)
SetDisplay[NoteBook ->Off, Live->Off];

gGround = Plot3D[ (1+Random[]) ((x/groundHalfWidth)^2 + (y/groundHalfWidth)^2)
	, {x,-groundHalfWidth,groundHalfWidth}
	, {y,-groundHalfLength,groundHalfLength}
	, ColorFunction ->(RGBColor[0,Random[],Random[]/2]&)
	, SphericalRegion->True
	, PlotPoints ->16
	];
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ]
Define Ferris wheel and support struts
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
(* Big Wheel Support Structure *)
Module[ {angle,iStrut},
	strutUnitVectors = Table[angle= 2Pi/ nCarriages i;
					N[{0,Cos[angle],Sin[angle]}] , {i,nCarriages}];
	gSupports = Graphics3D[ {Hue[.7],
		Line[ {{#,-supportHalfLengh,0},
			{#,0,bigWheelHalfHeight} , {#,supportHalfLengh,0}}
		]& /@ (supportHalfWidth{-1,1})
		
	}];
]	
(*
:[font = input; initialization; preserveAspect; endGroup; nowordwrap; ]
*)
(* Big Wheel Structure *)
Module[ {angle,iStrut},
	strutUnitVectors = Table[angle= 2Pi/ nCarriages i;
					N[{0,Cos[angle],Sin[angle]}] , {i,nCarriages}];
	gWheel = Graphics3D[ {
		Thickness[0.01]
		,
		Function[{side}, {
			(* Spokes *)
			RGBColor[1,0,0]	
		, 	(	Line[{ {side,0,0},{side,0,0}+ bigWheelRadius #}
				]&) /@ strutUnitVectors
		(* Do for both sides of the big wheel *)
		(* Ties*)
		,	RGBColor[1,1,0]	
		,	Table[
				(* Select radius *) 
				radius = {bigWheelSmallRadius,bigWheelRadius}[[circle]];
				(* Strut Ties *)	
					Line[( {side,0,0} +radius # &)
						/@ (Append[ #,First[#]]&[ strutUnitVectors]) 
				]
			, {circle, 2}
			]
		}] /@ (bigWheelHalfWidth{-1,1})
		,
		(* Cross Strut Ties *)
		Table[{
		(* Select radius *) 
				radius = {bigWheelCentreRadius
				, bigWheelSmallRadius
				, bigWheelRadius}[[circle]];
				{Hue[.0]
				,Hue[.4]
				,Hue[.6]}[[circle]]
			,
				(* Strut Ties *)
				MapIndexed[
					Function[{strut},
					{
						RGBColor[1,Mod[ #2[[1]],2],0]
					,	Line[(radius strut +#{bigWheelHalfWidth,0,0}&) /@ {-1,1}]
					
					}
					]
				, strutUnitVectors ]
			}
			, {circle, 3}
			]
		}
	]
];
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ]
 Create the carriage graphics
:[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ]
*)
Module[{BackHeight,HalfWidth,LegHeight,FootDepth,HalfSeatDepth},
	BackHeight 		= 0.9;
	HalfWidth  		= 0.95 bigWheelHalfWidth;
	LegHeight 		= 0.5;
	FootDepth 		= 0.3;
	HalfSeatDepth 	= 0.4;
	sideDepth		= 1.8 HalfSeatDepth;
	sideHeight		= 0.3;

gCarriage = Graphics3D[{
	Hue[-.1]
	,
		(* Seat *)
	Polygon[ (# {HalfWidth, HalfSeatDepth,0}&
			  	)/@ {{-1,-1,0}, {1,-1,0},{1,1,0} , {-1,1,0}}	]
	,	(* Vertical leg rest *) 
	Polygon[ ({0,HalfSeatDepth,0} + 
				#{HalfWidth,0,-LegHeight}& 
				)/@ {{-1,0,0}, {1,0,0},{1,0,1}, {-1,0,1}}	]
	,	(* Foot rest *)
	Hue[-.1,.6,.6]
	,
	Polygon[ ({0,HalfSeatDepth,-LegHeight} +
				#{ HalfWidth, FootDepth,0}&
			  	)/@ {{-1,0,0}, {1,0,0},{1,1,0} , {-1,1,0}}	]
	,	(* Back rest *)
	Hue[-.3]
	,
	Polygon[ ({0,-HalfSeatDepth,0} +
				#{ HalfWidth, 0, BackHeight}&
				)/@ {{-1,0,0}, {1,0,0},{1,0,1} , {-1,0,1}}	]
	,	(* sides *)
	Hue[.1]
	,
	Table[
		Polygon[ ({HalfWidth iside,-HalfSeatDepth,0} +
				#{ 0,sideDepth,sideHeight}&
				)/@ {{0,0,0}, {0,0,1},{0,1,1} , {0,1,0}}	]
	, {iside,-1,1,2}
	]
	,	(* Cross Bar *)
	Thickness[0.02] , Hue[.4,.4,.4]
	
	,
	Line[ {0,sideDepth-HalfSeatDepth,sideHeight} + 
				({# HalfWidth,0,0})& /@ {-1,1} ]
	
			}
			];
	
]
(*
:[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ]
Put the objects in MathLive
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ]
Initialise the MathLive Model
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
Live[ Change [Model3D["Default`"] , ModelRange -> {{-13,-13,-13},{13,13,13}} ] ]
(*
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
Clear[ carAngle,carPosition,carVertical]

carAngle[car_,t_] := bigWheelAngleStep (car-1)+ t bigWheelTurningSpeed;

carPosition[car_,t_] := Module[ {angle = carAngle[car,t]},
(* We move the carriage up slightly to ensure the cross strut is
   under the car *)
	N[{0,0,bigWheelHalfHeight+.1} + 
		bigWheelRadius { 0,Cos[angle],-Sin[angle]}]
]; 

carSwing[car_,t_] := Module[{ angle = carAngle[car,t] },
	N[ 0.5 Sin[2 angle - 1.5 ] ]
]; (* This has no physical basis - it just has the correct period *) 
	
(*
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
(*Position the Camera & Model so that the objects that are
created can be seen easily *)

Clear[ resetModel];
resetModel := Change[Model3D["Default`"],Location-> Reset, YawPitchRoll -> {6Pi/7,0,0}];
	
Live[ resetModel ]

(*
:[font = input; initialization; preserveAspect; endGroup; nowordwrap; ]
*)
Live[ Change[ Camera["Camera"] , Location->{0,-1,0.7}, YawPitchRoll -> {0,-Pi/12,0}] ];
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ]
Create all the objects in MathLive
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
(* Create the ground *)
theGround = Object3D["Ground"];
Live[ Create[ theGround,  gGround] ];
(*
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
(* Create the wheel *)
theWheel = Object3D["Big Wheel"];
Live[ Create[ theWheel,  gWheel] ];
(*
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
(* Create the supports *)
theSupports =Object3D["Supports"];
Live[ Create[ theSupports,  gSupports] ];
(*
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
(* Use the automatic naming for the carriages *)
SetDisplay[ NoteBook ->Off, Live -> On];
theCarriages = {};
Do[
	Show[ gCarriage ];
	AppendTo[theCarriages,LastObjectCreated[] ];
	, { nCarriages }
];

(*
:[font = input; initialization; preserveAspect; endGroup; nowordwrap; ]
*)
allObjects = Join[{theGround,theWheel,theSupports },theCarriages];
Live[ Change[ allObjects , MouseMovement ->False ] ];
Live[ Change[ Model3D["Default`"] , BoundingBox ->False ] ];
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ]
Put them in their correct places & Set their surface characteristics
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
Clear[ resetObjects]
resetObjects := {{
	Change[ theWheel  
	,	Location -> {0,0,bigWheelHalfHeight}
	] 
,	 Change[ theGround,
		 {	Specular -> 0
		 ,	Ambient ->	.2
		 ,	Diffuse -> 0
		 ,	Scale -> {8,8,3}
		 ,  Opacity -> 1 (*Use 1 or .5 *)
	
	(* Opacity ->1 works best with QuickTime Movies
	whose playback size can be altered.
	A Transparent ground is useful when you wish to
	see objects whilst 'beneath' the ground surface*)
				
		}
	]
,
(* Send each car to its initial position *)
	MapIndexed[ 
		Change[#,Location->	carPosition[#2[[1]],0] ]&	
	,	theCarriages
	]
	
}};
(*
:[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ]
*)
Live[resetObjects];
Live[resetModel];
(*
:[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ]
Animation
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ]
Animate the big wheel
:[font = input; initialization; preserveAspect; nowordwrap; ]
*)
(* Build the animation *)

bigWheelTurningSpeed = 2 Pi / 49;
animFrames = 48; (* Goes round once *)

animWheel =	Table[{
		MapIndexed[ Change[#
			,	Location 	->carPosition[#2[[1]],frame]
			,	YawPitchRoll->{0,carSwing[#2[[1]],frame],0} 
			   ]& 
		,	theCarriages
		]
	,
		Change[ theWheel, YawPitchRoll -> {0,- bigWheelTurningSpeed frame,0}]
	}
, {frame, animFrames}
] //N;

(*
:[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ]
*)
(* Send the animation to Live *)
Live[resetObjects]
Live[animWheel];
(*
:[font = section; inactive; preserveAspect; startGroup; nohscroll; ]
For further information, advice or suggestions please contact-
:[font = text; inactive; preserveAspect; endGroup; endGroup; nohscroll; cellOutline; backColorRed = 65535; backColorGreen = 65535; backColorBlue = 65535; fontColorRed = 0; fontColorGreen = 0; fontColorBlue = 0; plain; fontName = "Times"; fontSize = 12; ]
Email:     support@milohedge.com               
Post:       Milo Hedge Ltd, The Oxford Centre for Innovation, Mill Street, Oxford, OX2 0JX
WWW:   http://www.milohedge.com/mathlive/
^*)