ru.perl

 
 - RU.PERL ----------------------------------------------------------------------
 From : Oleg Bakiev                          2:5061/109.58  20 Jun 2000  11:42:03
 To : Prokhorov Andrew
 Subject : Очень нужно
 -------------------------------------------------------------------------------- 
 

 
 18 Jun 00 00:28, Prokhorov Andrew wrote to All:
 
  PA> Я недавно бросал мессагу с просьбой привести алгоритм или пример
  PA> исходника на ПЕРЛЕ для перевода чисел в пропись. Откликнулся только
  PA> один добрый человек, но пример скрипта был в непонятной кодировке,
  PA> которую мне не удалось прочитать. Обращаюсь ко всем с повторной
  PA> просьбой помочь с алгоритмом или кинуть уже готовый пример программы,
  PA> если у кого есть.
 === Cut ===
 
 # параметры: число, род единицы измерения (1 - М, 0 - Ж),
 # ссылка на список из трех названий в соотв. падежах
 #   (род. множ., именит. единств., родит. множ.
 # (по образцу заполнения @names) или несклоняемое название
 sub StrNum {
      my ($n,$m,$cases) = @_;
      my ($nn,$n1,$n2,$num,$s);
      my $i;
      my $ind;
      my @names = ($cases, ["тысяч","тысяча","тысячи"],
          ["миллионов",  "миллион", "миллиона"],
          ["миллиардов", "миллиард", "миллиарда"],
          ["триллионов", "триллион", "триллиона"]);
      my @sex = ($m,0,1,1,1);
 
      $nn = $n+0;
 
      for ($i = 0; $nn > 0; $i ++) {
          $num = substr("000$nn", -3,3);
          $n1 = substr($num,-1);
          $n2 = substr($num,-2,1);
          if ($n2 == 1) {
              $ind = 0;
          } else {
              if ($n1 == 1) {
                  $ind = 1;
              } elsif ($n1 >= 2 && $n1 <= 4) {
                  $ind = 2;
              } else {
                  $ind = 0;
              }
          }
          $s = ' ' . S1000($num, $sex[$i]) . ' ' .
              (ref $names[$i] ? $names[$i] -> [$ind] : $names[$i]) . $s;
          $nn = substr("000$nn",0, length($nn));
      }
 
      return $s;
  }
 
 sub S1000 {
     my ($n,$m) = @_;
 #' m - индикатор male/female рода предмета
     my ($nn,$s);
     my ($n3,$n2,$n1) = unpack('AAA',substr("000$n",-3));
     my @ar_n3 = qw(сто двести триста четыреста пятьсот шестьсот
          семьсот восемьсот девятьсот);
 
     my @ar_n2n1 = qw(десять одиннадцать двенадцать тринадцать
         четырнадцать пятнадцать шестнадцать семнадцать восемнадцать      
 девятнадцать);
 
     my @ar_n2 = qw(хмм двадцать тридцать сорок пятьдесят шестьдесят
         семьдесят восемьдесят девяносто);
 
     my @ar_n1 = ($m ? ('один','два') : ('одна','две'),"три","четыре",
             "пять","шесть", "семь","восемь","девять");
 
     $n3 --;
     $n2 --;
     $n1 --;
 
     $s = $ar_n3[$n3] if ($n3 >= 0);
     if ($n2 == 0) {
         $s .= ' ' . $ar_n2n1[$n1 + 1];
         return $s;
     } elsif ($n2 > 0) {
         $s .= " $ar_n2[$n2]";
     }
 
     $s .= ' ' if (($n3 >= 0 || $n2 > 0) && $n1 >= 0);
     $s .= $ar_n1[$n1] if ($n1 >= 0);
     return $s;
 
 }
 
 === Cut ===
 WBR, Oleg
 --- GoldED/W32 3.0.1
  * Origin:  >>> Можно я лягу? <<< (2:5061/109.58)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор 

Тема:    Автор:    Дата:    Очень нужно   Prokhorov Andrew   17 Jun 2000 21:53:32   Re: Очень нужно   Ilya Rubtsov   17 Jun 2000 22:39:48   Re: Очень нужно   Alexander Gaiduk   19 Jun 2000 11:57:40   Очень нужно   Oleg Bakiev   20 Jun 2000 11:42:03