# Glue a series of images as textures on various points of a sphere

Using the techniques outlined in the answers to this and this questions, it's possible to map images as textures on the surface of a sphere or other object.

These questions, however, consider the case in which one wants to map a single image over the whole surface of a sphere. I am instead trying to plot different images at various points of the sphere.

A first attempt to do this is the following:

testImage[theta_, phi_] :=
Rasterize[
Framed@Text[
"\[Theta]=" <> StringTake[ToString@N@theta, UpTo@3] "\n\[Phi]=" <>
StringTake[ToString@N@phi, UpTo@3]], RasterSize -> {60, 60}];
Show[
Graphics3D[{
Sphere[{0, 0, 0}, 19.9]
}, Axes -> True],
Table[
SphericalPlot3D[
20, {u, theta - 0.1, theta + 0.1}, {v, phi - 0.1, phi + 0.1},
Mesh -> None,
TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Texture[testImage[theta, phi]]],
Lighting -> "Neutral"
],
{theta, Subdivide[0., Pi, 10]},
{phi, Subdivide[0., 2 Pi, 8]}
]
]


which produces This is sort of what I am trying to achieve. However, there is the problem that the spherical coordinates distort the images the more they approach the poles.

I want instead to plot the images without any distortion around any given angle $$(\theta,\phi)$$. Clearly, if the list of images were the same as in this example we would get overlapping images, but that is not really a concern for my actual use case. I am also not concerned about the orientation of any single image, so one can assume that the images have rotational symmetry around their centres.

How can I do this?

Lazy approach is to create a properly shaped polygon with a texture and then rotate it wherever you want with that or replaced texture:

image = First @ SphericalPlot3D[ 1, {t, Pi/2 - .2, Pi/2 + .2}, {f, -.2, .2},
PlotStyle -> Texture@ExampleData[{"TestImage", "Lena"}],
TextureCoordinateFunction -> ({#5, -#4} &), PlotPoints -> 2, Mesh -> None
]

Graphics3D[
{ Sphere[{0, 0, 0}, .99],
image,
GeometricTransformation[ image, RotationTransform[{{1, 0, 0}, {1, 1, 1}}]],
GeometricTransformation[
image /. _Texture -> Texture[ExampleData[{"TestImage", "Airplane"}]],
RotationTransform[{{1, 0, 0}, {1, -1, 1}}]
]
}
] 