libbarcode-datamatrix-perl 0.10-1 / usr / share / perl5 / Barcode / DataMatrix / Engine.pm

package Barcode::DataMatrix::Engine;

=head1 NAME

Barcode::DataMatrix::Engine - The engine which generates the data matrix
bitmap.

=cut

use strict;
use warnings;
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 (@FORMATS,@C1);

*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;
	return if $sz eq 'AUTO';
	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_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<Barcode::DataMatrix::Engine> 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<Barcode::DataMatrix::Engine> 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;
}

=head2 A253 (i, j)

Return padding codewords via the 253-state algorithm.

For more information see
L<http://grandzebu.net/informatique/codbar-en/datamatrix.htm>.

The relevant text for this algorithm is reproduced here.

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

=head3 The 253-state algorithm

Let C<P> be the number of data C<CW>s from the beginning of the data, C<R> a
pseudo random number and C<CW> the required pad C<CW>.

    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;
	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 "[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];
    }
    for(; $i > $FORMATS[$k][7] && $k < 30; $k++)
    {
    	next if $self->{currentEncoding} != E_C40 && $self->{currentEncoding} != E_TEXT;
        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";
	$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++) {
        $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;
    }
    warn "Calc blocks=".Dumper \@blocks if $DEBUG{CALC};
	for (0..$#blocks) {
        $#{ $blocks[$_] } = $data; # correct padding
        if($self->{rows} == 144 and $_ > 7) {
        	$#{$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) {
			if ( $n < @{$blocks[$b]} ) { # 144 fix
				push @rv, $blocks[$b][$n];
			}
		}
	}
	return \@rv;
}

=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 = $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;
    	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])
        ) {
            my $l = ($ai->[$k] - 48) * 10 + ($ai->[$k + 1] - 48);
            $ai1->[$j++] = 130 + $l;
            $k++;
            $flag1 = 1;
        }
        if(!$flag1 and defined $as->[$k]) {
            if(
            	   $ai->[$k] == 234
            	or $ai->[$k] == 237
            	or $ai->[$k] == 236
            	or $ai->[$k] == 232
            ) {
                $ai1->[$j++] = $ai->[$k];
                $flag1 = 1;
            }
            if($ai->[$k] == 233 || $ai->[$k] == 241) {
                $ai1->[$j++] = $ai->[$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) {
                $ai1->[$j++] = $ai->[$k] + 1;
            } else {
                $ai1->[$j++] = 235;
                $ai1->[$j++] = ($ai->[$k] - 128) + 1;
            }
        }
    }
    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) {
            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
	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<http://grandzebu.net/informatique/codbar-en/datamatrix.htm>.

Let C<P> the number of data C<CW>s from the beginning of datas (C<CW> = code
word).  Let C<R> be a pseudo random number, C<V> the base 256 C<CW> value
and C<CW> the required C<CW>.

    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 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 $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};
    $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) = @_;
    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;