PDF atlas source code

#!/usr/bin/perl
use strict;
use PDF::API2;
use Data::Dumper;
use constant mm => 25.4/72;
 
my $ConfigFile = shift() || die("Usage: $0 [Config file]\n");
CreateAtlas($ConfigFile);
exit;
 
 
#---------------------------------------------------------
# Create a PDF road atlas, based on options in a config file
#---------------------------------------------------------
sub CreateAtlas(){
  my $PDF = PDF::API2->new();
 
  # Read the configuration file
  my $Options = ReadFile(shift());
 
  # Title page
  AddTitlePage($PDF, $Options->{"Title"});
 
  my $Data = LoadData($Options);
 
  MapPages($PDF, $Options, $Data);
 
  # License page
  TextPage($PDF, $Options->{"License"});
 
  # Save the PDF
  printf STDERR "Saving %s\n", $Options->{"Filename"};
  $PDF->saveas($Options->{"Filename"});
}
 
#---------------------------------------------------------
# Adds a title page to the PDF document
#---------------------------------------------------------
sub AddTitlePage()
{
  my ($PDF, $Title) = @_;
  my $Font = $PDF->corefont('Helvetica');
 
  # Add file meta-informationshift()
  AddMetaInfo($PDF, $Title);
 
  # Create a new page for the title
  my $Page = $PDF->page;
 
  my $TextHandler = $Page->text;
  $Page->mediabox(210/mm, 297/mm);
  $Page->cropbox (10/mm, 10/mm, 200/mm, 287/mm);
 
  # Write the page title (TODO: read this from a text file)
  foreach my $Line(
    ("105, 200, 11, centre, black, $Title",
    "105, 60, 6, centre, black, Created from OpenStreetMap data",
    "105, 50, 6, centre, black, http://openstreetmap.org.uk/",
    "105, 40, 6, centre, black, Published under a Creative Commons license",
    ))
    {
    my ($X, $Y, $Size, $Pos, $Colour, $Text) = split(/,\s+/, $Line);
 
    $TextHandler->font($Font, $Size/mm );
    $TextHandler->fillcolor($Colour);
    $TextHandler->translate($X/mm, $Y/mm);
 
    $TextHandler->text($Text) if($Pos eq "left");
    $TextHandler->text_center($Text) if($Pos eq "centre");
    $TextHandler->text_right($Text) if($Pos eq "right");
    }
}
 
#---------------------------------------------------------
# Adds a page of preformatted text, from a text file
#---------------------------------------------------------
sub TextPage()
{
  my ($PDF, $Filename) = @_;
  my $Page = $PDF->page;
 
  my $TextHandler = $Page->text;
  $TextHandler->font($PDF->corefont('Helvetica'), 6/mm );
  $TextHandler->fillcolor('black');
 
  open(my $fp, "<", $Filename) || die("Can't open $Filename ($!)\n");
 
  my ($x, $y) = (30, 250);
  foreach my $Line(<$fp>){
    chomp $Line;
    $TextHandler->translate($x/mm, $y/mm);
    $TextHandler->text($Line);
    $y -= 7;
  }
}
#---------------------------------------------------------
# Adds meta-information to a PDF
#---------------------------------------------------------
sub AddMetaInfo(){
  my ($PDF, $Title) = @_;
 
  # Timestamp (using perl standard functions to make script easier to install)
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
  my $Timestamp = sprintf("D:%04d%02d%02d%02d%02d%02d+00;00", $year+1900, $mon+1, $mday, $hour, $min, $sec);
 
  $PDF->info(
        'Author'       => "OpenStreetMap community",
        'CreationDate' => $Timestamp,
        'ModDate'      => $Timestamp,
        'Creator'      => "OJW's script",
        'Producer'     => "PDF::API2",
        'Title'        => $Title,
        'Subject'      => "Cartography",
        'Keywords'     => "OpenStreetMap"
    );
}
 
sub LoadData()
{
  my ($Options) = @_;
  my %Data;
 
  foreach my $Datatype("Styles","Equivalences","Filters")
  {
    my $Filename = $Options->{$Datatype};
    $Data{$Datatype} = ReadFile($Filename);
  }
 
  my ($LatC, $LongC, $Size) = split(/,/,$Options->{"Area"});
  my $Margin = 1.5;
  my %Bounds = (
    "W" => $LongC - $Margin * $Size,
    "E" => $LongC + $Margin * $Size,
    "S" => $LatC - $Margin * $Size,
    "N" => $LatC + $Margin * $Size);
 
  $Data{"Coast"} = LoadGSHHS($Options->{"Coast"}, \%Bounds) if($Options->{"Coast"});
 
  $Data{"Segments"} = LoadOSM($Options->{"Data"}, \%Bounds) if($Options->{"Data"});
 
  return(\%Data);
}
 
sub LoadGSHHS()
{
  my ($Filename, $Bounds) = @_;
  my @Coasts;
 
  # Open the file for reading, binary
  open(my $fp, "<", $Filename) || die("Can't open GSHHS file $Filename ($!)\n");
  binmode($fp);
  printf "Loading coastlines from %s\n", $Filename;
 
    printf "Bounds2 lat %f to %f, long %f to %f\n",
    $Bounds->{"S"},
    $Bounds->{"N"},
    $Bounds->{"W"},
    $Bounds->{"E"}; 
 
  # Continue reading headers until end of file
  while(read($fp, my $header, 8 * 4 + 2 * 2))
    {
    my ($Prev, $PLat, $PLon) = (0,0,0);
    my ($id, $numpoints, $level,
        $west, $east, $north, $south,
        $area, $crosses, $source) = unpack("NNNN4Nnn", $header);
 
    # Loop through vertices in this polygon
    foreach(1..$numpoints)
      {
      # Read from file
      die("GSHHS error\n") if(!read($fp, my $datapoint, 8));
 
      # Unpack binary data into local variables
      my($x, $y) = unpack("NN", $datapoint);
 
      my $Lat = coastcode($y);
      my $Lon = coastcode($x);
      $Lon -= 360 if($Lon > 180);
 
      if($Lat > $Bounds->{"S"} and 
        $Lat < $Bounds->{"N"} and 
        $Lon > $Bounds->{"W"} and 
        $Lon < $Bounds->{"E"}){
 
        push(@Coasts, "$PLat, $PLon, $Lat, $Lon") if($Prev);
      }
      ($PLat, $PLon, $Prev) = ($Lat, $Lon, 1);
      }
    }
  close($fp);
 
  return(\@Coasts);
}
 
sub coastcode(){
  my $x = shift();
  if($x > 0x80000000){
    $x -= 0xFFFFFFFF; $x--;
  }
  return($x / 1E+6);
}
 
sub LoadOSM()
{
  my ($Filename, $Bounds) = @_;
 
  open(my $fp, "<", $Filename) or die("Can't open $Filename ($!)\n");
  printf "Loading streetmaps from %s\n", $Filename;
  my @Lines = <$fp>;
  chomp @Lines;
  close($fp);  
 
  return(\@Lines);
}
 
sub MapPages()
{
  my ($PDF, $Options, $Data) = @_;
 
  my $Filename = $Options->{"Places"};
  open(my $fp, "<", $Filename) or die("Can't open $Filename ($!)\n");
 
  my @Maps;
 
  foreach my $Line(<$fp>){
    chomp $Line;
    if(substr($Line,0,1) ne "#")
    {
    	push(@Maps, $Line);
    }
  }
  printf "Creating %d maps\n", scalar(@Maps);
 
  my ($LatC, $LongC, $Size) = split(/,/,$Options->{"Area"});
  MapContentsPage($PDF, \@Maps, $LatC, $LongC, $Size, $Data);
 
 
  foreach my $Map(@Maps)
  { 
      my ($Name, $More) = split(/:\s*/, $Map);
      my ($Lat, $Long, $Size, $Type) = split(/,\s+/, $More);
 
      print "Generating map for $Name at $Lat, $Long\n";      
      MapPage($PDF, $Lat, $Long, $Size, $Name, $Type, $Data);
  }
}
 
#---------------------------------------------------------
# Adds a simple "text-style" contents page
#---------------------------------------------------------
sub ContentsPage()
{
	my ($PDF, $Maps) = @_;
  	my $Page = $PDF->page;
  	my $TextSize = 4.5;
 
	my $PageNum = $PDF->pages + 1; # Assume first map is on page after the current one
  	my $TextHandler = $Page->text;
 
  	# Title
  	$TextHandler->fillcolor('black');
	$TextHandler->font($PDF->corefont('Helvetica'), 7/mm );
    $TextHandler->translate(40/mm, 232/mm);
	$TextHandler->text("Contents:");
 
	# Setup size and position of contents items
	$TextHandler->font($PDF->corefont('Helvetica'), $TextSize/mm );  
    my $y = 220;
 
	foreach my $Map(@$Maps)
	{
		my ($Name, $Misc) = split(/:/, $Map);
 
		# Name
	    $TextHandler->translate(40/mm, $y/mm);
    	$TextHandler->text($Name);
 
		# Page num    	
	    $TextHandler->translate(150/mm, $y/mm);
    	$TextHandler->text($PageNum++);
 
	    $y -= ($TextSize+1);		
	}
}
sub MapContentsPage(){
  my ($PDF, $Maps, $Lat, $Long, $Size, $Data) = @_;
  my $Proj = SetupProjection($Lat, $Long, $Size);
 
  my $Page = $PDF->page;
  $Page->mediabox(210/mm, 297/mm);
 
  my $gfx = $Page->gfx;
  my $text = $Page->text;
  $text->font($PDF->corefont('Helvetica'), 4/mm );
 
  DrawCoastline($Data->{"Coast"}, $Proj, $gfx);
 
  my $Count = $PDF->pages + 1;
  foreach my $Map(@$Maps)
  {
    my ($Name, $More) = split(/:\s*/, $Map);
    my ($LatS, $LongS, $SizeS, $Type) = split(/,\s+/, $More);
    my $IsCity = $Type eq "city";
    my $Colour = $IsCity ? "#000000" : "#40C0FF";
 
    my $Proj2 = SetupProjection($LatS, $LongS, $SizeS);
 
    my ($x1, $y1) = Project($Proj, $Proj2->{"S"}, $Proj2->{"W"});
    my ($x2, $y2) = Project($Proj, $Proj2->{"N"}, $Proj2->{"E"});
 
    # Map border
    $gfx->strokecolor($Colour);
    $gfx->rect($x1/mm, $y1/mm, ($x2-$x1)/mm, ($y2-$y1)/mm); 
    $gfx->stroke();
    $gfx->endpath();
 
    # Text (inside area maps, outside city maps)
    if(!$IsCity){
      $text->fillcolor($Colour);
      $text->translate((($IsCity ? $x2 : $x1) + 1)/mm, ($y2 - 5)/mm);
      $text->text($Name);
    }
 
    $Count++;
  }
}
 
#---------------------------------------------------------
# Adds a page of maps
#---------------------------------------------------------
sub MapPage(){
  my ($PDF, $Lat, $Long, $Size, $Name, $Type, $Data) = @_;
 
  my $Proj = SetupProjection($Lat, $Long, $Size);
 
  my $Page = $PDF->page;
  $Page->mediabox(210/mm, 297/mm);
 
  my $gfx = $Page->gfx;
  my $Font = $PDF->corefont('Helvetica');
 
  # Draw the "simple" (A1 - G9) grid
  mapGrid($Page, 10, 287, 200, 10, $Font, $Proj);
 
  DrawCoastline($Data->{"Coast"}, $Proj, $gfx);
 
  DrawOSM($Data->{"Segments"}, $Proj, $gfx, $Data->{"Styles"});
 
  ScaleBar($PDF, $Page, $Proj);
 
  # White-out the edges of the page (stop maps spilling over)
  my $edges = $Page->gfx;
  $edges->rect(0/mm, 0/mm, 10/mm, 297/mm); # left
  $edges->rect(0/mm, 0/mm, 210/mm, 10/mm); # bottom
  $edges->rect(200/mm, 0/mm, 210/mm, 297/mm); # right
  $edges->rect(0/mm, 287/mm, 210/mm, 297/mm); # top
  $edges->fillcolor("#FFFFFF"); 
  $edges->fill; 
  $edges->endpath;
 
  # Map border
  $edges->strokecolor("#000080");
  $edges->rect(10/mm, 10/mm, 190/mm, 277/mm); 
  $edges->stroke();
  $edges->endpath();
 
  # Page number
  my $text = $Page->text;  
  $text->fillcolor("#000000"); 
  $text->font($Font, 6/mm );
  $text->translate( 10/mm, 289/mm );
  $text->text(sprintf("%d", $PDF->pages));
 
  # Page name
  $text->translate( 10/mm, 3/mm );
  $text->text($Name);
 
  # URL
  $text->translate( 200/mm, 3/mm );
  $text->text_right("http://openstreetmap.org/");
}
 
#---------------------------------------------------------
# Draw coastline segments	
#---------------------------------------------------------
sub DrawCoastline()
{
  my($Coast, $Proj, $gfx) = @_;
 
  if($Coast)
  {
    foreach my $Line(@$Coast)
    {
      my ($Lat1, $Long1, $Lat2, $Long2) = split(/,/, $Line);
      if(PossiblyOn($Proj, $Lat1, $Long1, $Lat2, $Long2))
      {
        my ($x1, $y1) = Project($Proj, $Lat1, $Long1);
        my ($x2, $y2) = Project($Proj, $Lat2, $Long2);
 
        my $Colour = "#0000FF";
 
        $gfx->strokecolor($Colour);
        $gfx->move($x1/mm,$y1/mm);
        $gfx->line($x2/mm,$y2/mm); 
        $gfx->stroke();
        $gfx->endpath();
      }
    }
  }	
}
 
#---------------------------------------------------------
# Draw OpenStreetMap segments
#---------------------------------------------------------
sub DrawOSM()
{
  my($Segments, $Proj, $gfx, $Styles) = @_;
 
  if($Segments)
  {
    foreach my $Line(@$Segments)
    {
      my($Lat1,$Long1,$Lat2,$Long2,$Class,$Name,$Highway) = split(/,/,$Line);
 
      $Class = $Highway if(!$Class);
 
      $Class = lc($Class);  
      if(PossiblyOn($Proj, $Lat1, $Long1, $Lat2, $Long2))
      {
        my ($x1, $y1) = Project($Proj, $Lat1, $Long1);
        my ($x2, $y2) = Project($Proj, $Lat2, $Long2);
 
        my $Colour = exists($Styles->{$Class}) ? $Styles->{$Class}: "#A0A0A0";
 
        $gfx->strokecolor($Colour);
        $gfx->move($x1/mm,$y1/mm);
        $gfx->line($x2/mm,$y2/mm); 
        $gfx->stroke();
        $gfx->endpath();
      }
    }
  }
}
#---------------------------------------------------------
# Draw a basic (uncorrelated with anything) grid on a map
#---------------------------------------------------------
sub mapGrid()
{
  my ($Page, $x1, $y1, $x2, $y2, $Font, $Proj) = @_;
  my $grid = $Page->gfx;
 
  my $xLabels = "ABCDEFG";
  my $dx = ($x2 - $x1) / 7;
  my $dy = ($y2 - $y1) / 10;
 
  my $gridtext = $Page->text;  
  $gridtext->fillcolor("#C1E4FF"); 
  $gridtext->font($Font, 3/mm );
 
  my $count = 0;
  for(my $x = $x1; $x < $x2-1; $x += $dx)
  {
    $grid->move($x/mm,$y1/mm);
    $grid->line($x/mm,$y2/mm); 
 
    $gridtext->translate(($x + $dx - 4)/mm, ($y1 - 4)/mm );
    $gridtext->text(substr($xLabels, $count++, 1));
  }
 
  $count = 1;
  for(my $y = $y1; $y > $y2+1; $y += $dy)
  {
    $grid->move($x1/mm,$y/mm);
    $grid->line($x2/mm,$y/mm); 
 
    $gridtext->translate(($x1 + 2)/mm, ($y + $dy + 2)/mm );
    $gridtext->text($count++);
 
  }
 
  $grid->strokecolor("#C1E4FF");
  $grid->stroke();
  $grid->endpath();
}
 
#---------------------------------------------------------
# Draw a scalebar on a map
#---------------------------------------------------------
sub ScaleBar()
{
  my ($PDF, $Page, $Proj) = @_;
  my $EarthRadius = 6378;
 
  my $ScaleX = 20;
  my $ScaleY = 20;
  my $dx = 100;
 
  my $ScaleLenDeg = $Proj->{"dLong"} * $dx / $Proj->{"dx"};
  my $ScaleLenGuess = $EarthRadius * DegToRad($ScaleLenDeg) * $Proj->{"latlong_ratio"};
 
  my $ScaleLen = Round($ScaleLenGuess);
  $dx *= $ScaleLen / $ScaleLenGuess;
 
  my $scale = $Page->gfx;
 
  # Bordered rectangle, to get rid of any bits of map under the scalebar
  BorderRect($scale,
    ($ScaleX - 2)/mm, 
    ($ScaleY - 8)/mm, 
    ($dx + 4)/mm, 
    10/mm,
    "#FFFFFF", 
    "#CCCCFF");
 
  # Scalebar length
  $scale->move($ScaleX/mm, $ScaleY/mm);
  $scale->line(($ScaleX + $dx)/mm, $ScaleY/mm); 
  # and tickmarks
  foreach(0..10){
    my $Len = (($_ % 5) == 0) ? 2 : 1;
    my $X = $ScaleX + $dx * $_ / 10;
    $scale->move($X/mm, $ScaleY/mm);
    $scale->line($X/mm, ($ScaleY - $Len)/mm);
  }
 
  $scale->strokecolor("#000000");
  $scale->stroke();
 
  # Scalebar text
  my $text = $Page->text;  
  $text->fillcolor("#000000"); 
  $text->font($PDF->corefont('Helvetica'), 4/mm );
  $text->translate($ScaleX/mm, ($ScaleY - 6)/mm );
  $text->text(FormatNum($ScaleLen) . " km");
 
}
 
#---------------------------------------------------------
# Draw a rectangle with fill and border
#---------------------------------------------------------
sub BorderRect()
{
  my ($gfx, $x, $y, $w, $h, $fill, $line) = @_;
  $gfx->rect($x, $y, $w, $h);
  $gfx->fillcolor($fill); 
  $gfx->fill; 
 
  $gfx->rect($x, $y, $w, $h);
  $gfx->strokecolor($line);
  $gfx->stroke();
}
 
#---------------------------------------------------------
# Format a number without trailing zeros
#---------------------------------------------------------
sub FormatNum()
{
  my $Text = sprintf("%lf", shift());
  $Text =~ s/(\.\d*?)0+$/\1/;
  $Text =~ s/\.$//;
  return($Text);
}
 
#---------------------------------------------------------
# Utility: round a number to the nearest power of 10
#---------------------------------------------------------
sub Round()
{
  my $x = shift();
  my $Result = $x;
  foreach(0.1, 0.5, 1, 2, 5, 10, 50, 100){
    $Result = $_ if($x > $_);
    }
  return($Result);
}
 
#---------------------------------------------------------
# Tests whether a line can possibly intersect an area
#---------------------------------------------------------
sub PossiblyOn()
{
  my ($Proj, $Lat1, $Long1, $Lat2, $Long2) = @_;
  return(0) if($Long1 < $Proj->{"W"} && $Long2 < $Proj->{"W"});
  return(0) if($Long1 > $Proj->{"E"} && $Long2 > $Proj->{"E"});
  return(0) if($Lat1 < $Proj->{"S"} && $Lat2 < $Proj->{"S"});
  return(0) if($Lat1 > $Proj->{"N"} && $Lat2 > $Proj->{"N"});
  return(1);
}
 
#---------------------------------------------------------
# Project a lat/long onto x,y coordinates
#---------------------------------------------------------
sub Project()
{
  my ($Proj, $Lat, $Long) = @_;
 
  my $x = $Proj->{"x1"} + $Proj->{"dx"} * ($Long - $Proj->{"W"}) / $Proj->{"dLong"};
  my $y = $Proj->{"y1"} + $Proj->{"dy"} * ($Lat - $Proj->{"S"}) / $Proj->{"dLat"};
 
  return($x,$y);
}
 
#---------------------------------------------------------
# Initialise a map projection for later use by Project()
#---------------------------------------------------------
sub SetupProjection()
{
  my ($Lat, $Long, $Size) = @_;
  my %Proj;
 
  # Scale to A4 page (note: A4 page sizes are hardcoded throughout at the moment)
  $Proj{"x1"} = 10;
  $Proj{"x2"} = 200;
  $Proj{"y1"} = 10;
  $Proj{"y2"} = 287;
 
  $Proj{"dx"} = $Proj{"x2"} - $Proj{"x1"};
  $Proj{"dy"} = $Proj{"y2"} - $Proj{"y1"};
 
  $Proj{"page_ratio"} = $Proj{"dy"} / $Proj{"dx"};
 
  # Size is used to define N-S limits
  $Proj{"N"} = $Lat + $Size;
  $Proj{"S"} = $Lat - $Size;
  $Proj{"dLat"} = $Proj{"N"} - $Proj{"S"};
 
  # Long/lat ratio is cos(lat) (very simple "projection")
  $Proj{"latlong_ratio"} = cos(DegToRad($Lat)); # ~0.5 for northern europe = long/lat
 
  $Proj{"dLong"} = $Proj{"dLat"} * $Proj{"page_ratio"} * $Proj{"latlong_ratio"};
  $Proj{"W"} = $Long - 0.5 * $Proj{"dLong"};
  $Proj{"E"} = $Long + 0.5 * $Proj{"dLong"};
 
  return(\%Proj);
}
sub DegToRad(){
 return(3.1415926 * shift() / 180);
}
#---------------------------------------------------------
# Reads a file consisting of "Name: Value" pairs, and 
# returns them as a hash
#---------------------------------------------------------
sub ReadFile(){
  my $Filename = shift();
  my %Options;
  open(my $fp, $Filename) || die("Can't open $Filename ($!)\n");
  printf STDERR "  - Reading %s\n", $Filename;
 
  foreach my $Line(<$fp>){
    chomp $Line;
    if(substr($Line,0,1) ne "#"){
      my ($Key, $Value) = split(/:\s*/, $Line);
      $Options{$Key} = $Value;
    }
  }
  close $fp;
  return(\%Options);
}