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;
}
I've tested it as far back as 5.00503 IIRC.
--
In Bob We Trust, All Others Bring Data.
|