Skip to content
Browse files

New world and continent maps, with colours

  • Loading branch information...
1 parent 5f355a7 commit 94bb3e8e54f1cc4e6e843ac0d6f8ebc5c3506671 leon committed
Showing with 68 additions and 12 deletions.
  1. +53 −11 perlmongers/bin/xml
  2. +7 −0 perlmongers/src/groups/continent.html
  3. +8 −1 perlmongers/src/groups/index.html
View
64 perlmongers/bin/xml
@@ -6,6 +6,15 @@ use Image::WorldMap;
use Template;
use XML::Simple;
+my %colours = (
+ 'africa' => [64,255,64],
+ 'asia' => [255,255,0],
+ 'europe' => [128,128,255],
+ 'north_america' => [255,0,0],
+ 'south_america' => [255,0,255],
+ 'oceania' => [0,255,255],
+);
+
$| = 1;
my $xml = XMLin('./perl_mongers.xml', cache => 'storable', suppressempty => 1);
@@ -24,6 +33,8 @@ my $tt = Template->new({
my %groups;
mkdir "www/groups/graphics";
+my $worldmap = Image::WorldMap->new("titchy.png");
+
foreach my $name (keys %$xml) {
my $group = $xml->{$name};
my $id = $group->{id};
@@ -54,14 +65,23 @@ foreach my $name (keys %$xml) {
map { $group->{location}->{$_} }
qw(city region state country continent);
- if (!-f "www/groups/graphics/$id.png"
- && $group->{location}->{longitude}
+ if ($group->{location}->{longitude}
&& $group->{location}->{latitude}) {
- my $map = Image::WorldMap->new("titchy.png");
- $map->add($group->{location}->{longitude}, $group->{location}->{latitude});
- $map->draw("foo.png");
- system("pngtopnm foo.png | ppmquant 64 | pnmtopng -compression 9 > www/groups/graphics/$id.png");
- $group->{image} = "graphics/$id.png";
+
+ # first add to world map
+ my $c = lc $group->{location}->{continent};
+ $c =~ s/\W/_/g;
+ my $colour = $colours{$c} || die;
+ $worldmap->add($group->{location}->{longitude}, $group->{location}->{latitude}, 'group', $colour);
+
+ # have we drawn the single-country map already?
+ if (!-f "www/groups/graphics/$id.png") {
+ my $map = Image::WorldMap->new("titchy.png");
+ $map->add($group->{location}->{longitude}, $group->{location}->{latitude}, 'group', $colour);
+ $map->draw("foo.png");
+ system("pngtopnm foo.png | ppmquant 128 | pnmtopng -compression 9 > www/groups/graphics/$id.png");
+ $group->{image} = "graphics/$id.png";
+ }
}
my $continent = $group->{location}->{continent};
@@ -81,25 +101,47 @@ copy("./perl_mongers.dtd", "www/groups/perl_mongers.dtd");
#use YAML; die Dump(\%groups);
foreach my $continent (sort keys %groups) {
- my $file = lc $continent;
- $file =~ s/\W/_/g;
- $file = "www/groups/$file.html";
+ my $name = lc $continent;
+ $name =~ s/\W/_/g;
+ my $file = "www/groups/$name.html";
warn "$continent -> $file\n";
my $groups;
+ my $map = Image::WorldMap->new("titchy.png");
foreach my $country (sort keys %{$groups{$continent}}) {
warn " $country\n";
- $groups->{$country} = [sort { lc $a->{name} cmp lc $b->{name} } @{$groups{$continent}->{$country}}];
+ my @mygroups = @{$groups{$continent}->{$country}};
+ $groups->{$country} = [sort { lc $a->{name} cmp lc $b->{name} } @mygroups];
+ }
+
+ my $colour = $colours{$name};
+ foreach my $name (keys %$xml) {
+ my $group = $xml->{$name};
+ my $status = $group->{status} || 'not-specified-in-xml-file';
+ next unless $status eq 'active' || $status eq 'sleeping';
+ next unless $group->{location}->{continent} eq $continent;
+ if ($group->{location}->{longitude}
+ && $group->{location}->{latitude}) {
+ $map->add($group->{location}->{longitude}, $group->{location}->{latitude}, "group", $colour);
+ }
}
+
+ $map->draw("foo.png");
+ system("pngtopnm foo.png | ppmquant 128 | pnmtopng -compression 9 > www/groups/graphics/$name.png");
my $conf = {
groups => $groups,
continent => $continent,
};
+ $conf->{image} = "graphics/$name.png" unless $name eq 'non_geographical';
+
$tt->process('src/groups/continent.html', $conf, $file)
|| die $tt->error();
#use YAML; die Dump($groups);
#use Data::Dumper; die Dumper($groups);
}
+$worldmap->draw("foo.png");
+system("pngtopnm foo.png | ppmquant 255 | pnmtopng -compression 9 > www/groups/graphics/world.png");
+
__END__
=head1 NAME
View
7 perlmongers/src/groups/continent.html
@@ -1,6 +1,13 @@
[% META title = "Perl Mongers: Continent" %]
+[% IF image %]
+<img src="[% image %]">
+[% END %]
+
+<p>
+
The following groups are in [% continent %]:
+
<p>
[% FOREACH country = groups.keys.sort %]
View
9 perlmongers/src/groups/index.html
@@ -1,6 +1,12 @@
[% META title = "Perl Mongers: User groups" %]
-There are lots of Perl Monger around the world.
+
+<img src="graphics/world.png">
+
+<p>
+
+There are many Perl Monger groups around the world.
+
<p>
Select a continent:
@@ -11,6 +17,7 @@
[% link_to("/groups/north_america.html", "North America") %],
[% link_to("/groups/oceania.html", "Oceania") %],
[% link_to("/groups/south_america.html", "South America") %].
+
<p>
The canonical source for the Perl Mongers groups is now an

0 comments on commit 94bb3e8

Please sign in to comment.
Something went wrong with that request. Please try again.