       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
];

{},
(* begining of the code *)
theFile = OpenRead[filename, DOSTextFormat -> False];
Close[theFile];
newdata = Drop[data, 40];
segDict =
}],
7*4];
segDict = FormatIntegers[#, {4, -4, -4, -4, -4, 4, 2, 2}] & /@
segDict;

];

{localDat, result, n, dx, dy, nx, ny},
localDat = Take[data, { segd[] + 1, 16 + segd[] + segd[]}];
sbHeader = FormatIntegers[ Take[ localDat, 4*4], {-4, -4, 4, 2, 2}];
result = { {nx, ny}};

localDat = Drop[localDat, 4*4];
For[n = 1, n <= nstrokes, n++,
If[ BitAnd [localDat[], 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[{{#[], #[]}, {#[], #[]}} & /@ {segd}]
, ,
Print[
{{ Min[ First /@ result], Min[ Last /@ result]},
{ Max[ First /@ result], Max[ Last /@ result]}}];
Print[First[{{#[], #[]}, {#[], #[]}} & /@ {segd}]];
Print["False"];];
result
];

filenameBDY = folderName <> "\\europe\\bdy.cbd";
filenameCIL = folderName <> "\\europe\\cil.cbd";
filenameRIV = folderName <> "\\europe\\riv.cbd";