filter-edge-shooters.pl

use strict;
use warnings;

use autodie;

use Fcntl ':seek';
use FindBin ();
use IO::Handle ();
use IO::Seekable ();

my $file = "$FindBin::Bin/sample_n.pat";
my $outfile = 'edge-shooters.life';

open my $fh, '<', $file;
open my $outfh, '>', $outfile;

my $found = 0;
while (defined(my $pattern = read_pattern($fh))) {
    $pattern =~ s/^#P \d+ \d+/#P 0 0/;

    my $cells = g_parse($pattern);

    my $glider = find_glider($cells);
    g_exit("Couldn't find glider.") if !$glider;

    my $cells_without_glider = subtract($cells, $glider);
    g_exit("Couldn't remove glider.") if !$cells_without_glider;

    g_new('');
    g_putcells($cells_without_glider);
    g_putcells($glider, -240 / 4, -240 / 4);

    g_putcells($cells, 0, 31);

    my @box = g_getrect();
    my $right_edge = $box[0] + $box[2];

    g_run(1000);
    g_select(-50, -500, 100, 250);
    g_clear(1);

    my $pop = g_getpop();
    my @spaceship_box = g_getrect();
    if ($pop > 18 && $spaceship_box[3] > 90 && $spaceship_box[0] > $right_edge) {
        my $x = $found * 200;
        $pattern =~ s/^#P \d+ \d+/#P $x 0/;
        $outfh->print($pattern . "\n");
        $found++;
    }
}

close $fh;
close $outfh;

sub read_pattern {
    my ($fh) = @_;
    my ($ret, $prev_pos);
    while (1) {
        $prev_pos = $fh->tell;

        my $line = $fh->getline;
        last if !defined($line);

        if ($line !~ m{^#P}) {
            next if !defined($ret);
        }
        elsif (defined($ret)) {
            $fh->seek($prev_pos, SEEK_SET);
            last;
        }

        ($ret ||= '') .= $line;
    }

    return $ret;
}

sub find_glider {
    my ($cells) = @_;

    my $map = {};
    for (my $i = 0; $i < @$cells; $i += 2) {
        my ($x, $y) = @$cells[$i, $i + 1];
        $map->{$x}{$y}++;
    }

    my $ret;
    POSITION: for (my $i = 0; $i < @$cells; $i += 2) {
        my ($x, $y) = @$cells[$i, $i + 1];

        my $glider_cells = [$x, $y, $x + 1, $y + 1, $x + 2, $y + 1, $x, $y + 2, $x + 1, $y + 2];
        for (my $j = 0; $j < @$glider_cells; $j += 2) {
            next POSITION if !$map->{ $glider_cells->[$j] }{ $glider_cells->[$j + 1] };
        }

        $ret = $glider_cells;
        last;
    }

    return $ret;
}

sub subtract {
    my ($cells, $sub) = @_;

    my %sub;
    for (my $i = 0; $i < @$sub; $i += 2) {
        $sub{ $sub->[$i] }{ $sub->[$i+1] }++;
    }

    my $ret = [];
    for (my $i = 0; $i < @$cells; $i += 2) {
        next if $sub{ $cells->[$i] }{ $cells->[$i+1] };

        push @$ret, @$cells[$i, $i+1];
    }

    return if @$cells != @$ret + @$sub;

    return $ret;
}