QRコードやフレームQRの型式情報一覧を生成する

qrlist.pl

use 5.018;
use utf8;
use warnings;
use strict;

my $size = 5;

sub bch5 {
    my ($c) = @_;
    my $pattern = ((1<<10) | (1<<8) | (1<<5) | (1<<4) | (1<<2) | (1<<1) | (1<<0))<<4;
    my $ret = $c << 10;
    my $mask = 1 << 14;
    for (1..5) {
        if ($ret & $mask) {
            $ret ^= $pattern;
        }
        $mask >>= 1;
        $pattern >>= 1;
    }
    return $ret & ((1<<10)-1);
}

sub finder_pattern {
    my ($x, $y) = @_;
    say qq(<rect x="$x" y="$y" width="80" height="80" stroke="none" stroke-width="0" fill="white"/>);
    say qq(<rect x="$x" y="$y" width="70" height="70" stroke="none" stroke-width="0" fill="black"/>);
    say qq(<rect x="@{[$x+10]}" y="@{[$y+10]}" width="50" height="50" stroke="none" stroke-width="0" fill="white"/>);
    say qq(<rect x="@{[$x+20]}" y="@{[$y+20]}" width="30" height="30" stroke="none" stroke-width="0" fill="black"/>);
}

sub module {
    my ($x, $y, $c) = @_;
    say qq(<rect x="$x" y="$y" width="10" height="10" stroke="gray" stroke-width="1" fill="@{[($c&1)?'black':'white']}"/>);
}

sub draw {
    my ($x, $y, $data) = @_;
    finder_pattern($x, $y);
    module($x+80, $y+$_*10, $data>>$_) for 0..5;
    module($x+80, $y+60, 1);
    module($x+80, $y+70, $data>>6);
    module($x+80, $y+80, $data>>7);
    module($x+70, $y+80, $data>>8);
    module($x+60, $y+80, 1);
    module($x+140-$_*10, $y+80, $data>>$_) for 9..14;
}

say '<svg xmlns="http://www.w3.org/2000/svg" width="1000" height="5000">';

for my $data(0..31) {
    finder_pattern(10, 10+130*$data);
    module(10+140-$_*10, 10+130*$data+80, $data>>($_-10)) for 10..14;

    for my $i(0..2) {
        my $pattern = (0x2825, 0x5412, 0x2A09)[$i];
        my $tmp = $data ^ ($pattern>>10);
        my $ret = (($tmp<<10)|bch5($tmp)) ^ $pattern;
        draw(150+150*$i, 10+130*$data, $ret);
    }
}

say "</svg>";