Here’s the code. First, some helper functions to tell me the center and pole of the rotated sphere:
RotatedCenter[θ_,axis_]:=RotationTransform[θ,axis,{0,0,-1}][{0,0,0}];​​RotatedPole[θ_,axis_]:=RotatedCenter[θ,axis]+{0,0,1};
And then a function which performs stereographic projection from any point
q
to the plane
z=0
:
In[]:=
StereoPointToPlane[p_,q_]:=1/(p[[3]]-q[[3]]){q[[1]]p[[3]]-p[[1]]q[[3]],q[[2]]p[[3]]-p[[2]]q[[3]]};
Finally, the big Manipulate for the animation:
DynamicModule[{axis,θ=Pi/3.,n=15,viewpoint={0,0,2},​​cols=RGBColor/@{"#FF9F1C","#2EC4B6","#E71D36","#011627"}},​​Manipulate[​​axis={Cos[ψ],Sin[ψ],0};​​Graphics3D[{Sphere[​​Append[StereoPointToPlane[​​RotationTransform[θ,axis,{0,0,-1}][Append[#,0]],​​RotatedPole[θ,axis]],0],.075]&/@​​CirclePoints[n]},​​PlotRange->1.2,ViewPoint->viewpoint,Boxed->False,Lighting->​​Append[Table[{"Point",cols[[i]],​​Append[2CirclePoints[3][[i]],0]},{i,1,3}],{"Ambient",cols[[-1]],viewpoint}],​​Background->cols[[-1]],ImageSize->540],​​{ψ,0,2Pi}]​​]