Cross posted on mathematica.stackexchange - https://mathematica.stackexchange.com/q/144167/5478

Question

Given a list of points on a sphere and the sphere/radius I'd like to plot a spherical polygon with vertices in those points.

And this needs to be fast, fast enough for the user to not "feel" generation time.

One should be able to style them too. Most importantly the surface but an edge style would be nice aswell.

What have I tried?

• https://mathematica.stackexchange.com/q/78705/5478

This is very closely related topic but answers there are not fast enough for my needs.

• J.M.'s answer from https://mathematica.stackexchange.com/q/126075/5478

Is great but "only good for making spherical quadrilaterals, or isosceles spherical triangles".

• ClipPlanes in V11+ can be used as a directive which is very effective:

    RandomSeed[3];
    pts = Normalize /@ RandomReal[{-1, 1}, {3, 3}]

    Graphics3D[
       {AbsolutePointSize@12, Point@pts,
        Red, Sphere[{0, 0, 0}, .999], Blue,
        Style[Sphere[], ClipPlanes -> {
           InfinitePlane[{#, #2, {0, 0, 0}}],
           InfinitePlane[{{0, 0, 0}, #3, #}],
           InfinitePlane[{{0, 0, 0}, #2, #3}]
           },
         ClipPlanesStyle -> Directive[Opacity@.2, Red]]
        }
       ] & @@ pts

But I'd need to write some code to determine in what order should those points be put in InfinitePlanes in order to clip from the right side (ClipPlane orientation). I didn't do this because I was too lazy and because:

> The number of clipping planes that can be implemented with ClipPlanes is limited by available graphics hardware.

So it won't be general enough. Though if you want to make this method automatic I will gladly upvote it.

Motivation

I think it will be useful in many applications.

I don't have time for this but I thought it would be a nice feature to have to improve code I was playing with lately, mostly based on another J.M.'s answer - Voronoi grid on a sphere

arc[center_?VectorQ, {start_?VectorQ, end_?VectorQ}] :=  Module[{ang, co, r}, ang = VectorAngle[start - center, end - center];
  co = Cos[ang/2]; r = EuclideanDistance[center, start];
  {{start, center + r/co Normalize[(start + end)/2 - center], end}, co}
  ]

points = {2 \[Pi] #1, ArcCos[2 #2 - 1]} & @@@ RandomReal[1, {10, 2}];

sp = Append[Sin[#2] Through[{Cos, Sin}[#1]], Cos[#2]] & @@@ points;

proc[] := (
   ch = ConvexHullMesh[sp];
   verts = MeshCoordinates[ch]; polys = First /@ MeshCells[ch, 2];

   voro = Normalize[ Cross[verts[[#2]] - verts[[#1]],  verts[[#3]] - verts[[#1]]]] & @@@ polys;

   edges =  arc[{0, 0, 0}, voro[[##]]] & /@      Select[Subsets[Range[Length[polys]], {2}],       Length[Intersection @@ polys[[#]]] >= 2 &];

   );

proc[];

DynamicModule[{run = True},  Graphics3D[{ {Opacity[.75],
    DynamicWrapper[EventHandler[Sphere[],
      "MouseMoved" :>  Module[{pos = MousePosition["Graphics3DBoxIntercepts", True], 
         pt},  If[
         Not@TrueQ@pos , pt = RegionIntersection[Sphere[], Line@pos];
         If[pt =!= EmptyRegion[3],  sp[[-1]] = First@Nearest[pt[[1]], pos[[1]]]; proc[]]  ]]]         
     , TrackedSymbols :> {run}         
     ]
    }
   , {AbsoluteThickness[2], 
    Dynamic[BSplineCurve[#, SplineDegree -> 2, 
        SplineKnots -> {0, 0, 0, 1, 1, 1}, 
        SplineWeights -> {1, #2, 1}] & @@@ edges]}
   , {Red, Sphere[Most@sp, .02], Dynamic@Sphere[Last@sp, .02]}
   }
  , PlotRange -> 1.1    , SphericalRegion -> True   , ImageSize -> 500]
 ]

To look more like https://www.jasondavies.com/maps/voronoi/