File Coverage

blib/lib/Barcode/DataMatrix/Engine.pm

Criterion	Covered	Total	%
statement	377	517	72.9
branch	129	254	50.7
condition	67	152	44.0
subroutine	36	40	90.0
pod	33	33	100.0
total	642	996	64.4

package Barcode::DataMatrix::Engine;

=head1 Barcode::DataMatrix::Engine

The engine which generates the data matrix bitmap.

=cut

use strict;
no warnings qw(uninitialized);
use Barcode::DataMatrix::Reed;
use Barcode::DataMatrix::Constants ();
use Barcode::DataMatrix::CharDataFiller ();
use Data::Dumper;$Data::Dumper::Useqq = 1;

=head2 DEBUG

Turn on/off general debugging information.

=cut

use constant DEBUG => 0;

our %DEBUG = (
	ENC    => 0,
	EAUTO  => 0,
	CALC   => 0,
	TRACE  => 0,
	B256   => 0
);
our (@GFI,@GFL,%POLY,@FORMATS,@C1);

*GFI     = \@Barcode::DataMatrix::Constants::GFI;
*GFL     = \@Barcode::DataMatrix::Constants::GFL;
*POLY    = \%Barcode::DataMatrix::Constants::POLY;
*FORMATS = \@Barcode::DataMatrix::Constants::FORMATS;
*C1      = \@Barcode::DataMatrix::Constants::C1;

=head2 E_ASCII

Represent the ASCII encoding type.

=cut

sub E_ASCII { 0 }

=head2 E_C40

Represent the C40 encoding type.  (upper case alphanumeric)

=cut

sub E_C40 { 1 }

=head2 E_TEXT

Represent the TEXT encoding type.  (lower case alphanumeric)

=cut

sub E_TEXT { 2 }

=head2 E_BASE256

Represent the BASE256 encoding type.

=cut

sub E_BASE256 { 3 }

=head2 E_NONE

Represent the when there is no encoding type.

=cut

sub E_NONE { 4 }

=head2 E_AUTO

Represent the when the encoding type is automatically set.

=cut

sub E_AUTO { 5 }

our $N = 255;

=head2 Types

Return a list of encoding types.

=cut

sub Types {
	return qw( ASCII C40 TEXT BASE256 NONE AUTO );
}

=head2 stringToType (type_name)

Return the integer representing the type from the type name.

=cut

sub stringToType {
	my $m = 'E_'.shift;
	return eval { __PACKAGE__->$m(); };
}

=head2 typeToString (type_integer)

Return the type name from the integer representing the type.

=cut

sub typeToString {
	my $i = shift;
	for (Types) {
		return $_ if stringToType($_) == $i and defined $i;
	}
	return 'UNK';
}

our @encName = map { typeToString $_ } 0..5;

=head2 stringToFormat (format_string)

Convert a "width x height" format string into an internal format specification.

=cut

sub stringToFormat {
	my $sz = shift;
	return unless $sz;
	my ($w,$h) = map { +int } split /\s*x\s*/,$sz,2;
	my $r;
	for my $i (0..$#FORMATS) {
		$r = $i,last if $FORMATS[$i][0] == $w and $FORMATS[$i][1] == $h;
	}
	die "Format not supported ($sz)\n" unless defined $r;
	return $r;
}

=head2 setType (type_name)

Set the encoding type from the given type name.

=cut

sub setType {
	my $self = shift;
	my $type = shift;
	my $t = stringToType($type);
	warn "setType $type => $t\n" if $DEBUG{ENC};
	#$t = E_AUTO unless defined $t;
	$t = E_ASCII unless defined $t;
	$self->{encoding} = $self->{currentEncoding} = $t;
	warn "Have type $t (".typeToString($t).")\n" if $DEBUG{ENC};
	return;
}

=head2 new

Construct a C object.

=cut

sub new {
	my $self = bless{},shift;
	$self->init();
	warn "[CA] new(@_)\n" if $DEBUG{TRACE};
	$self->{orig} = $self->{code} = shift;  # text
	$self->setType(shift);                  # type of encoding
	$self->{preferredFormat} = stringToFormat(shift) || -1; # type of format
	$self->{as} = [  ]; # additional streams
	$self->ProcessTilde if (shift);         # process tilde
	return unless ( my $l = length($self->{code}) );        # no data to encode
	$self->{ac} = [ split //,$self->{code} ]; # create an char array
	$self->{ai} = [ map { +ord } @{ $self->{ac} } ]; # create an int array
	$self->CreateBitmap();
	return $self;
}

=head2 init

Initialize some of the basic C data.

=cut

sub init {
	my $self = shift;
	my %p = (
        processTilde            => 0,#0
        encoding                => E_ASCII,
        preferredFormat         => -1,
        currentEncoding         => E_ASCII,
        C49rest                 => 0,
	);
	for (keys %p){
		$self->{$_} = $p{$_};
	}
}

=head2 ProcessTilde

Handle special or control characters, which are prefixed by a tilde C<~>
when encoding.

=cut

sub ProcessTilde {
	my $self = shift;
	my $s = $self->{code};
	my $as = $self->{as};
	for ($s) {
		s{~d(\d{3})}{ chr($1) }ge;
		s{~d.{3}}{}g;
		for my $i (0,1,4,5) {
			s{^(.{$i})~1}{ $as->[$-[0]+$i]=''; $1."\350"}ge;
		}
		s{~1}{\035}g;
		s{~2(.{3})}{ $as->[$-[0]] = $1; "\351".$2 }e;
		s{^~3}{ $as->[0] = ''; "\352" }e;
		s{^~5}{ $as->[0] = ''; "\354" }e;
		s{^~6}{ $as->[0] = ''; "\355" }e;
		s{~7(.{6})}{do{
			my $d = int $1;
			#warn "There is $d got from $1\n";
			if ($d < 127) {
				$d = chr($d+1);
			}
			elsif($d < 16383) {
				$d =
					chr( ( $d - 127 ) / 254 + 128 ).
					chr( ( $d - 127 ) % 254 + 1 );
			}
			else{
				$d =
					chr( int( ( $d - 16383 ) / 64516 + 192 ) ).
					chr( int( ( $d - 16383 ) / 254 ) % 254 + 1 ).
					chr( int( ( $d - 16383 ) % 254 + 1 ) );
			}
			$as->[$-[0]] = $d;
			warn "PT affect as[$-[0]] = ".join('+', map ord, split //, $d) if $DEBUG{TRACE};
			"\361"
		}}ge;
		s{~(.)}{$1 eq '~' ? '~' : $1}ge;
		warn "[C9] ProcessTilde($self->{code}) => ".Dumper($_) if $DEBUG{TRACE};
		return $self->{code} = $_;
	}
}

=head2 CalcReed (ai, err)

Return the message as a Reed-Solomon encoded array.

=cut

sub CalcReed { # (int ai[], int i, int j) : void
	my ($ai,$err) = @_;
	my $rv = Barcode::DataMatrix::Reed::encode($ai,$err);
	@$ai = @$rv;
	return $ai;
	#sub mult($$) { # (int i, int j) : int
#		my ($i,$j) = @_;
#		my $k = 0;
#		return 0 unless 1 * $i * $j;
#		$k = $GFL[$i] + $GFL[$j];
#		$k -= $N if $k >= $N;
#		return $GFI[$k];
#	}
#	sub short($) { $_[0] & 0xFF; }
#
#	my ($ai,$j) = @_;
#	my $i = @$ai;
#	warn "CalcReed(ai {".join(" ",grep{+defined}@$ai)."},$i,$j)\n" if $DEBUG{CALC};
#	my $p = exists $POLY{$j} ? $POLY{$j} : $POLY{68};
#	warn "CalcReed: poly {".join(" ",@$p)."}\n" if $DEBUG{CALC};
#    @$ai[ $i .. $i + $j - 1 ] = (0) x $j;
#    for my $l(0 .. $i - 1) {
#        my $word0 = short($ai->[$i] ^ $ai->[$l]);
#        for my $i1 (0 .. $j - 1) {
#            $ai->[$i + $i1] = short( $ai->[$i + $i1 + 1] ^ mult($word0, $p->[$i1]) );
#        }
#        $ai->[$i+$j-1] = mult($word0, $p->[$j - 1]);
#    }
#    return $ai;
}

=head2 A253 (i, j)

Return padding codewords via the 253-state algorithm.

For more information see
L.

The relevant text for this algorithm is reproduced here.

If the symbol is not full, pad Cs are required. After the last data
C, the 254 C indicates the end of the datas or the return to ASCII
method. First padding C is 129 and next padding Cs are computed with
the 253-state algorithm.

=head3 The 253-state algorithm

Let C be the number of data Cs from the beginning of the data, C a
pseudo random number and C the required pad C.

    R = ((149 * P) MOD 253) + 1
    CW = (129 + R) MOD 254

=cut

sub A253 # C8 (int i, int j) : int
{
	my ($i,$j) = @_;
    my $l = $i + (149 * $j) % 253 + 1;
    return $l <= 254 ? $l : $l - 254;
}

=head2 CreateBitmap

Generate and return the bitmap representing the message.

=cut

sub CreateBitmap #CB (int ai[], String as[]) : int[][]
{
	my $self = shift;
	my ($ai,$as) = @$self{qw(ai as)};
	warn "[CB] CreateBitmap(ai[" .join(',',@$ai).'], as[' . scalar(@$as) .  "])\n" if $DEBUG{TRACE};
    my $ai1 = [];
    my $i = 0;
	$self->{currentEncoding} = $self->{encoding} if $self->{encoding} != E_AUTO;
	#warn "AI Before enc: ".join(" ",@$ai)."\n";
	for ($self->{encoding}){
		warn "[CB] Select method for $self->{encoding}, ".typeToString($self->{encoding})."\n" if $DEBUG{ENC};
		$_ == E_AUTO    && do { $i = $self->DetectEncoding($ai1); last;};
		$_ == E_ASCII   && do { $i = $self->EncodeASCII(scalar(@$ai), $ai, $ai1, $as); last;};
		$_ == E_C40     && do { $i = $self->EncodeC40TEXT(scalar(@$ai), [0], $ai, $ai1, 0, 1, 0); last;};
		$_ == E_TEXT    && do { $i = $self->EncodeC40TEXT(scalar(@$ai), [0], $ai, $ai1, 1, 1, 0); last;};
		$_ == E_BASE256 && do { $i = $self->EncodeBASE256(scalar(@$ai), [0], $ai, [0], $ai1, 0, $as); last;};
		$_ == E_NONE    && do { $ai1 = [ @$ai ]; $i = @$ai; last };
	}
	warn "[CB] selected (ai1[" .join(',',@$ai1).'], as[' . scalar(@$as) .  "])\n" if $DEBUG{TRACE};
	DEBUG and print "Use Encoding: " .typeToString($self->{currentEncoding}). "(".typeToString($self->{encoding}).")\n";
	#warn "AI1 After enc: ".join(" ",@$ai1)."\n";
	warn "[CB]: enc res: ".typeToString($self->{encoding}).", " .typeToString($self->{currentEncoding}). "\n" if $DEBUG{ENC};
    my $k = 0;
	if($self->{preferredFormat} != -1) {
    	$k = $self->{preferredFormat};
        $k = 0 if $i > $FORMATS[$k][7];
    }
	#warn "[CB]: format: $k\n";
    for(; $i > $FORMATS[$k][7] && $k < 30; $k++)
    {
    	next if $self->{currentEncoding} != E_C40 && $self->{currentEncoding} != E_TEXT;
    	#warn "[CB]: enc: E_C40/E_TEXT\n";
        if($self->{C49rest} == 1 && $ai1->[$i - 2] == 254 && $FORMATS[$k][7] == $i - 1) {
            $ai1->[$i - 2] = $ai1->[$i - 1];
            $ai1->[$i - 1] = 0;
            $i--;
            last;
        }
    	next if($self->{C49rest} != 0 || $ai1->[$i - 1] != 254 || $FORMATS[$k][7] != $i - 1);
        $ai1->[$i - 1] = 0;
        $i--;
        last;
    }

    return if $k == 30;
    my $l = $k;
	@$self{qw(
		rows
		cols
		datarows
		datacols
		regions
		maprows
		mapcols
		totaldata
		totalerr
		reeddata
		reederr
		reedblocks
	)} = @{$FORMATS[$l]}[0..11];
	DEBUG and print "Format: $self->{rows}x$self->{cols}; Data: $self->{totaldata}; i=$i; blocks = $self->{reedblocks}\n";
	#warn "[CB]: Selected $self->{rows}x$self->{cols} [$self->{totaldata}]; $i\n";
	$ai1->[$i - 1] = 129 if (
		($self->{currentEncoding} == E_C40 || $self->{currentEncoding} == E_TEXT )
		and
		$self->{C49rest} == 0 && $i == $self->{totaldata} && $ai1->[$i - 1] == 254
    );
    my $flag = 1;
    warn "Calc begin from $i..$self->{totaldata} ai1=[@{$ai1}]\n" if $DEBUG{CALC};
	for(my $i1 = $i; $i1 < $self->{totaldata}; $i1++) {
		#warn "   CB: $i <= $i1 < $self->{totaldata}\n";
        $ai1->[$i1] = $flag ? 129 : A253(129, $i1 + 1);
        $flag = 0;
    }
    return $self->{bitmap} = $self->GenData($self->ecc($l,$ai1));
}

=head2 ecc (format, ai)

Return the ECC200 (DataMatrix) array, formatted for the appropriate matrix
size.

=cut

sub ecc {
	my $self = shift;
	my $format = shift;
	my $ai = shift;
	my ($data,$err,$blocks) = @{$FORMATS[$format]}[9..11];
	$blocks--;$data--;
    warn "ECC: ai=[@{$ai}], blocks=$blocks\n" if $DEBUG{CALC};
    my @blocks = map {[]} 0..$blocks;
    my $block = 0;
    for (@$ai) {
    	push @{$blocks[$block++]}, $_;
    	$block = 0 if $block > $blocks;
    }
    #$#{ $blocks[-1] } = $#{ $blocks[0] };
    warn "Calc blocks=".Dumper \@blocks if $DEBUG{CALC};
	for (0..$#blocks) {
        $#{ $blocks[$_] } = $data; # correct padding
        if($self->{rows} == 144 and $_ > 7) {
			#warn "144 fix: decrease block $_ to size 155 from @{[ 0+@{$blocks[$_]} ]}";
        	$#{$blocks[$_]} -= 1;
        }

		CalcReed($blocks[$_], $err);
	}
    warn "Calc reed=\n".
    	join "\n", map { '['.join(',',@$_).']' } @blocks if $DEBUG{CALC};
    my @rv;
	for my $n (0..$data+$err) {
		for my $b (0..$#blocks) {
			#warn "Calc $n, block $b";
			if ( $n < @{$blocks[$b]} ) { # 144 fix
				push @rv, $blocks[$b][$n];
			} else {
				#warn "skip $n from $b: 144 fix";
			}
		}
	}
	return \@rv;
}

=head2 isCDigit (character)

Return true if the character is a digit.

=cut

sub isCDigit { # C1*
	return shift =~ /^[0-9]$/ ? 1 : 0;
}

=head2 isIDigit (character_code)

Return true if the character code represents a digit.

=cut

sub isIDigit { # C1
	my $i = shift;
	return ( $i >= 48 && $i <= 57 ) ? 1 : 0;
}

=head2 isILower (character_code)

Return true if the character code represents a lower case letter.

=cut

sub isILower {
	my $i = shift;
	return ( $i >= ord('a') && $i <= ord('z') ) ? 1 : 0;
}

=head2 isIUpper (character_code)

Return true if the character code represents an upper case letter.

=cut

sub isIUpper {
	my $i = shift;
	return ( $i >= ord('A') && $i <= ord('Z') ) ? 1 : 0;
}

=head2 DetectEncoding

Detect the encoding type.

=cut

sub DetectEncoding() #C4 (int i, int ai[], int ai1[], String as[]) : int
{
	my $self = shift;
	warn "[C4] DetectEncoding(@_)\n" if $DEBUG{TRACE};
	my $ai = $self->{ai};
	my $i = scalar (@$ai);
	my $as = $self->{as};
	my $ai1 = shift;
    my $ai2 = [  ];
    my $ai3 = [  ];
    my $flag = 0;
    my $j1 = 0;
    my $k1 = E_ASCII;
    my $ai4 = [ 0 ];
    my $l2 = E_ASCII;
    my $as1 = [  ];
    my $iterator = 0;
	$self->{currentEncoding} = E_ASCII;
	warn("DetectENC: starting from ".$encName[$self->{currentEncoding}]."\n") if $DEBUG{EAUTO};
    while($iterator < $i) { # while iterator less than length of data
		warn("DetectENC: at $iterator ce=$encName[$self->{currentEncoding}] k1=$encName[$k1] l2=$encName[$l2]\n") if $DEBUG{EAUTO};
    	while($self->{currentEncoding} == E_ASCII and $iterator < $i) {
			warn("DetectENC: while at $iterator ce=$encName[$self->{currentEncoding}] k1=$encName[$k1] l2=$encName[$l2]\n") if $DEBUG{EAUTO};
            my $flag1 = 0;
            if(
            	$iterator + 1 < $i
            	and isIDigit($ai->[$iterator])
            	and isIDigit($ai->[$iterator + 1])
            ){
				warn("DetectENC: 2dig $ai->[$iterator]+$ai->[$iterator+1] at $iterator ce=$encName[$self->{currentEncoding}] k1=$encName[$k1] l2=$encName[$l2]\n") if $DEBUG{EAUTO};
                $ai1->[$j1++] = 254 if($l2 != E_ASCII);
                $ai2->[0]     = $ai->[$iterator];
                $ai2->[1]     = $ai->[$iterator + 1];
                my $j = $self->EncodeASCII(2, $ai2, $ai3, $as1);
				splice(@$ai1,$j1,$j, @$ai3[0 .. $j-1 ]);
                $j1 += $j;
                $iterator++;
                $iterator++;
                $flag1 = 1;
                $l2 = E_ASCII;
            }
            if(!$flag1) {
				warn("DetectENC: !dig !flag1 at $iterator ce=$encName[$self->{currentEncoding}] k1=$encName[$k1] l2=$encName[$l2]\n") if $DEBUG{EAUTO};
            	#my $l1 = C3(@$ai, $self->{currentEncoding}, $iterator, @$as);
            	my $l1 = $self->SelectEncoding( $iterator );
                if( $l1 != E_ASCII) {
					warn("DetectENC: $encName[$self->{currentEncoding}] => $encName[$l1]\n") if $DEBUG{EAUTO};
                	$l2 = $self->{currentEncoding};
                	$self->{currentEncoding} = $l1;
                }
            }
        	if(!$flag1 and $self->{currentEncoding} == E_ASCII){
                $ai1->[$j1++] = 254 if($l2 != E_ASCII);
                $ai2->[0] = $ai->[$iterator];
                $as1->[0] = $as->[$iterator];
                my $k = $self->EncodeASCII(1, $ai2, $ai3, $as1);
                $as1->[0] = undef;
				splice(@$ai1,$j1,$k, @$ai3[0 .. $k-1 ]);
                $j1 += $k;
                $iterator++;
                $l2 = E_ASCII;
            }
        }
		warn("DetectENC: after while at $iterator ce=$encName[$self->{currentEncoding}] k1=$encName[$k1] l2=$encName[$l2]\n") if $DEBUG{EAUTO};
        my $i2;
        #warn "DetectEncoding < $iterator < $i > : i2: [$i2] ".typeToString($i2)."\n";
    	for(; $self->{currentEncoding} == E_C40 and $iterator < $i; $self->{currentEncoding} = $i2) {
            $ai4->[0] = $iterator;
            my $l = $self->EncodeC40TEXT($i, $ai4, $ai, $ai3, 0, $l2 != E_C40, 1);
            $iterator = $ai4->[0];
			splice(@$ai1,$j1,$l, @$ai3[0 .. $l-1 ]);
            $j1 += $l;
        	$i2 = $self->SelectEncoding($iterator);
        	$l2 = $self->{currentEncoding};
        }
		warn("DetectENC: after C40 at $iterator ce=$encName[$self->{currentEncoding}] k1=$encName[$k1] l2=$encName[$l2]\n") if $DEBUG{EAUTO};

        my $j2;
    	for(; $self->{currentEncoding} == E_TEXT and $iterator < $i; $self->{currentEncoding} = $j2) {
            $ai4->[0] = $iterator;
            my $i1 = $self->EncodeC40TEXT($i, $ai4, $ai, $ai3, 1, $l2 != E_TEXT, 1);
            $iterator = $ai4->[0];
			splice(@$ai1,$j1,$i1, @$ai3[0 .. $i1-1 ]);
            $j1 += $i1;
        	$j2 = $self->SelectEncoding($iterator);
        	$l2 = $self->{currentEncoding};
        }
		warn("DetectENC: after TEXT at $iterator ce=$encName[$self->{currentEncoding}] k1=$encName[$k1] l2=$encName[$l2]\n") if $DEBUG{EAUTO};

    	if($self->{currentEncoding} == E_BASE256) {
            $ai4->[0] = $iterator;
            $j1 = $self->EncodeBASE256($i, $ai4, $ai, [$j1], $ai1, 1);
            $iterator = $ai4->[0];
        	my $k2 = $self->SelectEncoding($iterator);
        	$l2 = $self->{currentEncoding};
        	$self->{currentEncoding} = $k2;
        }
		warn("DetectENC: after B256 at $iterator ce=$encName[$self->{currentEncoding}] k1=$encName[$k1] l2=$encName[$l2]\n") if $DEBUG{EAUTO};
    }
    return $j1;
}

=head2 EncodeASCII (i, ai, ai1, as)

Encode the message as ASCII.

=cut

sub EncodeASCII { #CE (int i; int ai[], int ai1[], String as[]) : int
	my $self = shift;
	warn "[CE] EncodeASCII(@_)\n" if $DEBUG{TRACE};
	my ($i,$ai,$ai1,$as) = @_;
	warn "[CE] ai:{".join(" ",grep{+defined}@$ai)."}; ai1:{".join(" ",grep{+defined}@$ai1)."}; as:{".join(" ",grep{+defined}@$as)."}\n" if $DEBUG{ENC};
    my $j = 0;
    my $flag = 0;
    for(my $k = 0; $k < $i; $k++) {
        my $flag1 = 0;
        if(
        	$k < $i - 1
        	and isIDigit($ai->[$k])
        	and isIDigit($ai->[$k+1])
        ) {
        	#warn "[CE] $flag $flag1 $k $ai->[$k] is type 1";
            my $l = ($ai->[$k] - 48) * 10 + ($ai->[$k + 1] - 48);
            $ai1->[$j++] = 130 + $l;
            $k++;
            $flag1 = 1;
        }
        if(!$flag1 and defined $as->[$k]) {
        	#warn "[CE] $flag $flag1 $k $ai->[$k] is subtype !flag";
            if(
            	   $ai->[$k] == 234
            	or $ai->[$k] == 237
            	or $ai->[$k] == 236
            	or $ai->[$k] == 232
            ) {
	        	#warn "[CE] $flag $flag1 $k $ai->[$k] is type 2";
                $ai1->[$j++] = $ai->[$k];
                $flag1 = 1;
            }
            if($ai->[$k] == 233 || $ai->[$k] == 241) {
                $ai1->[$j++] = $ai->[$k];
                #warn("Additional data by 233/241 for $k: $as->[$k]");
                for(my $i1 = 0; $i1 < length $as->[$k]; $i1++){
                    $ai1->[$j++] = ord substr($as->[$k],$i1,1);
                }
                $flag1 = 1;
            }
        }
        if(!$flag1){
            if($ai->[$k] < 128) {
	        	#warn "[CE] $flag $flag1 $k $ai->[$k] is type 3";
                $ai1->[$j++] = $ai->[$k] + 1;
            } else {
	        	#warn "[CE] $flag $flag1 $k $ai->[$k] is type 4";
                $ai1->[$j++] = 235;
                $ai1->[$j++] = ($ai->[$k] - 128) + 1;
            }
        }
    }
    #warn Dumper( \@_ );
    warn "[CE] end $j ai1:{".join(" ",@$ai1)."};\n" if $DEBUG{ENC};
    return $j;
}

=head2 SelectEncoding (j, ai, i)

Select a new encoding type for the message.

=cut

sub SelectEncoding #C3 (int ai[], int i, int j, String as[]) : int # DefineEncoding??
                   #iterator, ai, encoding
{
	#(iterator[,ai[,encoding]])
	#(ai,i: encoding,j: iterator,as)
	my $self = shift;
	warn "[C3] SelectEncoding(@_)\n" if $DEBUG{TRACE};

	my $j = shift;

	my $ai = shift;
	$ai = $self->{ai} unless defined $ai;

	my $i = shift || $self->{currentEncoding};
	$i = $self->{currentEncoding} unless defined $i;

	my $as = $self->{as};
    my $d  = 0.0;
    my $d2 = 1.0;
    my $d3 = 1.0;
    my $d4 = 1.25;
    my $k = $j;
    if($i != E_ASCII)
    {
        $d  = 1.0;
        $d2 = 2.0;
        $d3 = 2.0;
        $d4 = 2.25;
    }
    $d2 = 0.0 if $i == E_C40;
    $d3 = 0.0 if $i == E_TEXT;
    $d4 = 0.0 if $i == E_BASE256;
    for(; $j < @$ai; $j++)
    {
    	warn "SelectEncoding: have as[$j]: $as->[$j]\n" if defined $as->[$j] and $DEBUG{EAUTO};
        my $c = $ai->[$j];
        return E_ASCII if defined $as->[$j];

        if    ( isIDigit($c) )        { $d += 0.5 }
        elsif ( $c > 127 )            { $d = int( $d + 0.5 ) + 2; }
        else                          { $d = int( $d + 0.5 ) + 1; }

        if    ( @{ $C1[$c] } == 1 )   { $d2 += 0.66000000000000003; }
        elsif ( $c > 127 )            { $d2 += 2.6600000000000001;  }
        else                          { $d2 += 1.3300000000000001;  }
        my $c1 = $c;
        if( isIUpper($c) )            { $c1 = ord lc chr $c; }
        if( isILower($c) )            { $c1 = ord uc chr $c; }

        if    ( @{ $C1[$c1] } == 1)   { $d3 += 0.66000000000000003; }
        elsif ( $c1 > 127 )           { $d3 += 2.6600000000000001;  }
        else                          { $d3 += 1.3300000000000001;  }

        $d4++;

        if($j - $k >= 4) {
        	#warn "$j-$k >= 4: $d $d2 $d3 $d4\n";
            return E_ASCII   if $d  + 1.0 <= $d2 and $d + 1.0 <= $d3 and $d + 1.0 <= $d4;
            return E_BASE256 if $d4 + 1.0 <= $d;
            return E_BASE256 if $d4 + 1.0 < $d3 and $d4 + 1.0 < $d2;
            return E_TEXT    if $d3 + 1.0 < $d and $d3 + 1.0 < $d2 and $d3 + 1.0 < $d4;
            return E_C40     if $d2 + 1.0 < $d and $d2 + 1.0 < $d3 and $d2 + 1.0 < $d4;
        }
    }

    $d  = int( $d + 0.5 );
    $d2 = int( $d2 + 0.5 );
    $d3 = int( $d3 + 0.5 );
    $d4 = int( $d4 + 0.5 );
    return E_ASCII   if $d <= $d2 and $d <= $d3 and $d <= $d4;
    return E_TEXT    if $d3 < $d and $d3 < $d2 and $d3 < $d4;
    return E_BASE256 if $d4 < $d and $d4 < $d3 and $d4 < $d2;
    return E_C40;
}

=head2 EncodeC40TEXT (i, ai, ai1, ai2, flag, flag1, flag2)

Encode the message as C40/TEXT.

=cut

sub EncodeC40TEXT { # C6 #(int i, int ai[], int ai1[], int ai2[], boolean flag, boolean flag1, boolean flag2) : int
	#warn "[C6] EncodeC40TEXT\n";
	my $self = shift;
	my ($i,$ai,$ai1,$ai2,$flag,$flag1,$flag2) = @_;
    my $j = my $k = 0;
    my $ai3 = [ 0, 0, 0 ];
    my $flag3 = 0;
    my $as = [  ];
    if($flag1) {
        $ai2->[$j++] = $flag ? 239 : 230;
    }
    for(my $j1 = $ai->[0]; $j1 < $i; $j1++) {
        my $l = $ai1->[$j1];
        if($flag) {
            my $s = chr($l);
            $s = uc($s) if($l >= 97 && $l <= 122);
            $s = lc($s) if($l >= 65 && $l <= 90);
            $l  = ord(substr($s,0,1));
        }
        my $ai4 = $C1[$l];
        for my $l1 (0 .. $#$ai4) {
            $ai3->[$k++] = $ai4->[$l1];
            if($k == 3) {
                my $i2 = $ai3->[0] * 1600 + $ai3->[1] * 40 + $ai3->[2] + 1;
                $ai2->[$j++] = int $i2 / 256;
                $ai2->[$j++] = $i2 % 256;
                $k = 0;
            }
        }

        if($flag2 && $k == 0) {
        	$self->{C49rest} = $k;
            $ai->[0] = $j1 + 1;
            $ai2->[$j++] = 254 if($ai->[0] == $i);
            return $j;
        }
    }

    $ai->[0] = $i;
    if($k > 0) {
        if($k == 1) {
            $ai2->[$j++] = 254;
            $ai2->[$j++] = $ai1->[$i - 1] + 1;
            return $j;
        }
        if($k == 2) {
            $ai3->[2] = 0;
            my $k1 = $ai3->[0] * 1600 + $ai3->[1] * 40 + $ai3->[2] + 1;
            $ai2->[$j++] = int $k1 / 256;
            $ai2->[$j++] = $k1 % 256;
            $ai2->[$j++] = 254;
        	$self->{C49rest} = $k;
            return $j;
        }
    } else {
        $ai2->[$j++] = 254;
    }
    $self->{C49rest} = $k;
    return $j;
}

=head2 state255 (V, P)

The 255-state algorithm.  Used when encoding strings with the BASE256 type.

This information originally from
L.

Let C the number of data Cs from the beginning of datas (C = code
word).  Let C be a pseudo random number, C the base 256 C value
and C the required C.

    R = ((149 * P) MOD 255) + 1
    CW = (V + R) MOD 256

=cut

sub state255 # (int V, int P) : int
{
    my ($V,$P) = @_;
    return ( $V + (149 * $P) % 255 + 1 ) % 256;
}

=head2 hexary (src)

Return a string representation of the input hexadecimal number.

=cut

sub hexary {
	join(" ",map{ sprintf '%02x',$_} @{ shift() } )
}

=head2 decary (src)

Return a string representation of the input decimal number.

=cut

sub decary {
	join(" ",map{ sprintf '%3d',$_} @{ shift() } )
}

=head2 EncodeBASE256 (i, hint, src, stat, res, flag)

Encode the message as BASE256.

=cut

sub EncodeBASE256 {
	my $self = shift;
	my ($i,$hint,$src,$stat,$res,$flag) = @_;
    my $j = 0;
    my $xv = [];
    my $k =
    my $l = $stat->[0];
    my $flag1 = 0;
    my $j1 = 0;
    warn "AI1{".hexary($src)."}\n" if $DEBUG{B256};
    warn "AI4{".hexary($xv)."}\n" if $DEBUG{B256};
    for( $j1 = $hint->[0]; $j1 < $i; $j1++){
        $xv->[$j++] = $src->[$j1];
        last if $flag and $self->SelectEncoding($j1 + 1,$src,E_BASE256) != E_BASE256;
    }
    warn "AI1{".hexary($src)."}\n" if $DEBUG{B256};
    warn "AI4{".hexary($xv)."}\n" if $DEBUG{B256};
	#warn "$j1 : $l\n";
    $hint->[0] = $j1;
    $res->[$l++] = 231;
    if($j < 250) {
        $res->[$l++] = state255($j, $l + 1);
    } else {
        $res->[$l++] = state255(249 + ($i - $i % 250) / 250, $l + 1);
        $res->[$l++] = state255($i % 250, $l + 1);
    }
    $res->[$l++] = state255($xv->[$_], $l + 1) for 0..$j-1;
    $stat->[0] = $l;
    return $l;
}

=head2 GenData (ai)

Generate and return the data for the DataMatrix bitmap from the input array.

=cut

sub GenData { # CC (int ai[]) : int[][]
    my $self = shift;
    my ($ai) = @_;
    warn "[CC] GenData: ".join(",",@$ai)." [$self->{rows} x $self->{cols} : $self->{regions} : $self->{datacols}x$self->{datarows}]\n" if $DEBUG{TRACE};
	my $ai1 = [ map { [ (undef) x $self->{rows} ] } 1..$self->{cols} ]; # reverse cols/rows here, for correct access ->[][]

    my $i = my $j = 0;
    # Draw border
    if($self->{regions} == 2) {
		FillBorder($ai1, $i, $j, $self->{datacols} + 2, $self->{datarows} + 2);
    	FillBorder($ai1, $i + $self->{datacols} + 2, $j, $self->{datacols} + 2, $self->{datarows} + 2);
    } else {
    	my $k = int(sqrt($self->{regions}));
        for(my $l = 0; $l < $k; $l++){
            for(my $i1 = 0; $i1 < $k; $i1++) {
            	FillBorder($ai1, $i + $l * ($self->{datacols} + 2), $j
            		+ $i1 * ($self->{datarows} + 2),
            		$self->{datacols} + 2, $self->{datarows} + 2);
			}
        }

    }
    # End draw border
	my $ai2 = [ (undef) x ( ($self->{mapcols} + 10) * $self->{maprows} ) ];
    warn "[" . join (" ", grep { +defined } @$ai2)."]\n" if $DEBUG{CALC};
	FillCharData($self->{mapcols},$self->{maprows},$ai2);
    warn "[" . join (" ", grep { +defined } @$ai2)."]\n" if $DEBUG{CALC};
	warn "--------------\n" if $DEBUG{CALC};
    warn "[" . join (" ", grep { +defined } @$ai)."]\n" if $DEBUG{CALC};
    my $j1 = 1;
    my $flag = 0;
    my $flag1 = 0;
	for(my $i2 = 0; $i2 < $self->{maprows}; $i2++) {
        my $j2 = 1;
        for(my $k2 = 0; $k2 < $self->{mapcols}; $k2++) {
            my $l1 = $k2 + $j2;
            my $k1 = $i2 + $j1;
            if($ai2->[$i2 * $self->{mapcols} + $k2] > 9) {
            	my $l2 = int ( $ai2->[$i2 * $self->{mapcols} + $k2] / 10 );
            	my $i3 = $ai2->[$i2 * $self->{mapcols} + $k2] % 10;
                my $j3 = $ai->[$l2 - 1] & 1 << 8 - $i3;
                $ai1->[$l1][$k1] = $j3;
            } else {
            	$ai1->[$l1][$k1] = $ai2->[$i2 * $self->{mapcols} + $k2];
            }
        	if($k2 > 0 && ($k2 + 1) % $self->{datacols} == 0) {
                $j2 += 2;
            }
        }

    	if($i2 > 0 && ($i2 + 1) % $self->{datarows} == 0) {
            $j1 += 2;
        }
    }
    return $ai1;
}

=head2 FillBorder (ai, i, j, k, l)

Fill the border of the ECC200 data matrix bitmap.

=cut

sub FillBorder { # CD (int ai[][], int i, int j, int k, int l) : void
	my ($ai,$i,$j,$k,$l) = @_;
	#warn "[CD] FillBorder([".join(",",@$ai)."],$i,$j,$k,$l)\n";
    my $i1 = 0;
    for(my $k1 = 0; $k1 < $k; $k1++) {
        $i1 = ($k1 % 2 == 0) ? 1 : 0;
        $ai->[$i + $k1][$j + $l - 1] = 1;
        $ai->[$i + $k1][$j] = $i1;
    }
    $i1 = 0;
    for(my $l1 = 0; $l1 < $l; $l1++) {
        my $j1 = (($l1 + 1) % 2 == 0) ? 1 : 0;
        $ai->[$i][$j + $l1] = 1;
        $ai->[$i + $k - 1][$j + $l1] = $j1;
    }
}

=head2 FillCharData (ncol, nrow, array)

Fill the data matrix with the character data in the given message array.

=cut

sub FillCharData { # (int ncol; int nrow; int array;) : void
	my ($ncol,$nrow,$array) = @_;
	Barcode::DataMatrix::CharDataFiller->new($ncol,$nrow,$array);
	return;
}

1;