File:CARuleComparison18-18R.png

#!/usr/bin/perl -w
use strict;

my $rule = shift || 110;

$rule =~ /^(\d+)(R?)$/i and $1 < 256 or die "Invalid rule: '$rule'\n";
$rule = $1;
my $r = $2;

my %map;
$map{unpack "B3", pack "C", $_ << 5} =
    ($rule >> $_) & 1 for 0 .. 7;

my $w = shift || 200;
my $h = shift || $w;

$w =~ /\D/ and die "Invalid width: '$w'\n";
$h =~ /\D/ and die "Invalid heigth: '$h'\n";

my $pat1 = shift || "1";
$pat1 =~ /[^01]/ and die "Invalid pattern: '$pat1'\n";
length($pat1) > $w and die "Pattern too long.\n";

my $pat2 = shift || "";
$pat2 =~ /[^01]/ and die "Invalid pattern 2: '$pat2'\n";
length($pat2) > $w and die "Pattern 2 too long.\n";

my $buf1 = my $buf2 = "0" x $w;

substr($buf1, ($w-length($pat1))/2, length($pat1), $pat1);
substr($buf2, ($w-length($pat2))/2, length($pat2), $pat2);

print "P1 $w $h\n";
#$h--, print $buf2, "\n" if $r and $h;

while ($h--) {
    print $buf1, "\n";
    unless ($r) {
        substr($buf2,  0, 1, $map{substr($buf1, -1).substr($buf1, 0, 2)});
        substr($buf2, $_, 1, $map{substr($buf1, $_-1, 3)}) for 1 .. $w-2;
        substr($buf2, -1, 1, $map{substr($buf1, -2).substr($buf1, 0, 1)});
    } else {
        substr($buf2,  0, 1) ^= $map{substr($buf1, -1).substr($buf1, 0, 2)};
        substr($buf2, $_, 1) ^= $map{substr($buf1, $_-1, 3)} for 1 .. $w-2;
        substr($buf2, -1, 1) ^= $map{substr($buf1, -2).substr($buf1, 0, 1)};
    }
    last unless $h--;

    print $buf2, "\n";
    unless ($r) {
        substr($buf1,  0, 1, $map{substr($buf2, -1).substr($buf2, 0, 2)});
        substr($buf1, $_, 1, $map{substr($buf2, $_-1, 3)}) for 1 .. $w-2;
        substr($buf1, -1, 1, $map{substr($buf2, -2).substr($buf2, 0, 1)});
    } else {
        substr($buf1,  0, 1) ^= $map{substr($buf2, -1).substr($buf2, 0, 2)};
        substr($buf1, $_, 1) ^= $map{substr($buf2, $_-1, 3)} for 1 .. $w-2;
        substr($buf1, -1, 1) ^= $map{substr($buf2, -2).substr($buf2, 0, 1)};
    }
}

__END__