Dynamic visualisation of stereographic projection of the sphere

dynamicStereographicProjectionIn3D.m

stereoTo3D[x_, y_] := 1/(1 + x^2 + y^2) {2 x, 2 y, 1 - x^2 - y^2};

DynamicModule[
  {pt = {0, 0}},
  Row @ {
    LocatorPane[Dynamic @ pt, 
      Graphics[{Gray, Disk[]}, Frame -> True, ImageSize -> 200]
    ],
    Graphics3D[
      {
        {[email protected], Sphere[]},
        {[email protected], InfinitePlane[{0, 0, 0}, {{1, 0, 0}, {0, 1, 0}}]},
        [email protected],
        Dynamic @ Point @ {Append[pt, 0]},
        Dynamic @ Point @ {stereoTo3D @@ pt},
        Dynamic @ {Dashed,
          Line@{{0, 0, -1}, stereoTo3D @@ pt}
        }
      },
      Axes -> True, ImageSize -> 500
    ]
  }
]

Using it to visualise intersection at infinity of parallel lines when embedded in the projective space:

Graphics3D[
 {
  {[email protected], Sphere[]},
  {[email protected], InfinitePlane[{0, 0, 0}, {{1, 0, 0}, {0, 1, 0}}]},
  [email protected],
  Table[{t, t}, {t, Subdivide[-4, 4, 500]}] // {
     Point[Append[#, 0] & /@ #],
     Point[stereoTo3D /@ #]
     } &,
  Red,
  Table[{t, t + 1}, {t, Subdivide[-4, 4, 500]}] // {
     Point[Append[#, 0] & /@ #],
     Point[stereoTo3D /@ #]
     } &
  },
 Axes -> True, ImageSize -> 500, 
 PlotRange -> {{-2, 2}, {-2, 2}, Automatic}
 ]