Scraping High-Res images from the MoMA and the Van Gogh Museum websites

Question

Many art websites allow the user to zoom into an image to see it at high resolution by using image tiles. It is great on the website, but presents problems if one wishes to compile a complete high resolution picture from these tiles. I am currently using the following:

mOMA[name_, catalogueNumber_] := 
With[{src = 
Import[StringJoin["http://www.moma.org/collection/works/", 
  ToString[catalogueNumber], "?locale=en"], "Source"]}, 
With[{aa = 
 StringReplace[
  StringReplace[
   StringDrop[
    StringTake[src, 
     StringPosition[src, "allZoomBounds"][[1, 1]] - 11], 
    StringPosition[src, "allImageTiles"][[1, 2]] + 2], 
   "/media/" -> "http://www.moma.org/media/"], "]]" -> ","]}, 
With[{bb = StringDrop[aa, (Last@StringPosition[aa, "[["])[[2]]]}, 
With[{cc = {Length@StringPosition[bb, "["], Length@bb}}, 
 With[{dd = 
    StringReplace[StringReplace[bb, "[" -> ""], "]" -> ""]}, 
  With[{ee = StringPosition[dd, ","][[All, 1]]}, 
   With[{ccc = {Length@ee/(cc[[1]] + 1), (cc[[1]] + 1)}}, 
    With[{d1 = StringReplace[bb, "[" -> ""]}, 
     With[{d2 = Length@StringPosition[d1, "]"][[All, 1]] + 1}, 
      With[{cccc = {(Length@ee)/d2, d2}}, 
       With[{ff = 
          StringReplace[
             StringReplace[
              StringDrop[StringTake[dd, ee[[#]]], 
               If[# == 1, 0, ee[[# - 1]] + 1]], "\"" -> ""], 
             "," -> ""] & /@ Range@(Times @@ ccc)}, 
        With[{img = {ff, cccc}}, 
         With[{imgim = Import[#] & /@ img[[1]]}, 
          Rasterize[
           ImageAssemble[
            Table[imgim[[#]] & /@ (x + 
                img[[2, 1]] Range[0, img[[2, 2]] - 1]), {x, 1, 
              img[[2, 1]]}]], ImageResolution -> 100, 
           ImageSize -> 600]
          ]]]]]]]]]]]]] 

which works with something like mOMA[Picasso_Minotauromachy _ 1935, 60110], but seems like an awful lot of fiddling to isolate & ImageAssemble relevant image tiles (which on the MOMA site are sandwiched between allImageTiles and allZoomBounds in the source code). Is there a more straightforward way, eg with Cases and "XMLObject", or similar?

Update

In response to requested edits below, the following is the basis of the code:

With[{src = Import[StringJoin["http://www.moma.org/collection/works/", 
ToString[60110], "?locale=en"], "Source"]}, 
StringReplace[StringReplace[StringDrop[StringTake[src, StringPosition[src, 
"allZoomBounds"][[1, 1]] - 11], StringPosition[src, "allImageTiles"][[1, 2]] 
+ 2], "/media/" -> "http://www.moma.org/media/"], "]]" -> ","]]

with the rest of the code botched together to isolate each tile (each http string is a tile).

I agree that the code above, as presented is rather unreadable, with a load of nested With arguments that probably don't help. I will do my best to format appropriately, but am giving basic info in update for now, to hopefully clarify things a bit.

Update 2

Using @belisarus' code, thithe following works for the specific image request from @bills in the comments

With[{aa = ToExpression@Most[StringDrop[#, 2] & /@StringCases[
Import["https://vangoghmuseum-assetserver.appspot.com/tiles?id=\
4820945634066432", "Text"], Shortest["url" ~~ a : __ ~~ "},"] -> a]]},
Rasterize[ImageAssemble[Table[Import@# &@aa[[x + 15*#]], {x, 1, 15}] & /@   
Range[0, 9]], ImageResolution -> 100, ImageSize -> 600]]

... still working on generalisation.

Generalisation

doc = d0364V1968;
pollard = With[{num = StringReplace[StringReplace[StringReplace[StringCases[
Import[StringJoin["http://www.vangoghmuseum.nl/en/collection/", 
ToString[doc]], "Text"], Shortest["tiles?id=" ~~ a : __ ~~ "data"] -> a], 
"\"" -> ""], "\n" -> ""], " " -> ""][[1]]},
With[{aa = 
  Import[StringJoin[
    "https://vangoghmuseum-assetserver.appspot.com/tiles?id=", 
    num], "Text"]}, 
With[{x = 
   Max@ToExpression@
     StringReplace[
      StringDrop[#, 3] & /@ (StringTake[#, 5] & /@ 
         StringCases[aa, Shortest["x" ~~ a : __ ~~ "},"]]), 
      "," -> ""]},
With[{y = 
    Max@ToExpression@
      StringReplace[
       StringDrop[#, 3] & /@ (StringTake[#, 5] & /@ 
          StringCases[aa, Shortest["y" ~~ a : __ ~~ "},"]]), 
       "," -> ""]},
With[{bb = 
     ToExpression@
      Most[StringDrop[#, 2] & /@ 
        StringCases[aa, Shortest["url" ~~ a : __ ~~ "},"] -> a]]},
   Rasterize[ImageAssemble[
    Table[Import@# &@bb[[xx + (x + 1)*#]], {xx, 1, x + 1}] & /@ 
     Range[0, y - 1]], ImageResolution -> 100, ImageSize -> 600]
   ]]]]]

Disclaimer

Please read the terms of use for images from each website before assembling large image sizes from tiles (hence the use of Rasterize and setting appropriate ImageResolution).

Answer 1

MoMA

res= {1,2,3..} is the resolution.Use res = -1 for the max available resolution, but beware of a shipload of lawyers, middle managers, telephone sanitisers and hairdressers that may try to prosecute you if you use a value greater than 1,

moma[catalogueNumber_, res_] := 
  Module[{m = "http://www.moma.org", src, sj, rep, exp, a},
  rep = {"]" -> "}", "[" -> "{"};
  exp = Shortest["allImageTiles =" ~~ a : __ ~~ ";"] -> a;
  src = Import[StringJoin[m, "/collection/works/", ToString@catalogueNumber], "Source"];
  sj = Map[Import[m <> #] &, (ToExpression@
                         StringReplace[StringCases[src, exp], rep])[[1,1,res]], {2}];
  ImageAssemble@Transpose@sj]

moma[60110, 1]

Answer 2

Van Gogh Museum

Here is the same for the tiles structure of the Van Gogh Museum at @bills' request. Note that the structure is completely different. I preserved the same resolution convention:

vanInTheSkyWithLucy[catalog_, res_] := 
 Module[{i, df, zooms, c, maxXY, t}, 
  i = Import["http://www.vangoghmuseum.nl/en/collection/" <> catalog, "XMLObject"];
  df = First@  Cases[i, XMLElement[__, {___, "data-url" -> a__, ___}, ___] -> a, ∞];
  zooms = Reverse["levels" /. Import[df, "JSON"]];
  If [$VersionNumber >= 10,
     c = Cases[#, {"x" -> x_, "y" -> y_, "url" -> u_} :>{x, y,  u},∞],
     c = Cases[#, {"url" -> u_, "x" -> x_, "y" -> y_} :>{x, y,  u},∞]] &@zooms[[res]];
  maxXY = Max /@ (Transpose[c][[;; 2]]) + 1;
  t = ConstantArray[1, Reverse@maxXY];
  (t[[#[[2]] + 1, #[[1]] + 1]] = #[[3]]) & /@ c;
  ImageAssemble@Map[Import, t, {2}]]

vanInTheSkyWithLucy["d0364V1968", 1]

Warning The code works differently on V9 and V10, so I added a version check.Thanks lot to @bills for the debugging! Apparently the JSON import works differently.