Manipulate[
(*by Nasser M. Abbasi 6/30/14*)
tick;
Module[{perc,torque,g=9.81,I0,w=2.0 Pi*spin,delTheta=2.0 Pi/10,u},
torque=g*r2;
I0=r1^2;
perc=torque/(I0*w);
thick=0.07r1;
spins=Table[{{r2,0,0},{r2,r1 Cos[x],r1 Sin[x]}},{x,0., 2Pi,2 Pi/n}];
topSpins=Table[{{0,0,2},{0.4Cos[x],0.4Sin[x],2}},{x,0., 2Pi,2 Pi/10}];
wheel=Table[{r2,r1 Cos[u],r1 Sin[u]},{u,0.,2 Pi,2 Pi/40}];
topWheel=Table[{0.4 Cos[u],0.4 Sin[u],2},{u,0.,2 Pi,2 Pi/40}];

g=
Grid[{
{Grid[{
{"wheel angle","precession angle","wheel spin (hz)","Precession spin (hz)"},
{
padIt2[currentSpinAngle*180./Pi,{4,3}],
padIt2[currentPercAngle*180./Pi,{4,3}],
padIt1[w/(2 Pi),{5,4}],
padIt1[perc/(2 Pi),{5,4}]
}
},Alignment->Center,Frame->All,Spacings->{.5,.7}]
},
{Graphics3D[
Rotate[GraphicsGroup[
{
Rotate[GraphicsGroup[
{{Green,Tube[wheel,thick]},
{Red,Cylinder[{{r2-thick,0,0},{r2+thick,0,0}},thick]},(*disk in middle of wheeel*)
Tube[#,thick/3]&/@spins(*rods*)
}],
currentSpinAngle,{1,0,0}
],
{Arrowheads[Small],Arrow[{{r2,0,0},{r2,1.5 r1,0}}]},(*torque*)

Inset[Graphics[
Text[Style["torque",Bold,10]]
],{r2,1.8r1,0}],

{Arrowheads[Small],Arrow[{{0,0,0},{If[clockWise,-r1,r2+r1],0,0}}]},(*angular momentum*)
Inset[Graphics[
Text[Style["H",Bold,10]]
],{If[clockWise,-1.1r1,r2+1.1r1],0,0}],

{Blue,Cylinder[{{0,0,0},{r2,0,0}},thick]},(*tube to robe*)
Tube[{{0,0,0},{0,0,2}},thick/2],(*robe*)
{LightGray,Cylinder[{{0,0,2-0.03},{0,0,2-0.01}},0.4]} ,(*disk at top*)
Tube[topWheel,0.01],
{Red,Tube[#,0.01]&/@topSpins},

{Red,Arrowheads[Medium],Arrow[{{0,0,0},{.5,0,0}}]},(*x*)
{Red,Arrowheads[Medium],Arrow[{{0,0,0},{0,.5,0}}]},(*y*)
{Red,Arrowheads[Medium],Arrow[{{0,0,0},{0,0,.5}}]},(*z*)

Inset[Graphics[
Text["x"]
],{.5,-.15,0}],

Inset[Graphics[
Text["y"]
],{0,.55,0}],

Inset[Graphics[
Text["z"]
],{0,.1,.5}]

}],currentPercAngle,{0,0,1}],

Axes->False,AxesLabel->{"x","y","z"},PlotRange->{{-zoom,zoom},{-zoom,zoom},{-1.1,2.1}},
SphericalRegion->True,Boxed->False,ImagePadding->.1,ImageSize->400
]
}},Frame->True,FrameStyle->LightGray];

Which[state=="RUN"||state=="STEP",
currentSpinAngle=Mod[currentSpinAngle+ If[clockWise,-1,1]spin/(100-speed+1),2 Pi];
currentPercAngle=Mod[currentPercAngle+If[clockWise,-1,1]perc/(100-speed+1),2 Pi];
If[state=="RUN",tick=Not[tick]]
];
g
],

Grid[{
{Grid[{
{ Button[Text@Style["run",12],{state="RUN";tick=Not[tick]},ImageSize->{40,40}],
Button[Text@Style["step",12],{state="STEP";tick=Not[tick]},ImageSize->{40,40}],
Button[Text@Style["stop",12],{state="STOP";tick=Not[tick]},ImageSize->{40,40}],
Button[Text@Style["reset",12],{state="RESET";r1=1;r2=1;spin=2;zoom=2.2;n=10;speed=40;tick=Not[tick]},ImageSize->{40,40}]
}
},Spacings->{.3,0},Frame->True,FrameStyle->Gray
],SpanFromLeft
},
{
"radius of wheel",Manipulator[Dynamic[r1,{r1=#;tick=Not[tick]}&],{.2,1, .1},ImageSize->Small],Dynamic[padIt1[r1,{2,1}]]
},
{
"distance away",Manipulator[Dynamic[r2,{r2=#;tick=Not[tick]}&],{.2,2, .01},ImageSize->Small],Dynamic[padIt1[r2,{2,1}]]
},
{
"number of rods",Manipulator[Dynamic[n,{n=#;tick=Not[tick]}&],{3,15, 1},ImageSize->Small],Dynamic[padIt1[n,2]]
},
{
"wheel spin (hz)",Manipulator[Dynamic[spin,{spin=#;tick=Not[tick]}&],{.1,5, .1},ImageSize->Small],Dynamic[padIt1[spin,{2,1}]]
},
{
"simultion speed",Manipulator[Dynamic[speed,{speed=#;tick=Not[tick]}&],{0,100, 1},ImageSize->Small],Dynamic[padIt1[speed,3]]
},
{
"wheel spin clockwise",Checkbox[Dynamic[clockWise,{clockWise=#;tick=Not[tick]}&]]
},
{
"zoom",Manipulator[Dynamic[zoom,{zoom=#;tick=Not[tick]}&],{1,4, .1},ImageSize->Small],Dynamic[padIt1[zoom,{2,1}]]
}
},Frame->True,Alignment->Center,FrameStyle->Gray
],

{{tick,False},None},
{{r1,1},None},
{{r2,1},None},
{{spin,2},None},
{{zoom,2.2},None},
{{n,10},None},
{{state,"STOP"},None},
{{clockWise,True},None},
{{speed,40},None},

{{currentSpinAngle,0},None},
{{currentPercAngle,0},None},

ControlPlacement->Left,Alignment->Center,ImageMargins->0,FrameMargins->0,
TrackedSymbols:>{tick},
Initialization:>
(
integerStrictPositive=(IntegerQ[#]&&#>0&);
integerPositive=(IntegerQ[#]&&#≥0&);
numericStrictPositive=(Element[#,Reals]&&#>0&);
numericPositive=(Element[#,Reals]&&#≥0&);
numericStrictNegative=(Element[#,Reals]&&#<0&);
numericNegative=(Element[#,Reals]&&#≤0&);
bool=(Element[#,Booleans]&);
numeric=(Element[#,Reals]&);
integer=(Element[#,Integers]&);
(*--------------------------------------------*)
padIt1[v_?numeric,f_List]:=AccountingForm[v,
f,NumberSigns->{"-","+"},NumberPadding->{"0","0"},SignPadding->True];
(*--------------------------------------------*)
padIt1[v_?numeric,f_Integer]:=AccountingForm[Chop[v],
f,NumberSigns->{"-","+"},NumberPadding->{"0","0"},SignPadding->True];
(*--------------------------------------------*)
padIt2[v_?numeric,f_List]:=AccountingForm[v,
f,NumberSigns->{"",""},NumberPadding->{"0","0"},SignPadding->True];
(*--------------------------------------------*)
padIt2[v_?numeric,f_Integer]:=AccountingForm[Chop[v],
f,NumberSigns->{"",""},NumberPadding->{"0","0"},SignPadding->True]
(*--------------------------------------------*)
)
]