The World, Re-Justified

I just came across this web site describing The World, Justified, a piece of (ASCII) art created by a couple of Brazilians. Very interesting idea. I was able to replicate it using Mathematica 6 in just a few lines of code.

In[1]:=

map = CountryData["World", {"Shape", "Equirectangular"}]

Out[1]=

In[2]:=

g = Rasterize[map, ImageSize→80]

Out[2]=

In[3]:=

raster = First @ Cases[g, _Raster, ∞] ;

In[4]:=

txt = Reverse @ First[raster]/.{ {255, 255, 255} →" ", {_, _, _} →"*"} ;

In[5]:=

CellPrint @ Cell[StringJoin @@ Riffle[StringJoin/@txt, "\n"], FontFamily→"Courier"]

In[6]:=

CellPrint @ Cell[StringJoin @@ Riffle[StringReplace[#, " "→""] &/@txt, "\n"], TextAlignment→Left, FontFamily→"Courier"]

In[7]:=

CellPrint @ Cell[StringJoin @@ Riffle[StringReplace[#, " "→""] &/@txt, "\n"], TextAlignment→Right, FontFamily→"Courier"]

In[8]:=

CellPrint @ Cell[StringJoin @@ Riffle[StringReplace[#, " "→""] &/@txt, "\n"], TextAlignment→Center, FontFamily→"Courier"]