Description: |
This program massages the driving directions (in USA) for plain text printing (preferably in monospace font, w/ a blank line between each 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>'
|
#!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 };
}
|