BeginPackage["Minard`"]

Minard::usage = "Minard.m is a package for producing thematic maps
in the style of C. J. Minard"

ProcessTemp::usage = "ProcessTemp[list] computes the graphics primitives to be associated with a list of elements of the form {x, y, temp}"

stuff::usage = "stuff[list] computes the graphics primitives to be associated with a list of elements of the form {x, y, strength}"

ProcessStrength::usage = "ProcessStrength[list] computes the graphics primitives to be associated with a list of elements of the form {{x1, y1, strength1},....., {xn, yn, strengthn}}"

ProcessRivers::usage = "ProcessRivers[list] computes the graphics primitives to be associated with a list of river coordinates"

ProcessPoints::usage = "ProcessPoints[list] computes the graphics primitives to be associated with a list of city or other point coordinates"

ProcessTitle::usage = "ProcessTitle[location, title] computes the graphics primitives to be associated with the title"

ProcessBoxes::usage = "ProcessBoxes[list] computes the graphics primitives to be associated with a list of box coordinates"

ProcessText::usage = "ProcessText[list] computes the graphics primitives to be associated with a list of coordinates and associated text"

NapoleonicMarchOnMoscowAndBackAgainPlot::usage = 
"NapoleonicMarchOnMoscowAndBackAgainPlot[strength_list, temp_list, riverdata_list, boxdata_list, titledata_list, pointdata_list, textdata_list] shows the thematic chart associated with the strength temperature, river, box, title, point and text lists, in the style of C. J. Minard."

Begin["`Private`"]

ProcessTemp[tdata_] :=
Module[{tprimlist, coords = Array[coordarr, 100], numb, k,
temprules, firstx, lastx},
temprules = {0, -10, -20, -30};
firstx = First[tdata][[1]];
lastx = Last[tdata][[1]];
tprimlist = Map[({Thickness[0.001], Line[{{firstx, 0.0916 + 0.00188333*#}, 
{lastx, 0.0916 + 0.00188333*#}}]})&, temprules];
numb = Length[tdata];
Do[
coords[[k]] = {tdata[[k, 1]], 0.0916 + tdata[[k,3]]*0.0018833}
,{k, 1, numb}];
Do[
tprimlist = Append[tprimlist, 
{Thickness[0.001], Line[{tdata[[k, Range[2]]] , coords[[k]]} ]}];
,{k, 1, numb}];
Do[
tprimlist = Append[tprimlist, 
{Thickness[0.001], Line[{coords[[k]] , coords[[k+1]]} ]}];
,{k, 1, numb-1}];
tprimlist]

stuff[sd_] := Module[{k, m, primlist,pca, pcb, pcc, pcd,
scale, dir = Array[dirarr, 100], 
rotdir = Array[rotdirarr, 100], 
l = Array[larr, 100],
avevec  = Array[avevecarr, 100]},
scale = 10500000;
primlist = { };
k = Length[sd];
Do[(dir[[m]] = sd[[m+1, Range[2] ]] - sd[[m, Range[2] ]];
l[[m]] = Sqrt[dir[[m, 1]]^2 + dir[[m, 2]]^2]),
{m, 1, k-1}];
Do[
If[l[[m]] > 0.0001,
rotdir[[m]] = {-dir[[m, 2]], dir[[m, 1]]}/l[[m]], 
rotdir[[m]] = 
{-dir[[m+1, 2]], dir[[m+1, 1]]}/l[[m+1]]], 
{m, 1, k-1}];
avevec[[1]] = rotdir[[1]];
avevec[[k]] = rotdir[[k-1]];
Do[
avevec[[m]] = 
(rotdir[[m]] + rotdir[[m-1]])/(1 + 
rotdir[[m,1]]*rotdir[[m-1,1]]
+ rotdir[[m,2]]*rotdir[[m-1,2]]), {m, 2, k-1}];
Do[
pca = sd[[m,Range[2]]] - sd[[m,3]]*avevec[[m]]/scale;
pcb = sd[[m+1,Range[2]]] - sd[[m+1,3]]*avevec[[m+1]]/scale;
pcc = sd[[m+1,Range[2]]] + sd[[m+1,3]]*avevec[[m+1]]/scale;
pcd = sd[[m,Range[2]]] + sd[[m,3]]*avevec[[m]]/scale;
u = {If[sd[[m, 4]] == 1,
RGBColor[0,1,0],
RGBColor[0,0,0]], 
Polygon[{pca, pcb, pcc, pcd}]};
primlist = Append[primlist, u],
{m, 1, k-1}];
primlist]

ProcessStrength[data_] :=
Module[{strengthprims, str, len, v},
strengthprims = {};
len = Length[data];
Do[
(strengthprims = 
Append[strengthprims, stuff[data[[v]]]]),
{v, 1, len}];
strengthprims
]

ProcessTitle[titledata_] := 
Text[FontForm[titledata[[1, 3]],{"Helvetica-Bold", 14}],
 {titledata[[1, 1]], titledata[[1, 2]]}]

ProcessPoints[pointdata_] := 
Map[({Point[Drop[#, -1]], Text[FontForm[Last[#], {"Times-Roman",   8}], 
Drop[#, -1]+{0.01,0.01}, {0, -1}]})&, pointdata]

ProcessText[textdata_] := 
Map[(Text[FontForm[Last[#], {"Times-Roman",   6}], Drop[#, -1], {0, -1}])&,  textdata]

ProcessRivers[riverdata_] := 
Map[({RGBColor[0, 0, 1], Thickness[0.001], Line[#]}&), riverdata]

ProcessBoxes[boxdata_] := 
Map[({RGBColor[0, 0, 0], Thickness[0.002], Line[#]}&), boxdata]

NapoleonicMarchOnMoscowAndBackAgainPlot[sdata_, tdata_, riverdata_, boxdata_, titledata_, pointdata_, textdata_] := 
Show[Graphics[
{ProcessStrength[sdata],
 ProcessTemp[tdata],
 ProcessRivers[riverdata],
 ProcessBoxes[boxdata],
 ProcessTitle[titledata],
 ProcessPoints[pointdata],
 ProcessText[textdata]}
]]

Minard[] :=
NapoleonicMarchOnMoscowAndBackAgainPlot[
	StrengthData,
	TempData,
	RiverData,	(* river *)
	BoxData,
	TitleData,	(* title *)
	PointData,	(* point *)
	TextData		(* text *)
	]

TempData = {
{0.955, 0.306, 0},
{0.885, 0.304, 0},
{0.7, 0.259, -9},
{0.612, 0.228, -21},
{0.433, 0.177, -11},
{0.372, 0.17, -20},
{0.316, 0.201, -24},
{0.279, 0.181, -30},
{0.158, 0.195, -26}
};

RiverData = {{{0.39, 0.123}, {0.39, 0.131}, {0.388, 0.135}, {0.388, 0.14}, {0.382, 0.144}, 
  {0.382, 0.152}, {0.378, 0.156}, 
  {0.38, 0.17}, {0.376, 0.17}, {0.378, 0.177}, {0.374, 0.187}, {0.376, 0.195}, {0.372, 0.199}, {0.366, 0.199}, 
   {0.357, 0.203}, {0.349, 0.214}}, {{0.513, 0.123}, {0.513, 0.133}, {0.511, 0.138}, {0.509, 0.15}, {0.517, 0.166}, 
   {0.517, 0.181}, {0.509, 0.185}, {0.511, 0.195}, {0.509, 0.199}, {0.511, 0.207}, {0.513, 0.212}, {0.522, 0.226}, 
   {0.536, 0.23}, {0.548, 0.23}, {0.55, 0.234}}, 
  {{0.0702, 0.121}, {0.0712, 0.13}, {0.076, 0.134}, {0.077, 0.142}, {0.0721, 0.148}, {0.0673, 0.153}, 
   {0.0653, 0.156}, {0.0692, 0.161}, {0.0721, 0.165}, {0.0712, 0.169}, {0.0692, 0.173}, {0.0692, 0.175}, 
   {0.0712, 0.179}, {0.076, 0.184}, {0.076, 0.191}, {0.0702, 0.202}, {0.0692, 0.212}, {0.0682, 0.218}, 
   {0.0624, 0.222}, {0.0575, 0.224}, {0.0546, 0.23}, {0.0575, 0.238}, {0.0585, 0.245}, {0.0585, 0.251}, 
   {0.0546, 0.255}, {0.0546, 0.259}, {0.0507, 0.265}, {0.0507, 0.271}, {0.0448, 0.275}, {0.039, 0.276}, 
   {0.0331, 0.275}, {0.0292, 0.277}, {0.0292, 0.283}, {0.0292, 0.287}, {0.0224, 0.286}, {0.0175, 0.281}, 
   {0.0146, 0.278}, {0.0107, 0.278}, {0.00487, 0.278}}, 
  {{0.847, 0.363}, {0.847, 0.365}, {0.847, 0.371}, 
   {0.844, 0.374}, {0.843, 0.379}, {0.841, 0.381}, {0.833, 0.382}, 
   {0.830, 0.383}, {0.828, 0.383}, {0.825, 0.383}, {0.822, 0.383}, {0.821, 0.385}, {0.817, 0.386}, 
   {0.814, 0.388}, {0.813, 0.392}, {0.811, 0.394}, {0.809, 0.397}, {0.807, 0.4}, 
   {0.804, 0.402}, {0.804, 0.405}, {0.802, 0.407}, {0.798, 0.411}, {0.794, 0.415}}};
	
armydata = {
{{1812,10,18},100000},
{{1812,10,24}, 96000},
{{1812,11, 1}, 87000},
{{1812,11, 4}, 87000},
{{1812,11, 4}, 55000},
{{1812,11, 9}, 55000},
{{1812,11, 9}, 37000},
{{1812,11,14}, 37000},
{{1812,11,14}, 24000},
{{1812,11,19}, 24000},
{{1812,11,19}, 20000},
{{1812,11,25}, 20000},
{{1812,11,25}, 50000},
{{1812,11,28}, 50000},
{{1812,11,28}, 28000},
{{1812,12, 6}, 12000},
{{1812,12, 7},  8000}
};

StrengthData = {
{
{0.142, 0.238, 50000, 1},
{0.257, 0.331, 50000, 1},
{0.312, 0.326, 50000, 1},
{0.312, 0.326, 33000, 1},
{0.392, 0.318, 33000, 0}
},
{
{0.392, 0.318, 30000, 0},
{0.433, 0.177, 30000, 0}
},
{
{0.105, 0.242, 22000, 1},
{0.111, 0.351, 22000, 1}
},
{
{0.103, 0.353,  6000, 0},
{0.0916,0.193,  6000, 0}
},
{
{0.0565, 0.23, 422000, 1},
{0.105, 0.242, 422000, 1},
{0.105, 0.242, 400000, 1},
{0.181, 0.234, 400000, 1},
{0.181, 0.234, 340000, 1},
{0.333, 0.273, 257000, 1},
{0.476, 0.288, 175000, 1},
{0.595, 0.250, 145000, 1},
{0.704, 0.290, 136000, 1},
{0.789, 0.368, 127000, 1},
{0.84 , 0.355, 127000, 1},
{0.84,  0.355, 100000, 1},
{0.856, 0.349, 100000, 1},
{0.955, 0.4  , 100000, 1}
},
{
{0.965, 0.382, 100000, 0},
{0.953, 0.374, 100000, 0},
{0.945, 0.312, 100000, 0},
{0.932, 0.302,  98000, 0},
{0.838, 0.326,  87000, 0},
{0.768, 0.296,  87000, 0},
{0.768, 0.296,  55000, 0},
{0.7,   0.259,  55000, 0},
{0.7  , 0.259,  37000, 0},
{0.612, 0.228,  37000, 0},
{0.612, 0.228,  24000, 0},
{0.511, 0.209,  24000, 0},
{0.511, 0.209,  20000, 0},
{0.433, 0.177,  20000, 0},
{0.433, 0.177,  50000, 0},
{0.390, 0.162,  50000, 0},
{0.380, 0.164,  50000, 0},
{0.380, 0.164,  28000, 0},
{0.316, 0.201,  22000, 0},
{0.279, 0.181,  22000, 0},
{0.248, 0.191,  14000, 0},
{0.158, 0.195,   8000, 0},
{0.125, 0.193,   8000, 0},
{0.125, 0.193,   4000, 0},
{0.0916,0.193,   4000, 0},
{0.0916,0.193,  10000, 0},
{0.0682,0.193,  10000, 0}
}};

BoxData = {
{
{0, 0.121},
{1.05, 0.121},
{1.05, 0},
{0, 0},
{0, 0.121}
},
{
{0, 0.121}, 
{1.05, 0.121},
{1.05, 0.474},
{0, 0.474},
{0, 0.121}
}
};

TitleData = {{0.5,0.45, "Napoleon's Russian Campaign of 1812"}};
PointData = {{0.965,0.396, "Moscow"}};
TextData = {{0.98, 0.085, "0"}, {0.98, 0.026, "-30"},
 {0.111, 0.1502, "R. Niemen"}, {0.37, 0.20, "R. Berezina"},
{0.5,0.015,"Temperature in degrees Reaumur - return march"},
{0.1, 0.22, "422,000"},{0.9, 0.38, "100,000"},{0.04, 0.175, "10,000"},
{0.4, 0.4, "Strength of army = approximate thickness of track"},
{0.4, 0.38, "Return marches shown in black"}};
End[]
EndPackage[]