Trying to Rotate the North Pole View of a Globe

Question

My goal is to generate diagrams like this.

But I would like to be able to rotate the globe about the North Pole, so that I can represent different times of the day.
When I use ImageRotate, the results are a little weird.

That little black spot on the lower left is what was the original black background.
It seems like I'm doing things the hard way again.  I hope there is a better way, but is there a better way to rotate this globe?

Too late now, but here's the code for the original (without the point).
Show[Graphics[{Black, Rectangle[{-1.1, -1.1}, {6, 1.1}], White, Thickness[0.01], Arrowheads[0.04], Table[Arrow[{{6, y}, {1.1, y}}], {y, -1, 1, 0.5}]}], Graphics @@ GeoGraphics[GeoProjection -> "Orthographic", GeoCenter -> {90, 0}, GeoRange -> "World", GeoGridLines -> Automatic, Background -> None], ImageSize -> 800]

kglr · Accepted Answer

Update: It turns out oblique "Orthographic" projection (mentioned in the link provided by J.M.) has been implemented. Using the option "Centering" -> {90, - 30} gives the desired rotation in OP's case without the need for ImageRotate:
Row[GeoGraphics[{PointSize[Large], Point[fresno]}, ImageSize -> 300, 
    GeoRange -> "World", GeoGridLines -> Automatic, 
    GeoBackground -> GeoStyling["StreetMapNoLabels"], 
    GeoProjection -> {"Orthographic", "Centering" -> {90, #}}] & /@ 
 {-30, -60, 45}, Spacer[10]]

Original answer:
fresno = Entity["City", {"Fresno", "California", "UnitedStates"}];

geog1 = GeoGraphics[{PointSize[Large], Point[fresno]}, 
   ImageSize -> 400, GeoRange -> "World", GeoGridLines -> Automatic, 
   GeoBackground -> GeoStyling["StreetMapNoLabels"], 
   GeoCenter -> {90, 0}, GeoProjection -> "Orthographic"];

You can use ImageRotate with  GeoStylingImageFunction as follows and post-process to rotate the Point primitive:
geog2 = GeoGraphics[{PointSize[Large], Point[fresno]}, 
    ImageSize -> 400, GeoRange -> "World", GeoGridLines -> Automatic, 
    GeoBackground -> GeoStyling["StreetMapNoLabels", 
     GeoStylingImageFunction -> (ImageRotate[#, 30 Degree, ImageDimensions@#] &)], 
    GeoCenter -> {90, 0}, GeoProjection -> "Orthographic"] /. 
   Point[x_] :> GeometricTransformation[Point[x], RotationTransform[30 Degree]];

An easier approach is to rotate Rasterized geog1:
raster = Rasterize[geog1, Background -> None];
geog3 = Show[ImageRotate[raster, 30 Degree, ImageDimensions @ raster, 
    Background -> None], ImageSize -> 300]

Row[{geog1, geog2, geog3}, Spacer[10]]

rotate = ImageRotate[raster, #, ImageDimensions @ raster, Background -> None] &;

arrows = Graphics[{Arrowheads[.15], AbsoluteThickness[7], White, 
    Arrow[{Scaled[{2, #}], Scaled[{1, #}]}] & /@ (Range[4 ] / 5)}];

frames = Show[rotate[# Degree], arrows, Background -> Black, 
     PlotRange -> All, ImageSize -> 700] & /@ Range[0, 360, 10];

Export["rotategeog.gif", frames]

Carl Lange · Answer

kglr's updated answer is the more correct option. My less correct answer follows.
There are two tricks here - one to be able to get the same image size regardless of background in the GeoGraphics, and another to use ImageCompose to place one image inside another.
Here we have a function to give back an image of the same size given any rotation. There's a bit of a hack here to make the background of the GeoGraphics and the background of the ImageRotate Purple. Unfortunately when you use ImageRotate on a GeoGraphics, it appears to disregard the alpha channel and cast the background to white (even if you had it set to None or Transparent). We then replace all Purple with Transparent, to get a nice image we can compose with. You also use ImageCrop to get a consistent image size.
rotateGlobe[d_] := 
 ColorReplace[
  ImageCrop@
   ImageRotate[
    GeoGraphics[GeoRangePadding -> 0, ImagePadding -> 0, 
     GeoBackground -> "Coastlines", GeoProjection -> "Orthographic", 
     GeoRange -> "World", GeoGridLines -> Automatic, 
     GeoCenter -> {90, 0}, Background -> Purple, ImageSize -> 400], d,
     Background -> Purple], Purple -> Transparent]

We'll also define your "arrows" to make it more clear what we're doing.
arrows = Graphics[{Black, Rectangle[{-1.1, -1.1}, {6, 1.1}], White, 
   Thickness[0.01], Arrowheads[0.04], 
   Table[Arrow[{{6, y}, {1.1, y}}], {y, -1, 1, 0.5}]}]

And now we can animate the two together. ImageCompose here is your friend, as you have two images with quite different dimensions. I used Scaled a lot, eyeballing scale and position until it looked right.
Animate[
 ImageCompose[arrows, ImageResize[rotateGlobe[d], Scaled[.25]], 
  Scaled[{.18, .5}]],
 {d, -[Pi], [Pi], .1}]

or,
Table[
 ImageCompose[arrows, ImageResize[rotateGlobe[d], Scaled[.25]], 
  Scaled[{.18, .5}]],
 {d, -[Pi], [Pi], 1}]

Trying to Rotate the North Pole View of a Globe

2 Answers

Add your own answers!

Ask a Question