#!/usr/bin/perl -w
############################################################################
# Version 1.1, 3 October 2009
#
# Copyright 2009 TimR. All rights reserved.
############################################################################
############################################################################
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
############################################################################
use strict;
my @colours = qw(
blue
blueviolet
brown
burlywood
cadetblue
chartreuse
crimson
darkblue
darkcyan
darkgreen
darkgrey
darkmagenta
darkorange
deepskyblue
dimgrey
forestgreen
gold
goldenrod
hotpink
indianred
indigo
khaki
lawngreen
lightblue
lightcoral
lightgreen
lightgrey
lightpink
lightsalmon
lightskyblue
lightslategrey
lightsteelblue
lime
limegreen
magenta
maroon
mediumblue
mediumorchid
mediumpurple
mediumseagreen
mediumslateblue
mediumspringgreen
mediumturquoise
mediumvioletred
mistyrose
moccasin
navajowhite
navy
oldlace
olive
olivedrab
orange
orangered
orchid
palegoldenrod
palegreen
paleturquoise
palevioletred
papayawhip
peachpuff
peru
pink
plum
powderblue
purple
red
rosybrown
royalblue
saddlebrown
salmon
sandybrown
seagreen
seashell
sienna
silver
skyblue
slateblue
slategray
slategrey
snow
springgreen
steelblue
tan
teal
thistle
tomato
turquoise
violet
wheat
white
whitesmoke
yellow
yellowgreen
);
my @headers = ("Jun 07", "Jan 08", "Oct 08", "Jun 09");
my @rawdata = (
[ "Lord Adonis", qw(- - - trans )],
[ "Bob Ainsworth", qw(- - - defence )],
[ "Douglas Alexander", qw(id id id id )],
[ "Valerie Amos", qw(- - - - )],
[ "Hilary Armstrong", qw(- - - - )],
[ "Lady Ashton", qw(lhol - - - )],
[ "Margaret Beckett", qw(- - house - )],
[ "Ed Balls", qw(csf csf csf csf )],
[ "Hilary Benn", qw(efra efra efra efra )],
[ "Tony Blair", qw(- - - - )],
[ "Hazel Blears", qw(clg clg clg - )],
[ "David Blunkett", qw(- - - - )],
[ "Paul Boateng", qw(- - - - )],
[ "Ben Bradshaw", qw(- - - cms )],
[ "Gordon Brown", qw(pm pm pm pm )],
[ "Nick Brown", qw(- - whip whip )],
[ "Des Browne", qw(defence defence - - )],
[ "Andy Burnham", qw(treas cms cms health )],
[ "Liam Byrne", qw(- cab cab treas )],
[ "Charles Clarke", qw(- - - - )],
[ "Yvette Cooper", qw(house treas treas work )],
[ "Alistair Darling", qw(chan chan chan chan )],
[ "John Denham", qw(ius ius ius clg )],
[ "Charles Falconer", qw(- - - - )],
[ "Caroline Flint", qw(- house europe - )],
[ "Peter Hain", qw(work - - wales )],
[ "Harriet Harman", qw(lhoc lhoc lhoc lhoc )],
[ "Patricia Hewett", qw(- - - - )],
[ "Geoff Hoon", qw(whip whip trans - )],
[ "John Hutton", qw(bis bis defence - )],
[ "Alan Johnson", qw(health health health home )],
[ "Tessa Jowell", qw(- olymp olymp cab )],
[ "Ruth Kelly", qw(trans trans - - )],
[ "Lady Kinnock", qw(- - - europe )],
[ "Dennis MacShane", qw(- - - - )],
[ "Lord Mandelson", qw(- - bis bis )],
[ "David Miliband", qw(fs fs fs fs )],
[ "Ed Miliband", qw(cab energy energy energy )],
[ "Jim Murphy", qw(europe europe - scot )],
[ "Paul Murphy", qw(- wales wales - )],
[ "James Purnell", qw(cms work work - )],
[ "John Reid", qw(- - - - )],
[ "Lady Royall", qw(- lhol lhol lhol )],
[ "Chris Smith", qw(- - - - )],
[ "Jacqui Smith", qw(home home home - )],
[ "Jack Straw", qw(lchan lchan lchan lchan )],
[ "Stephen Timms", qw(- - - - )],
[ "Shaun Woodward", qw(ni ni ni ni )],
);
my @cats = (
pm => "Prime Minister",
lhoc => "Leader of the House of Commons",
chan => "Chancellor",
fs => "Foreign Secretary",
lchan => "Lord Chancellor",
home => "Home Secretary",
efra => "Environment, Food and Rural Affairs",
id => "International Development",
clg => "Communities and Local Government",
ius => "Innovation, Universities and Skills",
csf => "Children, Schools and Families",
energy => "Energy and Climate Change",
health => "Health",
ni => "Northern Ireland",
lhol => "Leader of the House of Lords",
cab => "Cabinet Office",
olymp => "Olympics",
scot => "Scotland",
work => "Work and Pensions",
cms => "Culture, Media and Sport",
treas => "Chief Secretary to the Treasury",
wales => "Wales",
bis => "Business, Innovation and Skills",
defence => "Defence",
trans => "Transport",
europe => "Europe",
);
my %cats;
my @catmap;
for (my $n=0; $n*2<@cats; $n++) {
my $tag = $cats[$n*2];
$cats{$tag} = {
tag => $tag,
index => $n,
name => $cats[$n*2+1],
};
$catmap[$n] = $cats{$tag};
}
my @data = map {
{
name => $_->[0],
positions => [ map { $cats{$_}->{index} }
@{$_}[1 .. @$_-1]
],
}
} @rawdata;
$_->{colour} = shift @colours
foreach @data;
my $numbercolumns;
my $numberrows;
my $minposition;
my $maxposition;
foreach (@data) {
$numbercolumns = @{$_->{positions} }
if !defined $numbercolumns ┃┃
$numbercolumns < @{$_->{positions} };
foreach (@{$_->{positions} }) {
$minposition = $_
if defined $_ &&
(!defined $minposition ┃┃
$_ < $minposition);
$maxposition = $_
if defined $_ &&
(!defined $maxposition ┃┃
$_ > $maxposition);
}
}
$numberrows = $maxposition - $minposition + 1;
my $leftmargin = 10;
my $rightmargin = 10;
my $topmargin = 10;
my $bottommargin = 10;
my $spacer = 20;
my $lefttextboxwidth = 480;
my $righttextboxwidth = 300;
my $colwidth = 120;
my $rowheight = 70;
my $lefttextvoffset = 8;
my $textvoffset = -8;
my $blobradius = 10;
my $linewidth = 10;
my $headerheight = 40;
my $chartxoffset = $leftmargin + $lefttextboxwidth + $spacer;
my $chartyoffset = $topmargin + $headerheight;
my $chartwidth = $blobradius +
($numbercolumns - 1) * $colwidth +
$blobradius;
my $totalwidth = $leftmargin + $lefttextboxwidth + $spacer +
$blobradius +
($numbercolumns - 1) * $colwidth +
$blobradius +
$spacer +
$righttextboxwidth + $rightmargin;
my $totalheight = $topmargin +
$headerheight +
$numberrows * $rowheight +
$bottommargin;
print <<EOF;
<?xml version='1.0'?>
<!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 1.1//EN'
'http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd'>
<svg xwidth='5cm' xheight='4cm'
version='1.1'
xmlns='http://www.w3.org/2000/svg'
viewBox='0 0 $totalwidth $totalheight'>
<desc>Cabinet chart</desc>
<rect x='0' y='0' width='$totalwidth' height='$totalheight'
fill='white' stroke='none' stroke-width='2'/>
EOF
########################################################################
# Print grid
########################################################################
print " <g fill='none' stroke='grey' stroke-width='1'>\n";
for (my $i=0; $i<$numberrows; $i++) {
printf " <line x1='%s' y1='%s' x2='%s' y2='%s'/>\n",
0, $chartyoffset + $i * $rowheight,
$totalwidth, $chartyoffset + $i * $rowheight;
}
printf " <line x1='%s' y1='%s' x2='%s' y2='%s'/>\n",
0, $chartyoffset + $numberrows * $rowheight,
$totalwidth, $chartyoffset + $numberrows * $rowheight;
print " </g>\n";
print "\n";
########################################################################
# Print headers
########################################################################
print " <g font-size='20' fill='black' font-family='sans-serif'>\n";
for (my $i=0; $i<@headers; $i++) {
printf " <text x='%s' y='%s'>%s</text>\n",
$chartxoffset + $blobradius + $i * $colwidth - 20,
$headerheight - 10,
$headers[$i];
}
print " </g>\n";
print "\n";
########################################################################
# Calculate segments
########################################################################
my @newsegments;
for (my $i=@data-1; $i>=0; $i--) {
my $item = $data[$i];
for (my $start=0; $start<$numbercolumns; $start++) {
if (defined $item->{positions}[$start]) {
my $end = $start;
while ($end+1<$numbercolumns &&
defined $item->{positions}[$end+1]) {
$end ++;
}
my @coords;
foreach ($start .. $end) {
push @coords, $chartxoffset + $blobradius + $colwidth * $_,
$chartyoffset +
($item->{positions}[$_] - $minposition) * $rowheight +
$rowheight/2 + 10;
}
push @newsegments, {
item => $item,
start => $start,
end => $end,
coords => \@coords,
};
$start = $end + 1;
}
}
}
########################################################################
# Print lines, blobs
########################################################################
print " <g stroke-width='$linewidth' stroke-linecap='round' fill='none'>\n";
foreach my $segment (@newsegments) {
my @coords = @{$segment->{coords} };
my @points = @coords;
push @points, $chartxoffset + $chartwidth + $spacer + $righttextboxwidth,
$points[-1]
if $segment->{end} == $numbercolumns-1;
printf " <polyline stroke='%s' points='%s'/>\n",
$segment->{item}{colour},
join(" ", @points);
while (@coords > 1) {
my $x = shift @coords;
my $y = shift @coords;
printf " <circle cx='%s' cy='%s' r='%s' fill='%s'/>\n",
$x, $y, $blobradius, $segment->{item}{colour};
}
}
print " </g>\n";
print "\n";
########################################################################
# Print labels
########################################################################
print " <g font-size='24' fill='black' font-family='sans-serif' font-weight='bold'>\n";
foreach my $segment (@newsegments) {
my @coords = @{$segment->{coords} };
my ($x, $y);
if ($segment->{end} == $numbercolumns-1) {
$x = $coords[-2] + 60;
$y = $coords[-1] - 15;
} else {
$x = $coords[0] - 10;
$y = $coords[1] - 20;
}
printf " <text x='%s' y='%s'>%s</text>\n",
$x, $y, $segment->{item}{name} #. " " . $segment->{item}{colour}
;
}
print " </g>\n";
print "\n";
########################################################################
# Print text columns
########################################################################
print " <g font-size='24' fill='black' font-family='sans-serif' font-weight='bold'>\n";
for (my $i=0; $i<$numberrows; $i++) {
printf " <text x='%s' y='%s'>%s</text>\n",
$leftmargin,
$chartyoffset + $i * $rowheight + $rowheight/2 + $lefttextvoffset,
$catmap[$i]->{name} #. " " . $catmap[$i]->{tag}
;
}
print " </g>\n";
print <<EOF;
</svg>
EOF
