#!perl

#  This program massages the driving directions (in USA) for plain tex
+t
#  printing (preferably in monospace font, w/ a blank line between eac
+h non
#  empty line), with these priorities (in no particular order) ...
#   - up-case road names, exit numbers, places
#   - low-case everything else
#   - expand n, w, e, s to north, west, east, south
#   - shorten road type (like mailing address), e.g. 'road' to 'rd', '
+lane' to
#     'ln', etc.
#   - removes the annoying 'go' from 'go <this much>'

use warnings; use strict;

my ( $geo_pos , $roads ) = ( get_geo_pos() , get_road() );

my @relative_pos = map uc( $_ ) , qw(left middle center right) ;

#  Got a better name for this variable?
my $less_important_than_roads_places =
  qr{ \b
      ( bear | stay | head | continue | follow | go | take | turn
       | entry | ramp | (?: to | fore? )w[oa]rds?
       | on.?to | on | to | for | at | off?  | then | t?here | from
       | an?d?
       | (?: h(?:ou)?r | min(?:ute)? | second | moment )s?
       | ph(?:one)? | fax | e.?mail | home | office | work | cell | mo
+bile
      )
      \b
    }xi;

my $misc_edits =
  {
    'and' => '&'
  , 'hour' => 'hr'
  , 'minutes?' => 'min'
  , 'seconds' => 'second'
  , 'phone' => 'ph'
  , 'fore?w[oa]rd' => 'forward'
  , 'toword' => 'toward'
  } ;

{
  local $^I = '' ;
  while ( <> )
  {
    s{ \s+ the \s+ }/ /xig;

    s{ \b go (?: \s+ for )? \s+ (\d) }/ $1/xige;

    $_ = uc $_;

    s{ (\d) \W* ( mi(?:le)? | ft) \b }/"$1~" . lc $2/xige;

    s{ $less_important_than_roads_places }/lc $1/xige;

    for my $map ( $roads , $geo_pos , $misc_edits )
    {
      while ( my ( $k , $v ) = each %$map )
      {
        s[ \b $k \b ]/$v/xig;
      }
    }

    for my $r ( values %$roads )
    {
      s/\b $r \./$r/xig;
    }

    s/^[ \t]+//g;
    s/[ \t]+$//g;
    s/[ \t]+/ /g;
    print;
  }
}

sub get_geo_pos
{
  my @points =
    qw(
        east west north south
        north-east north-west south-east south-west
        east-north east-south west-north west-south
      ) ;
  my %points ;
  foreach ( @points )
  {
    m{^ ([a-z])[a-z]+ (?: \W+ ( [a-z])[a-z]+ )? $}xi;
    $points{ $2 ? "$1$2" : $1 } = uc $_ ;
  }
  return { %points };
}

sub get_road
{
  my %roads =
    (
      'avenue' => 'ave'
    , 'av' => 'ave'
    , 'circle' => 'crl'
    , 'court' => 'ct'
    , 'crt' => 'ct'
    , 'drive' => 'dr'
    , 'lane' => 'ln'
    , 'pk' => 'pike'
    , 'parkway' => 'pkwy'
    , 'pky' => 'pkwy'
    , 'road' => 'rd'
    , 'route' => 'rt'
    , 'street' => 'st'
    , 'tpk' => 'turnpike'
    , 'turn.?pk' => 'turnpike'
    );

  $_ = uc $_ for values %roads;
  return { %roads };
}
[download]