Double Pendulum

(* Drawing of diagram *)
DrawPendula[\[Theta]1_, \[Theta]2_, m1_, m2_, l1_, l2_] :=
  Module[{radius1, radius2}, (
    radius1 = 0.2 (m1/Max[m1, m2])^(1/3);
    radius2 = 0.2 (m2/Max[m1, m2])^(1/3);
    Graphics[{
      PointSize[Large],
      Blue, Point[{0, 0}],
      Orange,
      Line[{{0,
         0}, {l1 Sin[\[Theta]1], -l1 Cos[\[Theta]1]}, {l1 \
Sin[\[Theta]1] + l2 Sin[\[Theta]2], -l1 Cos[\[Theta]1] -
          l2 Cos[\[Theta]2]}}],
      Red, Disk[{l1 Sin[\[Theta]1], -l1 Cos[\[Theta]1]}, radius1],
      Disk[{l1 Sin[\[Theta]1] +
         l2 Sin[\[Theta]2], -l1 Cos[\[Theta]1] - l2 Cos[\[Theta]2]},
       radius2]
      }, PlotRange -> Table[{-1 - l1 - l2, 1 + l1 + l2}, {2}],
     ImageSize -> {500}]
    )];
(* Interface *)
doublepend[\[Theta]1_, \[Theta]2_, d\[Theta]1_, d\[Theta]2_, m1_, m2_,
    l1_, l2_, g_, \[Alpha]_, ta_] :=
  Module[{eqns, soln, A, B, plot, \[Alpha]2},
   \[Alpha]2 = \[Alpha] B'[t];
   eqns = {m2 l2 B''[t] + m2 l1 A''[t] Cos[A[t] - B[t]] -
       m2 l1 (A'[t]^2) Sin[A[t] - B[t]] +
       m2 g Sin[B[t]] + \[Alpha]2 m2 l2 ==
      0, (m1 + m2) l1 A''[t] + m2 l2 B''[t] Cos[A[t] - B[t]] +
       m2 l2 (B'[t]^2) Sin[A[t] - B[t]] +
       g (m1 + m2) Sin[A[t]] + \[Alpha] A'[t] (m1 + m2) == 0,
     A[0] == \[Theta]1, A'[0] == d\[Theta]1, B[0] == \[Theta]2,
     B'[0] == d\[Theta]2};
   soln =
    NDSolve[eqns, {A, B}, {t, ta - ta/5 - 0.6, ta},
     MaxSteps -> Infinity, PrecisionGoal -> 10];
   If[ta < 25,
    plot =
     ParametricPlot[{{l1 Sin[A[t]], -l1 Cos[A[t]]}, {l1 Sin[A[t]] +
          l2 Sin[B[t]], -l1 Cos[A[t]] - l2 Cos[B[t]]}} /. soln, {t,
       ta - ta/5 - 0.5, ta}];
    Show[First[DrawPendula[A[ta], B[ta], m1, m2, l1, l2] /. soln],
     plot],
    Graphics[Text[Style["(Solution now unstable, probs)", Large]],
     ImageSize -> {500}]
    ]
   ];

Manipulate[
 doublepend[\[Theta]1, \[Theta]2, d\[Theta]1, d\[Theta]2, m1, m2, l1,
  l2, g, \[Alpha], ta]
 ,
 {{\[Theta]1, 7 Pi/8,
   "Initial \!\(\*SubscriptBox[\"\[Theta]\", \"1\"]\)"}, 0, 2 Pi},
 {{\[Theta]2, Pi/3,
   "Initial \!\(\*SubscriptBox[\"\[Theta]\", \"2\"]\)"}, 0, 2 Pi},
 {{d\[Theta]1, 2,
   "Initial \!\(\*SubscriptBox[\"\[Theta]\", \"1\"]\)'"}, -5, 5},
 {{d\[Theta]2, 1,
   "Initial \!\(\*SubscriptBox[\"\[Theta]\", \"2\"]\)'"}, -5, 5},
 {{m1, 1, "\!\(\*SubscriptBox[\"m\", \"1\"]\)"}, 0.1, 5},
 {{m2, 2, "\!\(\*SubscriptBox[\"m\", \"2\"]\)"}, 0.1, 5},
 {{l1, 1.5, "\!\(\*SubscriptBox[\"l\", \"1\"]\)"}, 0.1, 5},
 {{l2, 1, "\!\(\*SubscriptBox[\"l\", \"2\"]\)"}, 0.1, 5},
 {{g, 10, "gravity"}, 0, 20},
 {{\[Alpha], 0.1, "friction"}, 0, 0.5},
 {{ta, 0.001, "animate"}, 0.001, Infinity, 0.05,
  ControlType -> Trigger}
 ]