Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Higher resolution WORLD PLOT

• To: mathgroup at smc.vnet.net
• Subject: [mg16064] Higher resolution WORLD PLOT
• From: "Barthelet, Luc" <lucb at ea.com>
• Date: Tue, 23 Feb 1999 03:45:20 -0500
• Sender: owner-wri-mathgroup at wolfram.com

The following code should enable anyone downloading the files at:
ftp://sepftp.stanford.edu/pub/World_Map/ to create the cost lines and
interior border lines and rivers of the world (CIA database).
I have been using the WorldData add-on package but found that it was lacking
resolution when trying to display only one country at a time. This partially
solves the problem (with 32MB of data...). Thanks for the comments in the
package provided by Mathematica which helped me track the original hi-res
data.

I did not invest the time (yet) to arrange this like the add-on packages in
Mathematica 3.0, but I would sure appreciate if anyone was doing it.
There could be some bugs left in the code decompressing the data, but it
seems to work visually.

I will be using this to show the posting of SimCity files at
http://www.lucb.com
So far I have been only using the worldplot, but you will see more details
in the coming weeks.
The site at http://www.lucb.com is an example of a site managed as a
database entirely in Mathematica.
It reads emails saved as text and generate appropriately an update of the
html pages. More on that later.

Luc Barthelet
General Manager
Maxis

----------------------------------------------------------------------------
---

FormatIntegers[l_, b_] := Module[
    {ll, bb, firstb, result},
    ll = l; bb = b; result = {};
    While[ Length[bb] > 0,
      firstb = First[bb]; bb = Rest[bb];
       num = Take[ll, Abs[firstb]]; ll = Drop[ll, Abs[firstb]];
      num = num. Take[{1, 256, 65536, 16777216}, Length[num]];
      Switch[ firstb,
        -2, If[ num >= 32768, num = num - 65536;];  ,
        -4, If[ num >= 2147483648, num = num - 4294967296;];
        ];
      result = Join[result, {num}]
      ];
    result
    ];

ReadFile[filename_] := Module[
      {},
      (* begining of the code *)
      theFile = OpenRead[filename, DOSTextFormat -> False];
data = ReadList[theFile, Byte];
Close[theFile];
      header = Take[data, 40];
      newdata = Drop[data, 40];
header = (#.{1, 256, 65536, 16777216}) & /@  Partition[header, 4];
      segDict = 
        Partition[ Take[data, {1 + header[[2]], header[[2]] + header[[4]]
}], 
          7*4];
      segDict = FormatIntegers[#, {4, -4, -4, -4, -4, 4, 2, 2}] & /@
segDict;
      
       ReadSegment /@ segDict
      
      ];

ReadSegment[ segd_] := Module[
      {localDat, result, n, dx, dy, nx, ny},
      localDat = Take[data, { segd[[6]] + 1, 16 + segd[[6]] + segd[[7]]}];
      sbHeader = FormatIntegers[ Take[ localDat, 4*4], {-4, -4, 4, 2, 2}];
      nstrokes = sbHeader[[4]];
      {nx, ny} = Take[sbHeader, 2];
      result = { {nx, ny}};
      
      localDat = Drop[localDat, 4*4];
      For[n = 1, n <= nstrokes, n++,
        If[ BitAnd [localDat[[2]], 64] == 64,
          (* short version *)
          {dy, dx} = Take[localDat, 2];
          localDat = Drop[localDat, 2];
          If[ dx >= 128, dx = dx - 256, dx = BitXor[dx, 64];];
          If[ dy >= 128, dy = dy - 256];
          ,
          (* long version *)
          dx = Take[localDat, 2].{1, 256};
          localDat = Drop[localDat, 2];
          If[ dx >= 32768, dx = BitOr[dx, 64*256]; dx = dx - 65536;];
          dx = dx*65536 + Take[localDat, 2].{1, 256};
          localDat = Drop[localDat, 2];
          
          dy = Take[localDat, 2].{1, 256};
          localDat = Drop[localDat, 2];
          If[ dy >= 32768, dy = BitOr[dy, 64*256]; dy = dy - 65536;];
          dy = dy*65536 + Take[localDat, 2].{1, 256};
          localDat = Drop[localDat, 2];
          ];
        {nx, ny} += {dx, dy};
        result = Join[result, {{nx, ny}}];
        ];
      
      If[ Length[localDat] != 0, Print["Error in this segment:", segd];];
      If[
        {{ Min[ First /@ result], Min[ Last /@ result]}, 
            { Max[ First /@ result], Max[ Last /@ result]}} == 
          First[{{#[[5]], #[[3]]}, {#[[4]], #[[2]]}} & /@ {segd}]
        , ,
        Print[
          {{ Min[ First /@ result], Min[ Last /@ result]}, 
            { Max[ First /@ result], Max[ Last /@ result]}}];
        Print[First[{{#[[5]], #[[3]]}, {#[[4]], #[[2]]}} & /@ {segd}]];
        Print["False"];];
      result
      ];

filenameBDY = folderName <> "\\europe\\bdy.cbd";
filenameCIL = folderName <> "\\europe\\cil.cbd";
filenameRIV = folderName <> "\\europe\\riv.cbd";
internalBorders = ReadFile[filenameBDY];
externalBorders = ReadFile[filenameCIL];
rivers =  ReadFile[filenameRIV];
Show[Graphics[ 
      {GrayLevel[.75], Line /@ (internalBorders /3600)  , GrayLevel[0], 
        Line /@ (externalBorders /3600),
        RGBColor[.5, .5, 1], Line /@ (rivers /3600)}
      ], AspectRatio -> Automatic, ImageSize -> {640, 480}, Axes -> True];