sub UTF8ord{
  my $str = shift || $_;
  my $len = length ($str);

  return ord($str) if $len == 1;
  #This is a FIGlet specific error value
  return 128       if $len > 4 || $len == 0;

  my @n = unpack "C*", $str;
  $str  = (($n[-2] & 0x3f) <<  6) + ($n[-1] & 0x3f);
  $str += (($n[-3] & 0x1f) << 12) if $len ==3;
  $str += (($n[-3] & 0x3f) << 12) if $len ==4;
  $str += (($n[-4] & 0x0f) << 18) if $len == 4;
  return $str;
}

sub UTF8chr{
  my $ord = shift || $_;
  my @n;

  #x00-x7f        #1 byte
  if( $ord < 0x80 ){ 
    @n = $ord; }
  #x80-x7ff       #2 bytes
  elsif( $ord < 0x800 ){
    @n  = (0xc0|$ord>>6, 0x80|$ord&0x3f ); }
  #x800-xffff     #3 bytes
  elsif( $ord < 0x10000 ){
    @n  = (0xe0|$ord>>12, 
       0x80|($ord>>6)&0x3f,
       0x80|$ord&0x3f ); }
  #x10000-x10ffff #4 bytes
  elsif( $ord<0x20000 ){
    @n = (0xf0|$ord>>18,
      0x80|($ord>>12)&0x3f,
      0x80|($ord>>6)&0x3f,
      0x80|$ord&0x3f); }
  else{
    warn "Out of range for UTF-8: $ord"; }

  return pack "C*", @n;
}
[download]