О переводе карт на русский язык

[shoorick]

Карты с http://corsar.avtostop.ru/gps/index.html хороши тем, что их много: охватывают все интересующие меня области. Но плохи тем, что в них все названия набраны BOL'SHIMI BUKVAMI TRANSLITOM. Конечно, привыкнуть можно, но попробуй-ка прочитать, а тем более написать какое-нибудь местное название: особенности местной топонимики (названия у нас бывают трёх типов: русские, советские и татаро-башкирские) развивают лингвистическую прыть ума, но на транслит ума уже не остаётся. Кстати, советские названия не случайно вынесены в отдельную от русских категорию: сравните, например, русские посёлки Сосновка, Фёдоровка, Малиновка с советскими посёлками и улицами: Первомайский, Новоэлеваторная, Трубосварочная, Рабоче-Колхозная, Ферросплавная и, на закуску, Тридцать второй Годовщины Октября.

Ощутив в себе стремление к русификации, бросился переделывать названия в картах, ибо моя GPS кириллицу (кроме буквы Ё) понимает, но, оценив масштабы бедствия, остановился: только на весьма неполной карте города нанесено 800 объектов с именами. Переводить всё вручную — не наш метод!

Наш метод таков: перегнать карту в Польский формат, обработать её скриптом, а дальше работать уже с результатом.

#!perl
# Переводит названия в картах формата mp с сайта http://corsar.autostop.ru/
# с транслита на русский язык
# 01-02.04.2006  Alexander Sapozhnikov  http://shoorick.ru/ 

use locale;
use POSIX qw(locale_h);
setlocale (LC_ALL, "ru_RU.CP1251");

# Транслит сложных букв
%pr = (
'AY' => 'ай', 'CH' => 'ч', 'EY' => 'ей', 'GH' => 'ж', 'IY' => 'ий', 'KH' => 'х',
'OY' => 'ой', 'SH' => 'ш', 'UY' => 'уй', 'YA' => 'я', 'YE' => 'е', 'YO' => 'ё',
'YU' => 'ю', 'YY' => 'ый', 'ZH' => 'ж', 'йA' => 'я', 'йE' => 'е', 'йO' => 'ё',
'йY' => 'ю', 'щч' => 'щ');

# Специфические замены
%prw = ('аирпорт' => 'аэропорт', '\bе(ле[вкр])' => 'э$1', '\bенер' => 'энер',
'-И' => '-I', '-IИ' => '-II', 'раён' => 'район', 'маёр' => 'майор');

while (<>)
{
 if (/^(Label=)(.+)$/)  # Переводим на русский только метки
 {
  $s = $2;
  # Сначала меняем сложные буквы
  foreach $k (sort(keys(%pr)))
  {
   $s =~ s/$k/$pr{$k}/gi;
  }
  # Затем - простые
  $s =~ tr/ABCDEFGHIJKLMNOPRSTUVYZ'/абцдефгхийклмнопрстувызь/;
  # Специфические замены
  foreach $k (keys(%prw))
  {
   $s =~ s/$k/$prw{$k}/gi;
  }
  # Регистр символов
  $s = ucfirst($s);
  $s =~ s/\.\s*(\w)/. \U$1/g;
  $s =~ s/(-\w)/\U$1/g;
  $s =~ s/\s+(\w)/ \U$1/g;
  $s =~ s/ (Ул|Пр(осп)?|Пер|Тр|Ш)\.$/ \L$1./g;
  $s =~ s/Область/область/g;
  
  $_ = "Label=$s\n";
 } # if

 print;
} # while

И, что интересно, работает!