Bacchetta che si centra automaticamente grazie alla differenza 
fra coefficiente di attrito statico e dinamico

Pesi gravanti su ciascun appoggio

peso=10;

n1[x1_,x2_]:=peso x2/(-x1+x2)

n2[x1_,x2_]:=-peso x1/(-x1+x2)

n[x_,y_]:=peso y/(x+y)

Solve[n1[xx1,xx2]*ffs1 == n2[xx1,xx2]*ffd2,xx2]

Solve[n1[xx1,xx2]*ffd1 == n2[xx1,xx2]*ffs2,xx1]

Valori di partenza per la figura interattiva

χ1=0.8;
χ2=0.7;

fs10=0.5;

fd10=χ1*fs10

fs20=0.25;

fd20=χ2*fs20

x10=-30;
x20=30;

x1=x10;
x2=x20;
p1f=0;
p2f=0;
f1=fd10;
f2=fs20;
lista1={0};
lista2={0};
lista10={0};
lista20={0};
punti1={0,0};
punti2={0,0};



Manipulate[
fd1=fs1*ϵ1;
fd2=fs2*ϵ2;


Animate[(

If[n1[x1,x2]*f1 <  n2[x1,x2]*f2,

(colore1=Red;
colore2=Darker[Green];
lista1=Union[Join[lista1,{p2f}]];
lista10=0*lista1;
punti1=Transpose[{-lista1-x10,lista10}];
f1=fd1;
f2=fs2;
x1=x10+p-p2f;
p1f=p-p2f),



(colore1=Darker[Green];
colore2=Red;
lista2=Union[Join[lista2,{p1f}]];
lista20=0*lista2;
punti2=Transpose[{lista2-x20,lista20}];
f1=fs1;
f2=fd2;
x2=x20-p+p1f;
p2f=p-p1f)];

If[Abs[n1[x1,x2]*f1 -   n2[x1,x2]*f2]<0.051,

EmitSound[Sound[SoundNote[Round[p/2]]]]
(*EmitSound[Sound[SoundNote[Round[p/2],0.51,"HighAgogo"(*"Harpsichord"*)]]]*)];



Show[Graphics[{Thickness[0.0051],

GrayLevel[0.37],Darker[Magenta],
Line[{{x10,0},{-x10,0}}],

Orange,Thin,Thickness[0.00251],

If[n1[x1,x2]*f1 <  n2[x1,x2]*f2,
Line[{{x10,-2f2*n2[x1,x2]},{-x10,-2f2*n2[x1,x2]}}],
Line[{{x10,-2f1*n1[x1,x2]},{-x10,-2f1*n1[x1,x2]}}]
],



PointSize[0.01],
Black,
Point[punti1],
Point[punti2],



Thickness[0.005351],
Arrowheads[0.0423],

colore2,
Arrow[{{x1,0},{x1,2n1[x1,x2]}}],
colore1,
Arrow[{{x2,0},{x2,2n2[x1,x2]}}],


Thickness[0.00351],
Arrowheads[0.023],
colore2,
Arrow[{{x1,0},{x1,-2f1*n1[x1,x2]}}],
colore1,
Arrow[{{x2,0},{x2,-2f2*n2[x1,x2]}}],

Black,Thin,
Circle[{x1,0},Abs[2f1*n1[x1,x2]],{0,-Pi/2}],
Circle[{x2,0},Abs[2f2*n2[x1,x2]],{Pi+Pi/2,Pi}],

colore2,
Rotate[Arrow[{{x1,0},{x1,-2f1*n1[x1,x2]}}],Pi/2,{x1,0}],
colore1,
Rotate[Arrow[{{x2,0},{x2,-2f2*n2[x1,x2]}}],-Pi/2,{x2,0}],

Thickness[0.005351],
Arrowheads[0.0423],
Black,PointSize[0.02],Point[{0,0}],
Arrow[{{0,0},{0,-2n1[x1,x2]-2n2[x1,x2]}}],

}],
PlotRange->{2{-16,17},2{-10,10}},
ImageSize->700,
PlotLabel->"Attrito: bacchetta che si centra automaticamente (M. Guiggiani - 9/3/2020)"]

),
{p,0,65,0.0001,AnimationRate->2},AnimationDirection-> Forward,AnimationRepetitions->1, AnimationRunning->False,SaveDefinitions->False],


{{fs1,fs10,"fs1"},0.1,1.5,Appearance->"Labeled"},
{{ϵ1,χ1,"fd1/fs1"},0.1,0.99,Appearance->"Labeled"},
{{fs2,fs20,"fs2"},0.1,1.5,Appearance->"Labeled"},
{{ϵ2,χ2,"fd2/fs2"},0.1,0.99,Appearance->"Labeled"},
SaveDefinitions->True,
ControlPlacement->Right
]