Here is an attempt:
pointP[s_] = {0, s};
Assuming[0 < s < 2,
pointQ[s_] = SolveValues[{x, y} \[Element] Circle[{0, 0}, s] &&
{x, y} \[Element] Circle[{1, 0}, 1] &&
y > 0,
{x, y}][[1]];
pointR[s_] = SolveValues[{x, y} \[Element] InfiniteLine[{pointQ[s],
pointP[s]}] &&
y == 0,
{x, y}][[1]]];
Manipulate[Graphics[{Circle[{0, 0}, r], Circle[{1, 0}, 1],
PointSize[Large], Point[{pointQ[r], pointP[r], pointR[r]}],
InfiniteLine[{pointQ[r], pointP[r]}]},
Axes -> True, PlotRange -> {{-2, 4.5}, {-2, 3}}],
{{r, 3/2}, 0, 2}]
