wehub-resource-sync
395 lines
11 KiB
Perl
395 lines
11 KiB
Perl
package QRCode::Encoder::Matrix;
|
|
use v5.24;
|
|
use experimental qw< signatures >;
|
|
use List::Util qw< sum >;
|
|
use QRCode::Encoder::QRSpec qw<
|
|
qrspec_version_pattern
|
|
qrspec_format_pattern
|
|
qrspec_alignment_patterns
|
|
>;
|
|
|
|
use Exporter qw< import >;
|
|
our @EXPORT_OK = qw< add_matrix >;
|
|
|
|
# Parts liberally taken from libqrencode/qrspec.c, which is distributed
|
|
# with LGPL license
|
|
|
|
sub add_matrix ($data) {
|
|
add_base_matrix($data);
|
|
add_quiet($data);
|
|
add_finders($data);
|
|
add_format_reservations($data); # MUST: before add_timing
|
|
add_version($data);
|
|
add_timing($data);
|
|
add_alignments($data);
|
|
add_codewords($data);
|
|
add_mask($data);
|
|
return $data;
|
|
}
|
|
|
|
sub stringify_matrix ($data) {
|
|
my @chunks;
|
|
my $matrix = $data->{matrix};
|
|
for my $row ($matrix->@*) {
|
|
push @chunks, join '', map { chr($_) } $row->@*;
|
|
}
|
|
return join "\n", @chunks;
|
|
}
|
|
|
|
sub stringify_matrix_2 ($data) {
|
|
my @chunks;
|
|
my $matrix = $data->{matrix};
|
|
for my $row ($matrix->@*) {
|
|
push @chunks, join '', map { ($_ & 0x1) ? '#' : ' ' } $row->@*;
|
|
}
|
|
return join "\n", @chunks;
|
|
}
|
|
|
|
sub add_base_matrix ($data) {
|
|
my $side = $data->{side_size} = 17 + 4 * $data->{version};
|
|
my $eside = $data->{eside_size} = $side + 8;
|
|
$data->{matrix} = [ map { [ ( 0x38 ) x $eside ] } 1 .. $eside ];
|
|
return $data;
|
|
}
|
|
|
|
sub add_finders ($data) {
|
|
my $eside_size = $data->{eside_size};
|
|
add_finder($data, 4 - 1, 4 - 1);
|
|
add_finder($data, 4 - 1, $eside_size - 8 - 4);
|
|
add_finder($data, $eside_size - 8 - 4, 4 - 1);
|
|
return $data;
|
|
}
|
|
|
|
sub add_quiet ($data) {
|
|
my $es = $data->{eside_size};
|
|
my $matrix = $data->{matrix};
|
|
for my $i (0 .. 3) {
|
|
for my $j (0 .. $es - 1) {
|
|
$matrix->[$i][$j] =
|
|
$matrix->[$es - 1 - $i][$j] =
|
|
$matrix->[$j][$i] =
|
|
$matrix->[$j][$es - 1 - $i] = 0x30;
|
|
}
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
sub add_finder ($data, $x, $y) {
|
|
state $shape = [
|
|
[ 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30 ],
|
|
[ 0x30, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x30 ],
|
|
[ 0x30, 0x31, 0x30, 0x30, 0x30, 0x30, 0x30, 0x31, 0x30 ],
|
|
[ 0x30, 0x31, 0x30, 0x31, 0x31, 0x31, 0x30, 0x31, 0x30 ],
|
|
[ 0x30, 0x31, 0x30, 0x31, 0x31, 0x31, 0x30, 0x31, 0x30 ],
|
|
[ 0x30, 0x31, 0x30, 0x31, 0x31, 0x31, 0x30, 0x31, 0x30 ],
|
|
[ 0x30, 0x31, 0x30, 0x30, 0x30, 0x30, 0x30, 0x31, 0x30 ],
|
|
[ 0x30, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x30 ],
|
|
[ 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30 ],
|
|
];
|
|
my $matrix = $data->{matrix};
|
|
for my $yoff (0 .. 8) {
|
|
my $Y = $y + $yoff;
|
|
for my $xoff (0 .. 8) {
|
|
my $X = $x + $xoff;
|
|
$matrix->[$Y][$X] = $shape->[$yoff][$xoff];
|
|
}
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
sub add_format_reservations ($data) {
|
|
my $matrix = $data->{matrix};
|
|
my $es = $data->{eside_size};
|
|
for my $i (0 .. 7) {
|
|
$matrix->[12][$i + 4] =
|
|
$matrix->[12][$i + $es - 4 - 8] =
|
|
$matrix->[$i + $es - 4 - 8][12] =
|
|
$matrix->[$i + 4][12] = 0x32;
|
|
}
|
|
$matrix->[12][12] = 0x32;
|
|
$matrix->[$es - 4 - 8][12] = 0x31;
|
|
return $data;
|
|
}
|
|
|
|
sub add_version_reservations ($data) {
|
|
return $data->{version} <= 6;
|
|
|
|
my $matrix = $data->{matrix};
|
|
my $ecstart = $data->{eside_size} - 4 - 7 - 4;
|
|
for my $i (4 .. 9) {
|
|
for my $j ($ecstart .. ($ecstart + 2)) {
|
|
$matrix->[$i][$j] = $matrix->[$j][$i] = 0x32;
|
|
}
|
|
}
|
|
|
|
return $data;
|
|
}
|
|
|
|
sub add_timing ($data) {
|
|
my $matrix = $data->{matrix};
|
|
my $es = $data->{eside_size};
|
|
for my $i (12 .. ($es - 4 - 8 - 1)) {
|
|
$matrix->[$i][10] = $matrix->[10][$i] = 0x35 ^ ($i & 1);
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
sub try_add_alignment_pattern ($data, $x, $y) {
|
|
state $shape = [
|
|
[ 0x31, 0x31, 0x31, 0x31, 0x31 ],
|
|
[ 0x31, 0x30, 0x30, 0x30, 0x31 ],
|
|
[ 0x31, 0x30, 0x31, 0x30, 0x31 ],
|
|
[ 0x31, 0x30, 0x30, 0x30, 0x31 ],
|
|
[ 0x31, 0x31, 0x31, 0x31, 0x31 ],
|
|
];
|
|
$x += 4; # offset by quiet zone
|
|
$y += 4; # offset by quiet zone
|
|
my $matrix = $data->{matrix};
|
|
return if $matrix->[$y][$x] < 0x34
|
|
|| $matrix->[$y][$x + 4] < 0x34
|
|
|| $matrix->[$y + 4][$x] < 0x34;
|
|
for my $i (0 .. 4) {
|
|
for my $j (0 .. 4) {
|
|
$matrix->[$y + $i][$x + $j] = $shape->[$i][$j];
|
|
}
|
|
}
|
|
}
|
|
|
|
sub add_alignments ($data) {
|
|
my @offset = qrspec_alignment_patterns($data->{version});
|
|
for my $y_center (@offset) {
|
|
for my $x_center (@offset) {
|
|
try_add_alignment_pattern($data, $x_center - 2, $y_center - 2);
|
|
}
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
sub bits_iterator ($data) {
|
|
my $n_expanded = length($data->{expanded});
|
|
my $rem = $data->{remainder};
|
|
my $i = 0;
|
|
my @queue;
|
|
return sub {
|
|
if (! @queue) {
|
|
if ($i < $n_expanded) {
|
|
push @queue, split m{}mxs, unpack 'B*', substr($data->{expanded}, $i++, 1);
|
|
}
|
|
else {
|
|
push @queue, ('0') x $rem;
|
|
$rem = 0;
|
|
}
|
|
}
|
|
return shift(@queue);
|
|
};
|
|
}
|
|
|
|
sub add_codewords ($data) {
|
|
my $it = bits_iterator($data);
|
|
my $matrix = $data->{matrix};
|
|
my $side_size = $data->{side_size};
|
|
|
|
# start from a fake position that would be the last bit of a
|
|
# hypothetical "-1" codeword
|
|
my $x = $side_size - 2;
|
|
my $y = $side_size;
|
|
my $left = 1;
|
|
my $d = -1; # direction
|
|
while (defined(my $bit = $it->())) {
|
|
while ('necessary') {
|
|
if ($x % 2 == $left) {
|
|
++$x;
|
|
$y += $d;
|
|
}
|
|
else {
|
|
--$x;
|
|
}
|
|
if ($d < 0 && $y < 0) { # reset condition
|
|
$x -= 2;
|
|
$y = 0;
|
|
$d = 1;
|
|
}
|
|
elsif ($d > 0 && $y >= $side_size) { # other reset condition
|
|
$x -= 2;
|
|
$y = $side_size - 1;
|
|
$d = -1;
|
|
}
|
|
if ($x == 6) { # left timing column, skip a column entirely
|
|
$x = 5;
|
|
$left = 0;
|
|
}
|
|
last if $matrix->[$y + 4][$x + 4] > 0x37; # found suitable position
|
|
}
|
|
$matrix->[$y + 4][$x + 4] = $bit ? 0x37 : 0x36;
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
sub evaluate_matrix ($matrix) {
|
|
return 0
|
|
+ evaluate_matrix_adjacents_and_11311($matrix)
|
|
+ evaluate_matrix_blocks($matrix)
|
|
+ evaluate_matrix_proportion($matrix);
|
|
}
|
|
|
|
sub __row ($matrix, $i) {
|
|
my $max_idx = $matrix->[0]->$#* - 4;
|
|
join('', map { $matrix->[$i + 4][$_] & 0x01 ? 1 : 0 } 4 .. $max_idx);
|
|
}
|
|
|
|
sub __col ($matrix, $i) {
|
|
my $max_idx = $matrix->[0]->$#* - 4;
|
|
join('', map { $matrix->[$_][$i + 4] & 0x01 ? 1 : 0 } 4 .. $max_idx);
|
|
}
|
|
|
|
sub evaluate_matrix_adjacents_and_11311 ($matrix) {
|
|
my $side_size = $matrix->[0]->@* - 8;
|
|
my $penalty = 0;
|
|
my $penalty2 = 0;
|
|
for my $i (0 .. ($side_size - 1)) {
|
|
for my $seq (__row($matrix, $i), __col($matrix, $i)) {
|
|
|
|
# adjacences
|
|
my @contributions =
|
|
map { $_ - 2 }
|
|
grep { $_ >= 5 }
|
|
map { length }
|
|
split m{(0+)}mxs, $seq;
|
|
$penalty += sum(@contributions) if @contributions;
|
|
|
|
# 000011311 | 113110000
|
|
my @matches = $seq =~ m{
|
|
(
|
|
(?: (?<=0000) 1011101 ) # look behind...
|
|
| (?: 1011101 (?=0000) ) # or look ahead
|
|
)
|
|
}gmxs;
|
|
$penalty2 += 40 * scalar(@matches);
|
|
|
|
}
|
|
}
|
|
return $penalty + $penalty2;
|
|
}
|
|
|
|
sub evaluate_matrix_blocks ($matrix) {
|
|
my $side_size = $matrix->[0]->@* - 8;
|
|
my $penalty = 0;
|
|
for my $i (0 .. ($side_size - 2)) {
|
|
for my $j (0 .. ($side_size - 2)) {
|
|
my $count = 0;
|
|
for my $offset ([0, 0], [0, 1], [1, 0], [1, 1]) {
|
|
my ($oi, $oj) = $offset->@*;
|
|
$count++ if $matrix->[$i + $oi + 4][$j + $oj + 4] & 1;
|
|
}
|
|
$penalty += 3 if ($count == 0) || ($count == 4);
|
|
}
|
|
}
|
|
return $penalty;
|
|
}
|
|
|
|
sub evaluate_matrix_proportion ($matrix) {
|
|
my $count = sum( map { map { $_ & 0x1 ? 1 : 0 } $_->@* } $matrix->@* );
|
|
my $side_size = $matrix->[0]->@* - 8;
|
|
my $total = $side_size * $side_size;
|
|
my $percentage = 100 * $count / $total;
|
|
my $deviation = abs($percentage - 50);
|
|
my $penalty = 10 * int($deviation / 5);
|
|
return $penalty;
|
|
}
|
|
|
|
sub masked_matrix ($data, $mask_id) {
|
|
state $mask_for = {
|
|
0 => sub ($i, $j) { (($i + $j) % 2) == 0 },
|
|
1 => sub ($i, $j) { ($i % 2) == 0 },
|
|
2 => sub ($i, $j) { ($j % 3) == 0 },
|
|
3 => sub ($i, $j) { (($i + $j) % 3) == 0 },
|
|
4 => sub ($i, $j) { ((int($i / 2) + int($j / 3)) % 2) == 0 },
|
|
5 => sub ($i, $j) { ((($i * $j) % 2) + (($i * $j) % 3)) == 0 },
|
|
6 => sub ($i, $j) { (((($i * $j) % 2) + (($i * $j) % 3)) % 2) == 0 },
|
|
7 => sub ($i, $j) { (((($i + $j) % 2) + (($i * $j) % 3)) % 2) == 0 },
|
|
};
|
|
my $matrix = $data->{matrix};
|
|
my @masked;
|
|
my $eside_size = $data->{eside_size};
|
|
my $mask = $mask_for->{$mask_id};
|
|
for my $i (0 .. ($eside_size - 1)) {
|
|
for my $j (0 .. ($eside_size - 1)) {
|
|
if (($matrix->[$i][$j] >= 0x36) && $mask->($i - 4, $j - 4)) {
|
|
$masked[$i][$j] = $matrix->[$i][$j] ^ 0x01;
|
|
}
|
|
else {
|
|
$masked[$i][$j] = $matrix->[$i][$j];
|
|
}
|
|
}
|
|
}
|
|
return \@masked;
|
|
}
|
|
|
|
sub add_mask ($data) {
|
|
my ($best_mask_id, $best_matrix, $best_penalty);
|
|
$data->{masked} = \my @masked;
|
|
for my $mask_id (0 .. 7) {
|
|
my $matrix = masked_matrix($data, $mask_id);
|
|
add_format($matrix, $data->{level}, $mask_id);
|
|
push @masked, $matrix;
|
|
my $penalty = evaluate_matrix($matrix);
|
|
($best_mask_id, $best_matrix, $best_penalty) = ($mask_id, $matrix, $penalty)
|
|
if (! $best_matrix) || $penalty < $best_penalty;
|
|
}
|
|
$data->{original_matrix} = delete($data->{matrix});
|
|
$data->{matrix} = $best_matrix;
|
|
$data->{mask_id} = $best_mask_id;
|
|
return $data;
|
|
}
|
|
|
|
sub add_format ($matrix, $level, $mask_id) {
|
|
my $fmt = qrspec_format_pattern($level, $mask_id);
|
|
my $es = $matrix->[0]->@*;
|
|
|
|
# 1st copy
|
|
my $format = $fmt;
|
|
for my $i (0 .. 7) {
|
|
$matrix->[12][$es - 1 - 4 - $i] = $format & 0x01 ? 0x31 : 0x30;
|
|
$format >>= 1;
|
|
}
|
|
for my $i (8 .. 14) {
|
|
$matrix->[$es - 1 - 4 - 14 + $i][12] = $format & 0x01 ? 0x31 : 0x30;
|
|
$format >>= 1;
|
|
}
|
|
|
|
# 2nd copy
|
|
$format = $fmt;
|
|
for my $i (0 .. 5) {
|
|
$matrix->[4 + $i][12] = $format & 0x01 ? 0x31 : 0x30;
|
|
$format >>= 1;
|
|
}
|
|
for my $i (6, 7) {
|
|
$matrix->[4 + 1 + $i][12] = $format & 0x01 ? 0x31 : 0x30;
|
|
$format >>= 1;
|
|
}
|
|
# 8
|
|
$matrix->[4 + 1 + 7][11] = $format & 0x01 ? 0x31 : 0x30;
|
|
$format >>= 1;
|
|
for my $i (9 .. 14) {
|
|
$matrix->[4 + 1 + 7][9 + 9 - $i] = $format & 0x01 ? 0x31 : 0x30;
|
|
$format >>= 1;
|
|
}
|
|
|
|
return $matrix;
|
|
}
|
|
|
|
sub add_version ($data) {
|
|
my $vp = qrspec_version_pattern($data->{version}) // return;
|
|
my $matrix = $data->{matrix};
|
|
my $ecstart = $data->{eside_size} - 4 - 7 - 4;
|
|
for my $i (4 .. 9) {
|
|
for my $j ($ecstart .. ($ecstart + 2)) {
|
|
$matrix->[$i][$j] = $matrix->[$j][$i] = 0x30 ^ ($vp & 1);
|
|
$vp >>= 1;
|
|
}
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
1;
|