Pensieve header: Planet Earth centered at some specific point. Much obliged to pensieve://Projects/PlanetHopf/.

(AllCountries = Union[Take[CountryData["Countries"], All], {"Antarctica"}]);

AllCountries

Area[reg_Region] := Abs[Dot[
Sin[List @@ Last /@ reg],
((RotateLeft[#]-#)& )@ (List @@ First /@ reg)
]];
Area[c_CountryShape] := (Plus @@ Area /@ c);
Area[s_String] := Area[CountryShape[s]];

CountryShape[c_String] := Sort[
Select[
Map[(LonLat@@N[# Degree])&,
Apply[Region,
CountryShape @@ First[CountryData[c, "SchematicPolygon"]],
{1}
],
{2}
],
Area[#]>10^(-5)&
],
Area[#]&
]
(* /. LonLat[ln_, lt_] :> LonLat[-Pi/2+ln, lt] *)

MakeColourScheme[ac_List, newborders_List] := Module[
{c, nbd, cnbd, addborders, k, oc, nc, changes, change},
(nbd[#] = CountryData[#,"BorderingCountries"])& /@ ac;
addborders[{c1_, c2_}] := (
nbd[c1] = Union[nbd[c1], {c2}];
nbd[c2] = Union[nbd[c2], {c1}];
);
addborders[l_List] := Do[
addborders[{l[[i]], l[[j]]}],
{i, 2, Length[l]}, {j, i}
];
addborders /@ newborders;
(CountryColour[#] = RandomReal[])& /@ AllCountries;
changes={}; change=0;
Do[
Do[
cnbd = Sort[CountryColour /@  nbd[c]];
If[cnbd ≠ {},
AppendTo[cnbd, 1+First[cnbd]];
{k}=Ordering[Rest[RotateRight[cnbd]-cnbd], 1];
oc = CountryColour[c];
nc = FractionalPart[(cnbd[[k]]+cnbd[[k+1]])/2];
oc = Abs[oc-nc]; If[oc>0.5, oc=1-oc];
change += oc;
CountryColour[c] = nc
],
{c, AllCountries}
];
AppendTo[changes, change];
change=0,
{32}
];
Print["Country colouring process changes: ", changes]
];
MakeColourScheme[ac_] := MakeColourScheme[ac, {}];
LoadColourScheme[s_String] := Module[
{rule},
rule=Get[s<>".m"];
(CountryColour[#] = (#/.rule))& /@ (First /@ rule);
];
SaveColourScheme[] := SaveColourScheme[
DateString[{"YearShort","Month","Day","-","Hour24","Minute","Second"}]
];
SaveColourScheme[dt_String] := Module[
{},
Put[
(# -> CountryColour[#])& /@ AllCountries,
dt<>".m"
];
Export[dt<>".png",
Graphics[{
EdgeForm[White],
{
Hue[CountryColour[#]],
CountryShape[#] /. {CountryShape  -> List, Region[pts___] :> Polygon[{pts} /. LonLat-> List]}
}& /@ 
(AllCountries)
},
Background -> Black, ImageSize -> 640
]
]
]

MakeColourScheme[AllCountries,{
{"Canada", "Greenland"}, {"Canada", "Russia"}, {"UnitedStates", "Russia"}, {"Canada", "Mexico"}, {"Malaysia", "PapuaNewGuinea"}, {"Japan", "Russia"}, {"Japan", "SouthKorea"}, 
{"Kazakhstan", "Mongolia"}, {"Australia", "NewZealand"}, {"Australia", "Indonesia"}, {"Australia", "PapuaNewGuinea"}, {"China", "Japan"}, {"China", "SouthKorea"}, {"NorthKorea", "Japan"}, {"UnitedStates", "Greenland"}, {"Greenland", "Russia"}, {"Pakistan", "Tajikistan"}, {"Canada", "Japan"}, {"Canada", "Italy"}, {"Italy", "Japan"}, {"Italy", "Germany"}, {"France", "UnitedKingdom"}
}]

MapCenteredAt[coord_String, excl___] := MapCenteredAt[FromDMS[coord] Degree // N, excl];
MapCenteredAt[{BLat_, BLon_}]  := MapCenteredAt[{BLat, BLon}, {}] ;
MapCenteredAt[{BLat_, BLon_}, excl_List] := Module[{M, P, Draw},
M=RotationMatrix[(({{Cos[BLat]Cos[BLon], 0}, {Cos[BLat]Sin[BLon], 0}, {Sin[BLat], 1}}))//Transpose];
P[LonLat[θ_,ϕ_]] := (
{x,y,z}=M.{Cos[ϕ]Cos[θ],Cos[ϕ]Sin[θ], Sin[ϕ]};
(*(Sqrt[(1/(2(1+z)))]){x,y}*)  ((ArcCos[z])/(π(Sqrt[1-(z^2)]))){x,y}
);
Draw[c_String] := {Hue[CountryColour[c]], (List @@ CountryShape[c])/. {Region[pts___] -> Polygon@{pts}} /. p_LonLat :> P[p]};
Graphics[{Circle[{0,0},1], Draw /@ Complement[AllCountries, excl]}]
]

MapCenteredAt["43° 42′ 0″ N, 79° 24′ 0″ W"]

MapCenteredAt["24°51′36″N 67°0′36″E"]

MapCenteredAt@"31° 47′ 0″ N,35° 13′ 0″ E"

CityData["Sydney", "Coordinates"]

MapCenteredAt[CityData["Sydney", "Coordinates"] Degree]

CityData["Jerusalem", "Coordinates"]

MapCenteredAt[{-31.78`,180+35.22`} Degree, {"Israel", "WestBank", "Jordan"}]