# madoka 4.2 kanji
#
#  kanji.mpi
#    Copyright(c)1998- cookie / The madoka project
#

&list_add($plugin_list, 'kanji');
1;

sub kanji_code {
  local $src = $_[0];
  local $l = length($src);
  local($i, $c);
  for ($i = 0; $i < $l; $i++) {
    $c = ord(substr($src, 0));
    $src = substr($src, 1);
    if ($c == 0x1b) {
      if ($src =~ /^\$[\@B]/i || $src =~ /^\(I/i) {
	return 'jis';
      }
    } elsif ($c >= 0x81 && $c <= 0xfe) {
      if ($c == 0x8e) {
	if ($src =~ /^[\xa1-\xdf]/) {
	  return 'euc';
	} elsif ($src =~ /^[\x40-\x7e\x80-\xfc]/) {
	  return 'sjis';
	}
      } elsif ($c <= 0x9f) {
	if ($src =~ /^[\x40-\x7e\x80-\xfc]/) {
	  return 'sjis';
	}
      } elsif ($c >= 0xa1 && $c <= 0xdf || $c == 0xfd || $c == 0xfe) {
	if ($src =~ /^[\xa1-\xfe]/) {
	  unless ($src =~ /^[\xa0-\xdf]/) {
	    return 'euc';
	  } else {
	    return &_kanji_code($src);
	  }
	}
      } elsif ($c >= 0xe0 && $c <= 0xfc) {
	if ($src =~ /^[\x40-\x7e\x80-\xfc]/) {
	  unless ($src =~ /^[\xa1-\xfe]/) {
	    return 'sjis';
	  } else {
	    return &_kanji_code($src);
	  }
	} else {
	  if ($src =~ /^[\xa1-\xfe]/) {
	    return 'euc';
	  }
	}
      }
    }
  }
  return 'jis';
}
sub _kanji_code {
  local $src = $_[0];
  local $l = length($src);
  local($jis, $euc, $sjis) = (0, 0, 0);
  local($i, $c, $code);
  for ($i = 0; $i < $l; $i++) {
    $c = ord(substr($src, 0));
    $src = substr($src, 1);
    if ($c == 0x1b) {
      if ($src =~ /^\$[\@B]/i || $src =~ /^\([JB]/i) {
	$jis++;
      }
    } elsif ($c >= 0x81 && $c <= 0xfe) {
      if ($c == 0x8e) {
	last if length($src) < 1;
      } elsif ($c <= 0x9f) {
	last if length($src) < 1;
	if ($src =~ /^[\x40-\x7e\x80-\xfc]/) {
	  $sjis++;
	}
      } elsif ($c >= 0xa1 && $c <= 0xdf) {
	if (length($src) < 1) {
	  $euc += .5;
	  $sjis += .5;
	} elsif ($src =~ /^[\xa0-\xdf]/) {
	  $euc += .5;
	  $sjis += .5;
	} elsif ($src =~ /^[\xa1-\xfe]/) {
	  $euc++;
	}
      } elsif ($c != 0xa0) {
	$euc++;
      }
    }
    last if length($src) < 1;
  }
  $code = 'euc';
  if ($jis > $euc && $jis > $sjis) {
    $code = 'jis';
  } elsif ($euc > $jis && $euc > $sjis) {
    $code = 'euc';
  } elsif ($sjis > $jis && $sjis > $euc) {
    $code = 'sjis';
  }
  return $code;
}
# $c > 0xa0 && $c < 0x80 (jis)
# $c > 0xa0 && $c < 0xff (euc)
# $c > 0x9f && $c < 0xe0 (kana)
# $c > 0x80 && $c < 0xa0 || $c > 0xdf && $c < 0xfd (kanji1st)
# $c > 0x3f && $c < 0xfd && $c != 0x7f (kanji2nd)
sub kanji_jis {
  local(*mes, $code) = @_;
  $code = &kanji_code($mes) unless $code;
  local $src = $mes;
  local($jis, $kana, $n) = (0, 0, '');
  local($i, $c, $c2);
  if ($code eq 'jis') {
    local $l = length($src);
    for ($i = 0; $i < $l; $i++) {
      $c = ord(substr($src, 0, 1));
      if (length($src) < 2) {
	$src = '';
      } else {
	$src = substr($src, 1);
      }
      if ($c == 0x1b) {
	if ($src eq '') {
	  $n .= "\e\(B";
	  $jis = 0;
	  last;
	} elsif ($src =~ /^\$/) {
	  if ($src eq '\$') {
	    $n .= "\e\$B";
	    $jis = 1;
	    last;
	  } elsif ($src =~ /^\$[\@B]/i) {
	    $n .= "\e\$B";
	    $jis = 1;
	    $src = substr($src, 2);
	  }
	} elsif ($src =~ /^\(/) {
	  if ($src eq '(') {
	    $n .= "\e\(B";
	    $jis = 0;
	    last;
	  } elsif ($src =~ /^\([BHJ]/i) {
	    $n .= "\e\(B";
	    $jis = 0;
	    $src = substr($src, 2);
	  } elsif ($src =~ /^\(I/i) {
	    $n .= "\e\(I";
	    $jis = 1;
	    $src = substr($src, 2);
	  } else {
	    $n .= "\e\(";
	    $src = substr($src, 1);
	  }
	} else {
	  $n .= "\e";
	}
      } elsif ($c == 0x0a || $c == 0x0d) {
        if ($jis == 1) {
          $n .= "\e\(B";
          $jis = 0;
        }
        $n .= sprintf("%c", $c);
      } else {
	$n .= sprintf("%c", $c);
      }
      last if $src eq '';
    }
    $n .= "\e\(B" if $jis == 1;
  } elsif ($code eq 'euc') {
    local $l = length($src);
    for ($i = 0; $i < $l; $i++) {
      $c = ord(substr($src, 0, 1));
      if (length($src) < 2) {
	$src = '';
      } else {
	$src = substr($src, 1);
      }
      if ($c < 0x80) {
	if ($jis) {
	  $n .= "\e\(B";
	  $jis = 0;
	} elsif ($kana) {
	  $n .= "\e\(B";
	  $kana = 0;
	}
	$n .= sprintf("%c", $c);
      } elsif ($c >= 0xa1 && $c <= 0xfe) {
	if ($src eq '') {
	  if ($jis) {
	    $n .= "\e\(B";
	    $jis = 0;
	  } elsif ($kana) {
	    $n .= "\e\(B";
	    $kana = 0;
	  }
	  $n .= sprintf("%c", $c);
	  last;
	}
	if (!$jis) {
	  if ($kana) {
	    $kana = 0;
	  }
	  $n .= "\e\$B";
	  $jis = 1;
	}
	if ($src =~ /^[\xa1-\xfe]/){
	  $n .= sprintf("%c", $c & 0x7f);
	  $n .= sprintf("%c", ord($&) & 0x7f);
	  $src = substr($src, 1);
	} else {
	  $n .= sprintf("%c", $c) . substr($src, 0, 1);
	  $src = substr($src, 1);
	}
      } elsif ($c == 0x8e) {
	if ($src eq '') {
	  if ($jis) {
	    $n .= "\e\(B";
	    $jis = 0;
	  } elsif ($kana) {
	    $n .= "\e\(B";
	    $kana = 0;
	  }
	  $n .= sprintf("%c", $c);
	  last;
	}
	if (!$kana || $jis) {
	  $n .= "\e\(I";
	  $jis = 0;
	}
	$kana = 1;
	$n .= sprintf("%c", ord(substr($src, 0, 1)) & 0x7f);
	$src = substr($src, 1);
      } else {
	if ($jis) {
	  $n .= "\e\(B";
	  $jis = 0;
	} elsif ($kana) {
	  $n .= "\e\(B";
	  $kana = 0;
	}
	$n .= sprintf("%c", $c);
      }
      if ($src eq '') {
	if ($jis) {
	  $n .= "\e\(B";
	  $jis = 0;
	} elsif ($kana) {
	  $n .= "\e\(B";
	  $kana = 0;
	}
	last;
      }
    }
  } elsif ($code eq 'sjis') {
    local $l = length($src);
    for ($i = 0; $i < $l; $i++) {
      $c = ord(substr($src, 0, 1));
      if (length($src) < 2) {
	$src = '';
      } else {
	$src = substr($src, 1);
      }
      if ($c <= 0x80) {
	if ($jis) {
	  $n .= "\e\(B";
	  $jis = 0;
	} elsif ($kana) {
	  $n .= "\e\(B";
	  $kana = 0;
	}
	$n .= sprintf("%c", $c);
      } elsif ($c >= 0x81 && $c <= 0x9f || $c >= 0xe0 && $c <= 0xfc) {
	if ($src eq '') {
	  if ($jis) {
	    $n .= "\e\(B";
	    $jis = 0;
	  } elsif ($kana) {
	    $n .= "\e\(B";
	    $kana = 0;
	  }
	  $n .= sprintf("%c", $c);
	  last;
	}
	if (!$jis) {
	  if ($kana) {
	    $kana = 0;
	  }
	  $n .= "\e\$B";
	  $jis = 1;
	}
	if ($src =~ /^[\x40-\x7e\x80-\xfc]/) {
	  $c2 = ord($&);
	  $c -= ($c < 0xa0) ? 0x70 : 0xb0;
	  $c <<= 1;
	  if ($c2 >= 0x40 && $c2 <= 0x9f) {
	    $c2 -= ($c2 < 0x7f) ? 0x1f : 0x20;
	    $c--;
	  } else {
	    $c2 -= 0x7e;
	  }
	  $n .= sprintf("%c%c", $c, $c2);
	  $src = substr($src, 1);
	}
      } elsif ($c >= 0xa0 && $c <= 0xdf) {
	if (!$kana || $jis) {
	  $n .= "\e\(I";
	  $jis = 0;
	}
	$kana = 1;
	$n .= sprintf("%c", $c & 0x7f);
      } else {
	if ($jis) {
	  $n .= "\e\(B";
	  $jis = 0;
	} elsif ($kana) {
	  $n .= "\e\(B";
	  $kana = 0;
	}
	$n .= sprintf ("%c", $c);
      }
      if ($src eq '') {
	if ($jis) {
	  $n .= "\e\(B";
	  $jis = 0;
	} elsif ($kana) {
	  $n .= "\e\(B";
	  $kana = 0;
	}
	last;
      }
    }
  }
  $mes = $n;
}
sub kanji_euc {
  local(*mes, $code) = @_;
  $code = &kanji_code($mes) unless $code;
  local $src = $mes;
  local($jis, $kana, $n) = (0, 0, '');
  local($c, $c2, $i);
  if ($code eq 'jis') {
    local $l = length($src);
    for ($i = 0; $i < $l; $i++) {
      $c = ord(substr($src, 0, 1));
      if (length($src) < 2) {
	$src = '';
      } else {
	$src = substr($src, 1);
      }
      if ($c == 0x1b) {
	if ($src eq '') {
	  $n .= "\e";
	  last;
	} elsif ($src =~ /^\$/) {
          if ($src eq '\$') {
            $n .= "\e\$B";
            last;
          } elsif ($src =~ /^\$[\@B]/i) {
	    $jis = 1;
	    $kana = 0;
	    $src = substr($src, 2);
	  } else {
	    $n .= "\e\$";
	    $src = substr($src, 1);
	  }
	} elsif ($src =~ /^\(/) {
	  if ($src eq '(') {
	    $n .= "\e\(";
	    last;
	  } elsif ($src =~ /^\([BHJ]/i) {
	    $jis = 0;
	    $kana = 0;
	    $src = substr($src, 2);
	  } elsif ($src =~ /^\(I/i) {
	    $jis = 0;
	    $kana = 1;
	    $src = substr($src, 2);
	  } else {
	    $n .= "\e\(";
	    $src = substr($src, 1);
	  }
	} else {
	  $n .= "\e";
	} 
      } elsif ($c <= 0x20 || $c == 0x7f) {
	$n .= sprintf("%c", $c);
      } elsif ($kana) {
	if ($src eq '') {
	  $n .= sprintf("%c", $c | 0x80) . "\e\(B";
	  last;
	}
	$n .= "\x8e" . sprintf("%c", $c | 0x80);
      } elsif ($jis) {
	if ($src eq '') {
	  $n .= sprintf("%c", $c);
	  last;
	} elsif ($src =~ /^[\x00-\x20\x7f]/) {
	  $n .= sprintf("%c", $c);
	}
	$c2 = ord(substr($src, 0, 1));
	$n .= sprintf("%c%c", $c | 0x80, $c2 | 0x80);
	$src = substr($src, 1);	
      } else {
	if ($c >= 0xa0 && $c <= 0xdf) {
	  $n .= "\x8e";
	}
	$n .= sprintf("%c", $c);
      }
      last if $src eq '';
    }
  } elsif ($code eq 'euc') {
    $n .= $src;
  } elsif ($code eq 'sjis') {
    local $l = length($src);
    for ($i = 0; $i < $l; $i++) {
      $c = ord(substr($src, 0, 1));
      if (length($src) < 2) {
	$src = '';
      } else {
	$src = substr($src, 1);
      }
      if ($c < 0x80) {
	$n .= sprintf("%c", $c);
      } elsif ($c >= 0x81 && $c <= 0x9f || $c >= 0xe0 && $c <= 0xfc) {
	if ($src eq '') {
	  $n .= sprintf("%c", $c);
	  last;
	} elsif ($src =~ /^[\x40-\x7e\x80-\xfc]/) {
	  $c2 = ord($&);
	  $c -= ($c < 0xa0) ? 0x70 : 0xb0;
	  $c <<= 1;
	  if ($c2 >= 0x40 && $c2 <= 0x9e) {
	    $c2 -= ($c2 < 0x7f) ? 0x1f : 0x20;
	    $c--;
	  } else {
	    $c2 -= 0x7e;
	  }
	  $n .= sprintf("%c%c", ($c | 0x80), ($c2 | 0x80));
	  $src = substr($src, 1);
	} else {
	  $n .= sprintf("%c", $c) . substr($src, 0, 1);
	  $src = substr($src, 1);
	}
      } elsif ($c >= 0xa0 && $c <= 0xdf) {
	$n .= "\x8e" . sprintf("%c", $c);
      } else {
	$n .= sprintf("%c", $c);
      }
      last if $src eq '';
    }
  }
  $mes = $n;
}
sub kanji_sjis {
  local(*mes, $code) = @_;
  $code = &kanji_code($mes) unless $code;
  local $src = $mes;
  local($jis, $kana, $n) = (0, 0, '');
  local($c, $c2, $i);
  if ($code eq 'jis') {
    local $l = length($src);
    for ($i = 0; $i < $l; $i++) {
      $c = ord(substr($src, 0, 1));
      if (length($src) < 2) {
	$src = '';
      } else {
	$src = substr($src, 1);
      }
      if ($c == 0x1b) {
	if ($src eq '') {
	  $n .= "\e";
	  $jis = 0;
	  last;
	} elsif ($src =~ /^\$/) {
	  if ($src eq '\$') {
	    $n .= "\e\$";
	    $jis = 0;
	  }  elsif ($src =~ /^\$[\@B]/i) {
	    $jis = 1;
	    $src = substr($src, 2);
	  }
	} elsif ($src =~ /^\(/) {
	  if ($src eq '(') {
	    $n .= "\e\(";
	    $jis = 0;
	    last;
	  } elsif ($src =~ /^\([BHJ]/i) {
	    $jis = 0;
	    $src = substr($src, 2);
	  } elsif ($src =~ /^\(I/i) {
	    $jis = 1;
	    $src = substr($src, 2);
	  } else {
	    $n .= "\e\(";
	    $src = substr($src, 1);
	  }
	} else {
	  $n .= "\e";
	}
      } elsif ($c <= 0x20 || $c == 0x7f) {
	$n .= sprintf("%c", $c);
      } elsif ($jis) {
	if ($src eq '') {
	  $n .= sprintf("%c", $c);
	  last;
	}
	if ($src =~ /^[\x00-\x20]/) {
	  $n .= sprintf("%c", $c);
	  $src = substr($src, 1);
	  next;
	}
	if ($c < 0x80 && $src =~ /^[\x00-\x7f\xa1-\xff]/) {
	  $c2 = ord($&);
	  if ($c & 1) {
	    $c = ($c >> 1) + 0x71;
	    $c2 += 0x1f;
	    $c2++ if $c2 >= 0x7f;
	  } else {
	    $c = ($c >> 1) + 0x70;
	    $c2 += 0x7e;
	  }
	  $c += 0x40 if $c > 0x9f;
	  $n .= sprintf("%c%c", $c, $c2);
          $src = substr($src, 1);
	} else {
	  $n .= sprintf("%c", $c) . substr($src, 0, 1);
	  $src = substr($src, 1);
	}
      } else {
	$n .= sprintf("%c", $c);
      }
      last if $src eq '';
    }
  } elsif ($code eq 'sjis') {
    $n .= $src;
  } elsif ($code eq 'euc') {
    local $l = length($src);
    for ($i = 0; $i < $l; $i++) {
      $c = ord(substr($src, 0, 1));
      if (length($src) < 2) {
        $src = '';
      } else {
        $src = substr($src, 1);
      }
      if ($c < 0x80) {
	$n .= sprintf("%c", $c);
      } elsif ($c > 0xa0 && $c < 0xff) {
	if ($src eq '') {
	  $n .= sprintf("%c", $c);
	  last;
	} elsif ($src =~ /^[\xa1-\xfe]/) {
          $c2 = ord($&) & 0x7f;
	  $c &= 0x7f;
          if ($c & 1) {
            $c = ($c >> 1) + 0x71;
            $c2 += 0x1f;
            $c2++ if $c2 >= 0x7f;
          } else {
            $c = ($c >> 1) + 0x70;
            $c2 += 0x7e;
          }
          $c += 0x40 if $c > 0x9f;
	  $n .= sprintf("%c%c", $c, $c2);
          $src = substr($src, 1);
	} else {
          $n .= sprintf("%c", $c) . substr($src, 0, 1);
          $src = substr($src, 1);
	}
      } elsif ($c == 0x8e) {
	last if $src eq '';
	$n .= sprintf("%c", $c);
      } else {
	$n .= sprintf("%c", $c);
      }
      last if $src eq '';
    }
  }
  $mes = $n;
}