1 package Encode::Tcl::Table;
3 our $VERSION = do { my @r = (q$Revision: 0.90 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
5 use base 'Encode::Encoding';
12 my ($obj,$fh,$name,$type) = @_;
14 my ($def,$sym,$pages) = split(/\s+/,scalar(<$fh>));
23 my $page = hex($line);
25 $leading[$page] = 1 if $page;
27 for (my $i = 0; $i < 16; $i++)
30 for (my $j = 0; $j < 16; $j++)
32 my $val = hex(substr($line,0,4,''));
35 my $uch = pack('U', $val); # chr($val);
47 $touni[$page] = \@page;
50 ? $obj->can("rep_$type")
53 ($_[0] > 255) || $leading[$_[0]] ? 'n' : 'C';
56 $obj->{'ToUni'} = \@touni;
57 $obj->{'FmUni'} = \%fmuni;
59 $obj->{'Num'} = $count;
67 #sub rep_M { ($_[0] > 255) ? 'n' : 'C' }
72 $ch = 0 unless @_ > 1;
78 my($obj,$str,$chk) = @_;
79 my $name = $obj->{'Name'};
80 my $rep = $obj->{'Rep'};
81 my $touni = $obj->{'ToUni'};
85 my $cc = substr($str,0,1,'');
88 if (&$rep($ch) eq 'C')
90 $x = $touni->[0][$ch];
96 $str = pack('C',$ch); # split leading byte
99 my $c2 = substr($str,0,1,'');
101 $x = $touni->[$ch][ord($c2)];
105 Encode::Tcl::no_map_in_decode($name, $cc.$str);
109 $_[1] = $str if $chk;
115 my ($obj,$uni,$chk) = @_;
116 my $fmuni = $obj->{'FmUni'};
117 my $def = $obj->{'Def'};
118 my $name = $obj->{'Name'};
119 my $rep = $obj->{'Rep'};
123 my $ch = substr($uni,0,1,'');
124 my $x = $fmuni->{$ch};
129 Encode::Tcl::no_map_in_encode(ord($ch), $name)
133 $str .= pack(&$rep($x),$x);
135 $_[1] = $uni if $chk;
143 Encode::Tcl::Table - Tcl Table encodings
151 This module is used internally by Encode::Tcl
152 and handles types S, D, and M of Tcl encodings.
154 Implementation for type M is restricted to encodings
155 in which bytes per a character is up to 2.