Trying to make animated gif of zooming into famous [Ford circles](https://en.wikipedia.org/wiki/Ford_circle). With the code

 visibleQ[lh_, hr_, c_, k_] := Which[
 lh >= 1/(2 k), If[2 c k^2 <= 1 && lh^2 < c (1 - c k^2), True, False],
 hr >= 1/(2 k), If[2 c k^2 <= 1 && hr^2 < c (1 - c k^2), True, False],
 True, True]
 t = {}
 With[{center = 1/π, s = 1.04, start = 60},
 Module[{d = s^start},
 For[maxz = start; maxz < 300, maxz++; d *= s,
 With[{a = center - 2/3/d, b = center + 2/3/d, c = 2/3/d, 
 e = -1/120/d},
 AppendTo[t,
 Graphics[
 {
 Line[{{-1, 0}, {2, 0}}],
 Table[
 Map[
 Circle[{#/k, 1/(2 k^2)}, 1/(2 k^2)] &,
 Select[Range[k], 
 visibleQ[a k - #, # - b k, c, k] && CoprimeQ[#, k] &]
 ],
 {k, 12 Sqrt[3 d/2]}
 ]
 },
 ImageSize -> 500, PlotRange -> {{a, b}, {e, c}}
 ]
 ]
 ]
 ]
 ]
 ]
 Export["..\\Desktop\\ford240.gif", t]

(which I adapted from [a Wolfram demonstration](http://demonstrations.wolfram.com/FordCircles/) and optimized a bit) I get this:
[![enter image description here][1]][1]

As you see the circles tremble unpleasantly, and occasionally intersect each other, although according to the formulæ they must always touch only.

How can this be improved?

Searching for similar questions I only found http://mathematica.stackexchange.com/q/94470/35000 but that one is about text and I could not figure out whether it might be useful in any way here.

There is another problem too. It concerns mathematics rather than Mathematica, but still let me ask about it here. By monitoring `maxz` I found out that each next frame renders more slowly than the previous - which is of course understandable as it requires working with larger and larger ranges of `k`. But on the other hand the number of circles in each frame is roughly the same, so in principle there must be a way to program it so that every frame takes roughly the same amount of time. Can it be done?

**Update**

Using the suggestion by J. M. I switched to Farey sequences. This allowed to remove divisibility check, but strangely enough became even slower. I don't know why but now rasterization takes more time.

 visibleQ[a_, b_, c_, x_] := 
 With[{r = 1/(2 Denominator[x]^2)}, Which[
 x <= a - r, If[r c <= 1 && (a - x)^2 < c (2/r - c), True, False],
 x >= b + r, If[r c <= 1 && (x - b)^2 < c (2/r - c), True, False],
 True, True]
 ]
 tocircle[x_] := 
 With[{r = 1/(2 Denominator[x]^2)}, Circle[{x, r}, r]]
 With[{center = 1/π, s = 1.04, start = 60, size = 504},
 Module[{d = s^start},
 For[maxz = start; t = {}, maxz < 300, maxz++; d *= s,
 With[{a = center - 2/3/d, b = center + 2/3/d, c = 2/3/d, 
 e = -1/120/d},
 l = Select[FareySequence[Floor[Sqrt[3 size d]/2]], 
 visibleQ[a, b, c, #] &];
 AppendTo[t,
 Rasterize[
 Graphics[
 {
 Line[{{-1, 0}, {2, 0}}],
 Map[tocircle, l]
 },
 ImageSize -> size, PlotRange -> {{a, b}, {e, c}}
 ]
 ]
 ]
 ]
 ]
 ]
 ]
And there is hardly any improvement on accuracy of the plot.

 [1]: https://i.sstatic.net/Eh5k9.gif