contrib/gpinyin/subs.pl

   1 #! /usr/bin/env perl
   2
   3 # gpinyin - European-like Chinese writing `pinyin' into `groff'
   4
   5 # Source file position: <groff-source>/contrib/gpinyin/gpinyin.pl
   6 # Installed position: <prefix>/bin/gpinyin
   7
   8 # Copyright (C) 2014  Free Software Foundation, Inc.
   9
  10 # Written by Bernd Warken <groff-bernd.warken-72@web.de>.
  11
  12 # This file is part of `gpinyin', which is part of `groff'.
  13
  14 # `groff' is free software; you can redistribute it and/or modify it
  15 # under the terms of the GNU General Public License as published by
  16 # the Free Software Foundation, either version 2 of the License, or
  17 # (at your option) any later version.
  18
  19 # `groff' is distributed in the hope that it will be useful, but
  20 # WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 # General Public License for more details.
  23
  24 # You can find a copy of the GNU General Public License in the internet
  25 # at <http://www.gnu.org/licenses/gpl-2.0.html>.
  26
  27 ########################################################################
  28
  29 ########################################################################
  30 # All Pinyin syllables from wikipedia
  31 ########################################################################
  32
  33 my %syllables =
  34   (
  35    'a' => 1, 'ai' => 1, 'an' => 1, 'ang' => 1, 'ao' => 1,
  36    'ba' => 1, 'bai' => 1, 'ban' => 1, 'bang' => 1, 'bao' => 1,
  37    'bei' => 1, 'ben' => 1, 'beng' => 1,
  38    'bi' => 1, 'bian' => 1, 'biao' => 1, 'bie' => 1, 'bin' => 1,
  39    'bing' => 1, 'bo' => 1, 'bu' => 1,
  40    'ca' => 1, 'cai' => 1, 'can' => 1, 'cang' => 1, 'cao' => 1,
  41    'ce' => 1, 'cen' => 1, 'ceng' => 1,
  42    'cha' => 1, 'chai' => 1, 'chan' => 1, 'chang' => 1, 'chao' => 1,
  43    'che' => 1, 'chen' => 1, 'cheng' => 1, 'chi' => 1,
  44    'chong' => 1, 'chou' => 1, 'chu' => 1,
  45    'chua' => 1, 'chuai' => 1, 'chuan' => 1, 'chuang' => 1,
  46    'chui' => 1, 'chun' => 1, 'chuo' => 1,
  47    'ci' => 1, 'cong' => 1, 'cou' => 1,
  48    'cu' => 1, 'cuan' => 1, 'cui' => 1, 'cun' => 1, 'cuo' => 1,
  49    'da' => 1, 'dai' => 1, 'dan' => 1, 'dang' => 1, 'dao' => 1,
  50    'de' => 1, 'dei' => 1, 'den' => 1, 'deng' => 1,
  51    'di' => 1, 'dian' => 1, 'diao' => 1, 'die' => 1,
  52    'ding' => 1, 'diu' => 1, 'dong' => 1, 'dou' => 1,
  53    'du' => 1, 'duan' => 1, 'dui' => 1, 'dun' => 1, 'duo' => 1,
  54    'e' => 1, 'ei' => 1, 'en' => 1,  'eng' => 1, 'er' => 1,
  55    'fa' => 1, 'fan' => 1, 'fang' => 1,
  56    'fei' => 1, 'fen' => 1, 'feng' => 1, 'fiao' => 1,
  57    'fo' => 1, 'fou' => 1, 'fu' => 1,
  58    'ga' => 1, 'gai' => 1, 'gan' => 1, 'gang' => 1, 'gao' => 1,
  59    'ge' => 1, 'gei' => 1, 'gen' => 1, 'geng' => 1,
  60    'gong' => 1, 'gou' => 1, 'gu' => 1,
  61    'gua' => 1, 'guai' => 1, 'guan' => 1, 'guang' => 1, 'gui' => 1,
  62    'gun' => 1, 'guo' => 1,
  63    'ha' => 1, 'hai' => 1, 'han' => 1, 'hang' => 1, 'hao' => 1,
  64    'he' => 1, 'hei' => 1, 'hen' => 1, 'heng' => 1,
  65    'hong' => 1, 'hou' => 1,
  66    'hu' => 1, 'hua' => 1, 'huai' => 1, 'huan' => 1, 'huang' => 1,
  67    'hui' => 1, 'hun' => 1, 'huo' => 1,
  68    'ji' => 1, 'jia' => 1, 'jian' => 1, 'jiang' => 1, 'jiao' => 1,
  69    'jie' => 1, 'jin' => 1, 'jing' => 1, 'jiong' => 1, 'jiu' => 1,
  70    'ju' => 1, 'juan' => 1, 'jue' => 1, 'jun' => 1,
  71    'ka' => 1, 'kai' => 1, 'kan' => 1, 'kang' => 1, 'kao' => 1,
  72    'ke' => 1, 'kei' => 1, 'ken' => 1, 'keng' => 1,
  73    'kong' => 1, 'kou' => 1, 'ku' => 1, 'kua' => 1, 'kuai' => 1,
  74    'kuan' => 1, 'kuang' => 1, 'kui' => 1, 'kun' => 1, 'kuo' => 1,
  75    'la' => 1, 'lai' => 1, 'lan' => 1, 'lang' => 1, 'lao' => 1,
  76    'le' => 1, 'lei' => 1, 'leng' => 1,
  77    'li' => 1, 'lia' => 1, 'lian' => 1, 'liang' => 1, 'liao' => 1,
  78    'lie' => 1, 'lin' => 1, 'ling' => 1, 'liu' => 1,
  79    'lo' => 1, 'long' => 1, 'lou' => 1,
  80    'lu' => 1, 'luan' => 1, 'lun' => 1, 'luo' => 1,
  81    'lü' => 1, 'lüe' => 1,
  82    'ma' => 1, 'mai' => 1, 'man' => 1, 'mang' => 1, 'mao' => 1,
  83    'me' => 1, 'mei' => 1, 'men' => 1, 'meng' => 1,
  84    'mi' => 1, 'mian' => 1, 'miao' => 1, 'mie' => 1,
  85    'min' => 1, 'ming' => 1, 'miu' => 1,
  86    'mo' => 1, 'mou' => 1, 'mu' => 1,
  87    'na' => 1, 'nai' => 1, 'nan' => 1, 'nang' => 1, 'nao' => 1,
  88    'ne' => 1, 'nei' => 1, 'nen' => 1, 'neng' => 1,
  89    'ni' => 1, 'nian' => 1, 'niang' => 1, 'niao' => 1, 'nie' => 1,
  90    'nin' => 1, 'ning' => 1, 'niu' => 1, 'nong' => 1, 'nou' => 1,
  91    'nu' => 1, 'nuan' => 1, 'nun' => 1, 'nuo' => 1,
  92    'nü' => 1, 'nüe' => 1,
  93    'o' => 1, 'ong' => 1, 'ou' => 1,
  94    'pa' => 1, 'pai' => 1, 'pan' => 1, 'pang' => 1, 'pao' => 1,
  95    'pei' => 1, 'pen' => 1, 'peng' => 1,
  96    'pi' => 1, 'pian' => 1, 'piao' => 1, 'pie' => 1, 'pin' => 1,
  97    'ping' => 1, 'po' => 1, 'pou' => 1, 'pu' => 1,
  98    'qi' => 1, 'qia' => 1, 'qian' => 1, 'qiang' => 1, 'qiao' => 1, 'qie' => 1,
  99    'qin' => 1, 'qing' => 1, 'qiong' => 1, 'qiu' => 1,
 100    'qu' => 1, 'quan' => 1, 'que' => 1, 'qun' => 1,
 101    'ran' => 1, 'rang' => 1, 'rao' => 1, 're' => 1, 'ren' => 1,
 102    'ri' => 1, 'rong' => 1, 'rou' => 1,
 103    'ru' => 1, 'ruan' => 1, 'rui' => 1, 'run' => 1, 'ruo' => 1,
 104    'sa' => 1, 'sai' => 1, 'san' => 1, 'sang' => 1, 'sao' => 1,
 105    'se' => 1, 'sen' => 1, 'seng' => 1,
 106    'sha' => 1, 'shai' => 1, 'shan' => 1, 'shang' => 1, 'shao' => 1,
 107    'she' => 1, 'shei' => 1, 'shen' => 1, 'sheng' => 1, 'shi' => 1,
 108    'shou' => 1, 'shu' => 1, 'shua' => 1, 'shuai' => 1, 'shuan' => 1,
 109    'shuang' => 1, 'shui' => 1, 'shun' => 1, 'shuo' => 1,
 110    'si' => 1, 'song' => 1, 'sou' => 1, 'su' => 1, 'suan' => 1, 'sui' => 1,
 111    'sun' => 1, 'suo' => 1,
 112    'ta' => 1, 'tai' => 1, 'tan' => 1, 'tang' => 1, 'tao' => 1,
 113    'te' => 1, 'teng' => 1,
 114    'ti' => 1, 'tian' => 1, 'tiao' => 1, 'tie' => 1, 'ting' => 1,
 115    'tong' => 1, 'tou' => 1,
 116    'tu' => 1, 'tuan' => 1, 'tui' => 1, 'tun' => 1, 'tuo' => 1,
 117    'wa' => 1, 'wai' => 1, 'wan' => 1, 'wang' => 1,
 118    'wei' => 1, 'wen' => 1, 'weng' => 1, 'wo' => 1, 'wu' => 1,
 119    'xi' => 1, 'xia' => 1, 'xian' => 1, 'xiang' => 1, 'xiao' => 1,
 120    'xie' => 1, 'xin' => 1, 'xing' => 1, 'xiong' => 1, 'xiu' => 1,
 121    'xu' => 1, 'xuan' => 1, 'xue' => 1, 'xun' => 1,
 122    'ya' => 1, 'yai' => 1, 'yan' => 1, 'yang' => 1, 'yao' => 1,
 123    'ye' => 1, 'yi' => 1, 'yin' => 1, 'ying' => 1,
 124    'yo' => 1, 'yong' => 1, 'you' => 1,
 125    'yu' => 1, 'yuan' => 1, 'yue' => 1, 'yun' => 1,
 126    'za' => 1, 'zai' => 1, 'zan' => 1, 'zang' => 1, 'zao' => 1,
 127    'ze' => 1, 'zei' => 1, 'zen' => 1, 'zeng' => 1,
 128    'zha' => 1, 'zhai' => 1, 'zhan' => 1, 'zhang' => 1, 'zhao' => 1,
 129    'zhe' => 1, 'zhei' => 1, 'zhen' => 1, 'zheng' => 1, 'zhi' => 1,
 130    'zhong' => 1, 'zhou' => 1, 'zhu' => 1, 'zhua' => 1, 'zhuai' => 1,
 131    'zhuan' => 1, 'zhuang' => 1, 'zhui' => 1, 'zhun' => 1, 'zhuo' => 1,
 132    'zi' => 1, 'zong' => 1, 'zou' => 1, 'zu' => 1, 'zuan' => 1,
 133    'zui' => 1, 'zun' => 1, 'zuo' => 1,
 134   );
 135
 136 ########################################################################
 137 # Unicode variables for utf8 tty (nroff)
 138 ########################################################################
 139
 140 my %tones1_Unicode =
 141   (
 142    'A' => q(\\[u0100]),
 143    'E' => q(\\[u0112]),
 144    'I' => q(\\[u012A]),
 145    'O' => q(\\[u014C]),
 146    'U' => q(\\[u016A]),
 147    'Ü' => q(\\[u016A]),
 148    'a' => q(\\[u0101]),
 149    'e' => q(\\[u0113]),
 150    'i' => q(\\[u012B]),
 151    'o' => q(\\[u014D]),
 152    'u' => q(\\[u016B]),
 153    'ü' => q(\\[u01D6]),
 154   );
 155
 156 my %tones2_Unicode =
 157   (
 158    'A' => q(\\[u00C1]),
 159    'E' => q(\\[u00C9]),
 160    'I' => q(\\[u00CD]),
 161    'O' => q(\\[u00D3]),
 162    'U' => q(\\[u00DA]),
 163    'Ü' => q(\\[u01D7]),
 164    'a' => q(\\[u00E1]),
 165    'e' => q(\\[u00E9]),
 166    'i' => q(\\[u00ED]),
 167    'o' => q(\\[u00F3]),
 168    'u' => q(\\[u00FA]),
 169    'ü' => q(\\[u01D8]),
 170   );
 171
 172 my %tones3_Unicode =
 173   (
 174    'A' => q(\\[u01CD]),
 175    'E' => q(\\[u011A]),
 176    'I' => q(\\[u01CF]),
 177    'O' => q(\\[u01D1]),
 178    'U' => q(\\[u01D3]),
 179    'Ü' => q(\\[u01D9]),
 180    'a' => q(\\[u01CE]),
 181    'e' => q(\\[u011B]),
 182    'i' => q(\\[u01D0]),
 183    'o' => q(\\[u01D2]),
 184    'u' => q(\\[u01D4]),
 185    'ü' => q(\\[u01DA]),
 186   );
 187
 188 my %tones4_Unicode =
 189   (
 190    'A' => q(\\[u00C0]),
 191    'E' => q(\\[u00C8]),
 192    'I' => q(\\[u00CC]),
 193    'O' => q(\\[u00D2]),
 194    'U' => q(\\[u00D9]),
 195    'Ü' => q(\\[u01DB]),
 196    'a' => q(\\[u00E0]),
 197    'e' => q(\\[u00E8]),
 198    'i' => q(\\[u00EC]),
 199    'o' => q(\\[u00F2]),
 200    'u' => q(\\[u00F9]),
 201    'ü' => q(\\[u01DC]),
 202   );
 203
 204
 205 ########################################################################
 206 # glyph variables for troff
 207 ########################################################################
 208
 209 #my $tone1_macron = '\\[a-]';
 210 #my $tone2_acute = '\\[aa]';
 211 #my $tone3_caron = '\\[ah]';
 212 #my $tone4_grave = '\\[ga]';
 213 my @accents = ( '', '\\[a-]', '\\[aa]', '\\[ah]', '\\[ga]', );
 214
 215 my %tones2_glyphs =
 216   (
 217    'A' => q(\\['A]),
 218    'E' => q(\\['E]),
 219    'I' => q(\\['I]),
 220    'O' => q(\\['O]),
 221    'U' => q(\\['U]),
 222    'a' => q(\\['a]),
 223    'e' => q(\\['e]),
 224    'i' => q(\\['i]),
 225    'o' => q(\\['o]),
 226    'u' => q(\\['u]),
 227   );
 228
 229 my %tones4_glyphs =
 230   (
 231    'A' => q(\\[`A]),
 232    'E' => q(\\[`E]),
 233    'I' => q(\\[`I]),
 234    'O' => q(\\[`O]),
 235    'U' => q(\\[`U]),
 236    'a' => q(\\[`a]),
 237    'e' => q(\\[`e]),
 238    'i' => q(\\[`i]),
 239    'o' => q(\\[`o]),
 240    'u' => q(\\[`u]),
 241   );
 242
 243
 244
 245 ########################################################################
 246 # subs
 247 ########################################################################
 248
 249 # Pinyin consists of syllables with a final number to be translated
 250 # into an accent.  Such numbered syllables are combined into words.
 251 # Such words can have a final punctuation.  A line is a collection of
 252 # such words.
 253
 254 my @roffs = ( 'n',
 255               't',
 256             );
 257
 258 ########################################################################
 259 sub err {
 260   my $s = shift;
 261   print STDERR $s;
 262   1;
 263 } # err()
 264
 265
 266 ########################################################################
 267 sub handle_line {
 268   my $starting_blanks = shift;
 269   my $line = shift;
 270
 271 #&err('handle_line start: ' . $line);
 272
 273   my %outline = ( 'n' => $starting_blanks, 't' => $starting_blanks, );
 274
 275   # transform to Ü only for inside of Perl
 276   $line =~ s/\\
 277              \(:U
 278             /Ü/gx;
 279   $line =~ s/\\
 280              \[:U\]
 281             /Ü/gx;
 282
 283 # handle_line()
 284
 285   # transform to ü only for inside of Perl
 286   $line =~ s/\\
 287              \(:u
 288             /ü/gx;
 289   $line =~ s/\\
 290              \[:u\]
 291             /ü/gx;
 292
 293   $line =~ s/U[eE]/Ü/g;
 294   $line =~ s/u[eE]/ü/g;
 295
 296   $line =~ s/\\\(aq/'/g;        # \(aq is an apostrophe
 297   $line =~ s/\\\[aq\]/'/g;      # \[aq] is an apostrophe
 298   $line =~ s/^[']//;            # remove leading apostrophe
 299   $line =~ s/[']$//;            # remove final apostrophe
 300   $line =~ s/['][']+/'/g;       # combine apostrophe groups
 301   $line =~ s/([0-4])'/$1/;
 302   $line =~ s/([^0-4])'/${1}0/;
 303
 304   my @words = split /\s+/, $line;
 305
 306
 307 # handle_line()
 308   for my $word ( @words ) {
 309 #&err('handle_line word: ' . $word);
 310
 311     next unless ( $word );
 312
 313     # this is a word, maybe composed of several syllables
 314     my $punctuation = $1 if ( $word =~ s/([,.?!:;]*)$// );
 315     # `$word' is now without punctuation
 316
 317     my %outword = &handle_word($word);
 318     next unless ( %outword );
 319
 320     for my $roff ( @roffs ) {
 321 #&err('handle_line roff ' . $roff .  ': ' . $outword{$roff});
 322
 323       # combine words to line
 324       next unless ( $outword{$roff} );
 325
 326       # non-initial space
 327       $outline{$roff} .= ' ' if ( $outline{$roff} );
 328
 329       $outline{$roff} .= $outword{$roff};
 330       $outline{$roff} .= $punctuation;
 331     }
 332   }
 333 #for my $roff ( @roffs ) {
 334 #&err('handle_line end ' . $roff .  ': ' . $outline{$roff});
 335 #}
 336   return %outline;
 337 } # handle_line()
 338
 339
 340 ########################################################################
 341 sub handle_word {
 342   my $word = shift;
 343 #&err('handle_word start: ' . $word);
 344
 345   $word =~ s/5/0/g;             # transform 5 to 0
 346   $word =~ s/([^0-4])$/${1}0/;  # add lacking final no-tone
 347
 348   # remove apostrophes with tone
 349   $word =~ s/
 350               ([0-4])
 351               [']
 352             /$1/gx;
 353   # replace apostrophes without tone by 0
 354   $word =~ s/
 355               ([^0-4])
 356               [']
 357             /${1}0/gx;
 358
 359 # handle_word()
 360   # detect wrong tone numbers
 361   if ( $word =~ s/[5-9]/0/g ) {
 362     &err('word ' . $word . ': wrong tone number ' . $1);
 363     return {};
 364   }
 365
 366   $word =~ s/[']//g;            # remove apostrophes
 367
 368   # remove starting apostrophe or number
 369   $word =~ s/^(['0-4])+//;
 370
 371   # add 0 for final no-tone
 372   $word .= '0' if ( $word =~ /[^0-4]$/ );
 373
 374   if ( $word =~ /^[0-9]/ ) {    # word starts with number
 375     print 'word: ' . $word . ' starts with tone number';
 376     $word =~ s/^[0-9]+//;
 377   }
 378 #&err('handle_word 0: ' . $word);
 379
 380 # handle_word()
 381
 382   my %outword = ( 'n' => '', 't' => '', );
 383
 384   # split word into syllables
 385   while ( $word =~ /^[a-zA-ZüÜ']/ ) {
 386     $word =~ s/^([a-zA-ZüÜ']+)([0-4])//;
 387     my $syll = $1;
 388     my $tone = $2;
 389 #err('handle_word split: ' . $syll . ' ' . $tone);
 390     my %outsyll = &handle_syll( $syll, $tone );
 391     next unless ( %outsyll );
 392     for my $roff ( @roffs ) {
 393       my $out = $outsyll{$roff};
 394       $out = '\\[aq]' . $out if ( $out && $out =~ /^[aeo]/ );
 395       $outword{$roff} .= $out;
 396 #&err('handle_word ' . $roff . ': ' . $outword{$roff});
 397     }
 398   }
 399   return %outword;
 400 } # handle_word()
 401
 402
 403 ########################################################################
 404 sub handle_syll {
 405   my $syll = shift;
 406   my $tone = shift;
 407 #&err( 'handle_syll start: ' . $syll . ' ' . $tone);
 408
 409   my $lower_case = lc($syll);
 410   $lower_case =~ s/Ü/ü/g;
 411   unless ( exists($syllables{$lower_case}) ) {
 412     err('The syllable ' . $syll . ' is not a Chinese syllable.');
 413     return {};
 414   }
 415
 416   my %outsyll = ( 'n' => '', 't' => '', );
 417
 418   if ( $tone == 0 ) {   # no accent
 419     # use u umlaut without accent
 420     $syll =~ s/Ü/\\[:U]/g;
 421     $syll =~ s/ü/\\[:u]/g;
 422
 423     for my $roff ( @roffs ) {
 424       $outsyll{$roff} = $syll;
 425 #&err('handle_syll 0 outsyll ' . $roff . ': ' . $outsyll{$roff});
 426     }
 427     return %outsyll;
 428   }     # end of tone 0
 429
 430 # handle_syll()
 431
 432   # split syllable
 433   $syll =~
 434     /^
 435      ([a-zA-Z]*)
 436      ([aeiouAEIOUüÜ]+)
 437      ([a-zA-Z]*)
 438      $/x;
 439   my $initial = $1;
 440   my $vowels = $2;
 441   my $final = $3;
 442   unless ( $vowels ) {
 443     &err( 'Syllable ' . $syll . ' does not have vowels' );
 444     return {};
 445   }
 446
 447   # split vowels
 448   my $vowels_before = '';
 449   my $vowel = '';
 450   my $vowels_after = '';
 451
 452 # handle_syll()
 453
 454   # find vowel for accent
 455   if ( $vowels =~ /^[aeiouAEIOU]$/ ) {          # only 1 vowel
 456 #&err('handle_syll single vowel ' . $vowels);
 457     $vowel = $vowels;
 458   } elsif ( $vowels eq 'ü' ) {
 459     $vowel = $vowels;
 460   } elsif ( $vowels eq 'Ü' ) {
 461     $vowel = $vowels;
 462   } elsif ( $vowels =~ /^([^aeAE]*)([aeAE])(.*)$/ ) {   # a, A, e or E
 463     $vowels_before = $1;
 464     $vowel = $2;
 465     $vowels_after = $3;
 466   } elsif ( $vowels =~ /^([^oO]*)(oO)(.*)$/ ) {         # o or O
 467     $vowels_before = $1;
 468     $vowel = $2;
 469     $vowels_after = $3;
 470   } elsif ( $vowels =~ /^(\w)(\w)(.*)$/ ) {             # take 2nd vowel
 471     $vowels_before = $1;
 472     $vowel = $2;
 473     $vowels_after = $3;
 474   } else {
 475     &err( 'Unknown vowels: ' . $vowels . ' in syllable: ' . $syll );
 476     return {};
 477   }
 478
 479 #  unless ( $vowel =~ /^[aeiouAEIOU]$/ ) {
 480 #    print STDERR q(The argument `) . $vowel . q(' is not a vowel!);
 481 #    return {};
 482 #  }
 483
 484 # handle_syll()
 485
 486   $outsyll{'n'} = &vowel_n($vowel, $tone);
 487   $outsyll{'t'} = &vowel_t($vowel, $tone);
 488
 489   for my $roff ( @roffs ) {
 490     $outsyll{$roff} = $initial .  $vowels_before .
 491       $outsyll{$roff} . $vowels_after .  $final;
 492 #&err('handle_syll out ' . $roff . ': ' . $outsyll{$roff});
 493   }
 494
 495   return %outsyll;
 496 } # handle_syll()
 497
 498
 499 ########################################################################
 500 sub vowel_n {   # Unicode for nroff
 501   my $vowel = shift;
 502   my $tone = shift;
 503 #&err('vowel_n: ' . $vowel . ' ' . $tone);
 504
 505   return '' unless ( $vowel );
 506
 507   if ( $tone == 1 ) {           # macron
 508     $vowel = $tones1_Unicode{$vowel};
 509   } elsif ( $tone == 2 ) {      # acute
 510     $vowel = $tones2_Unicode{$vowel};
 511   } elsif ( $tone == 3 ) {      # caron
 512     $vowel = $tones3_Unicode{$vowel};
 513   } elsif ( $tone == 4 ) {      # grave
 514     $vowel = $tones4_Unicode{$vowel};
 515   }
 516   return $vowel;
 517 } # vowel_nr()
 518
 519
 520 ########################################################################
 521 sub vowel_t {   # named glyphs for troff
 522   my $vowel = shift;
 523   my $tone = shift;
 524 #&err( 'vowel_t: ' . $vowel . ' ' . $tone);
 525
 526   return '' unless ( $vowel );
 527
 528   # \o'\s-2\[:u]\s0\[a-]'
 529   if ( $vowel =~ /[üÜ]/ ) {
 530     my $smaller = 2;
 531     $vowel = q(\\o'\\s-) . $smaller . q(\\[:u]\\s0) .
 532       $accents[$tone] . q(');
 533     return $vowel;
 534   }
 535
 536   $vowel = q(\\[.i]) if ( $vowel eq 'i' );
 537
 538   if ( $tone == 1 ) {           # macron
 539     $vowel = q(\\o') . $vowel . $accents[$tone] . q(');
 540   } elsif ( $tone == 2 ) {      # acute
 541     $vowel = $tones2_glyphs{$vowel};
 542   } elsif ( $tone == 3 ) {      # caron
 543     $vowel = q(\\o') . $vowel . $accents[$tone] . q(');
 544   } elsif ( $tone == 4 ) {      # grave
 545     $vowel = $tones4_glyphs{$vowel};
 546   }
 547   return $vowel;
 548 } # vowel_t()
 549
 550
 551 ########################################################################
 552 sub finish_pinyin_mode {
 553 #&err( 'finish' );
 554   my $n = shift;
 555   my $t = shift;
 556   push @$n, '\\}';
 557   push @$t, '\\}';
 558
 559   for ( @$n ) { # Unicode for nroff
 560     print;
 561   }
 562
 563   for ( @$t ) { # glyphs for troff
 564     print;
 565   }
 566
 567   1;
 568 } # finish_pinyin_mode()
 569
 570
 571 1;
 572 ########################################################################
 573 ### Emacs settings
 574 # Local Variables:
 575 # mode: CPerl
 576 # End: