A = 0.1;
n=10;(*ばねの個数*)
k= 15;(*全体のばね定数*)
kh = 1;
K =10;
g=9.8;
naturalLength = 0.2;
size = 60;
ini :={
f ={};
m={};(*質量*)
r ={};(*位置ベクトル*)
v ={};
a ={};
Do[
AppendTo[f,{0,0,0}];
AppendTo[r,{0,i*naturalLength,0}];
AppendTo[v,{0,0,0}];
AppendTo[a,{0,0,0}];
AppendTo[m,1],
{i,1,n}
]
}
(* 頂点jから頂点j-1の間の長さを求める*)
len[j_]:= 
If[j ≥ 2,Norm[r[[j]] - r[[j-1]]], Norm[r[[j]]]]

(* 頂点jから頂点j-1に対する単位ベクトルを求める*)
unitVector[j_] := 
If[j ≥ 2, (r[[j]] - r[[j-1]])/len[j],  r[[j]]/len[j]]



fukugen[j_]:=
Which[j== 1,
		f[[j]]=f[[j]]+k(len[j+1] - naturalLength)unitVector[j+1],
	  (j ≥ 2)&&(j < n),
		 f[[j]]=f[[j]]-k(len[j]-naturalLength)unitVector[j]+k(len[j+1]-naturalLength)unitVector[j+1],
           j == n,
		f[[j]]=f[[j]]-k(len[j]-naturalLength)unitVector[j]	
]

tyouban[j_] :=
If[(j ≥ 2)&&(j < n),

thita = Dot[-unitVector [j+1],unitVector[j]]+1;
 nv = Cross[-unitVector [j+1],unitVector[j]];
fi = kh*thita*Cross[nv,-unitVector[j+1]];
fj = -kh*thita*Cross[nv,unitVector[j]];
f[[j-1]] = f[[j-1]]+fj*len[j];
f[[j]] = f[[j]]-fj-fi;
f[[j+1]] =f[[j+1]] +fi *len[j+1];
]

gensui[j_] := 
If[j ≥ 2,
tmp = -K*Dot[(v[[j]]- v[[j-1]]),unitVector[j]]*unitVector[j];
f[[j]] = f[[j]]+tmp;
f[[j-1]] = f[[j-1]] -tmp;
 ]

avoidCollision[j_] := 
If[j ≥ 2,
tmp = -(A/(len[j]+0.01))*unitVector[j];
f[[j]] = f[[j]]+tmp;
f[[j-1]] = f[[j-1]] -tmp;
 ]

juryoku[j_] := f[[j]] = f[[j]]+{0,-m[[j]]*g,0};
ini;

options={AspectRatio->Automatic, PlotRange->{{size,-size},{size,-size},{size,-size}}};
options2D ={AspectRatio->Automatic, PlotRange->{{size,-size},{size,-size}},
		Background->Gray, ImageSize->{600,600}};


getX[j_]:= Part[r2D[[j]], 1];
getY[j_]:= Part[r2D[[j]], 2];
scale = 2;
DynamicModule[
	{col = Green},

EventHandler[
Dynamic[
	f =Table[0,{n},{3}];
	Do[
	juryoku[i];
	
	gensui[i];
	tyouban[i];
	fukugen[i];
	,{i,1,n}];
	f[[1]] = {0,0,0};



	a = f;
	v = v + a *0.05;
	r = r + v * 0.05;
(*
	Do[
	v[[i]] = v[[i]]+a[[i]]*0.05;
	,{i,2,n-1}];

	Do[
	r[[i]] = r[[i]]+v[[i]]*0.05;
	,{i,2,n-1}];
	*)
	
	If[(col == Red ),r[[n]] = Insert[MousePosition["Graphics"],0,-1]
	];
	
	r2D = Drop[r, None, -1];
	
	
	Graphics[{
	Black, Line[r2D],(*糸*)
	(*かえる*)
	col, Disk[r2D[[n]], {2,1}*scale],(*顔*)
	Green, Disk[{getX[n]-scale, getY[n]+scale},0.5*scale],(*目*)
	Green, Disk[{getX[n]+scale, getY[n]+scale},0.5*scale],
	Black, Disk[{getX[n]-scale, getY[n]+scale},0.3*scale],(*黒目*)
	Black, Disk[{getX[n]+scale, getY[n]+scale},0.3*scale],
	Black, Line[{{getX[n]-1.2, getY[n]},{getX[n]+1.2, getY[n]}}](*口*)
	},
	options2D
	]
	

	(*
	Graphics3D[{
	Black,Line[r],
	Red,Sphere[r],
	(*Blue,Cylinder[{{0,0,0},{0,0,size}}, 0.3],*)
	Green,Polygon[{{-size,-size,-size},{-size,size,-size},{size,size,-size},{size,-size,-size}}]}, options]
	*)
]
,{{"MouseClicked",1}:>(col = col /.{Red->Green, Green->Red})}]

]