Applying a texture to part of a sphere

Question

I am trying to texture a sphere with a picture of myself. I don't want it to be stretched across the whole sphere but only to appear on the front. I used

SphericalPlot3D[1, {Theta, 0, Pi}, {Phi, 0, 2 Pi},
  PlotStylye -> Texture[image],
  TextureCoordinateFunction -> ({#5, 1 - #4} &)]

While this fixed the direction of the picture I cannot figure out how to shorten it so it's not stretched across the whole sphere. When I type in ImageDimensions[image,] it gives the image dimensions as {1440, 2560} if that helps at all.

Answer 1

A quick and dirty way to do this is to pad the image with pixels of some inoffensive color, so that the actual meaningful part of the image gets mapped to a smaller portion of the sphere:

image = Import["ExampleData/ocelot.jpg"];
{width, height} = ImageMeasurements[image, "Dimensions"];
image = ImagePad[image, {{2 width, 2 width}, {height, height}}, White];
SphericalPlot3D[1, {Theta, 0, Pi}, {Phi, 0, 2 Pi}, PlotStyle -> Texture[image], 
  TextureCoordinateFunction -> ({#5, 1 - #4} &), ViewPoint -> Left]

The first three lines create a new version of your image that's padded with white pixels on all sides; you'll need to play around with your values to get the aspect ratio right. Projecting this image onto the sphere then yields the following:

Note that I changed the ViewPoint in order to get the image on the "front" of the sphere. With the default viewpoint, you end up with the image about 3/4 of the way to the other side of the sphere.

The other way to do this would be to set TextureCoordinateScaling -> False and then rescale your TextureCoordinateFunction (put numbers in front of #5 and #4 and see what happens.) But I'm not sure if there's a way to do this without having the image repeat itself ad infinitum.

Answer 2

You can achieve this using "Texture". However, to prevent that the whole sphere is covered with the text, you must pad the text with White:

ima = Graphics@Text[Style["Hello", FontSize -> 100]];
{width, height} = ImageMeasurements[ima, "Dimensions"][[;; 2]]
te = ImagePad[ima, {0.5 {width, width}, 0.1 {height, height}}, White];

ParametricPlot3D[{Sqrt[1 - z^2] Sin[ph], Sqrt[1 - z^2] Cos[ph], 
  z}, {ph, 0, 2 Pi}, {z, -1, 1}, 
 TextureCoordinateFunction -> ({-#4, #5} &), 
 PlotStyle -> Directive[Texture[te]], Mesh -> None]