view release on metacpan or  search on metacpan

bin/golp  view on Meta::CPAN

        return load_RLE_file($filename);
    }
    
    warn("Unknown file type: '$filename'");
    return undef;
}

sub load_RLE_file {
    my ($filename) = @_;

    my $fh;
    unless ( defined open($fh, "<", $filename) ) {
        warn("Could not open file '$filename': $!");      
        return undef;  
    }

    my ($birth, $survival) = ( [3], [2,3] );
    my ($width, $height) = (0, 0);
    my $rle_data = "";
    
    READ_RLE_FILE: while (my $line = <$fh>) {
        chomp($line);
        if ( $line =~ /\A \s* \#/imsx ) { # skip comments           
            next READ_RLE_FILE; 
        }
        if ($line =~ /\A x \s* = \s* (\d+), \s* y \s* = \s* (\d+)/imsx) { # parse header
            ($width, $height) = ($1, $2);
            # check for rule
            if ( $line =~ m|rule \s* = \s* B \s* (\d+) \s* / \s* S \s* (\d+)|imsx ) {
                ($birth, $survival) = map { [split //] } ($1, $2);         
            }
            elsif ( $line =~ m|rule \s* = \s* (\d+) \s* / \s* (\d+)|imsx ) {
                ($birth, $survival) = map { [split //] } ($2, $1);
            }
            next READ_RLE_FILE;
        }
        $rle_data .= $line; 
    }
    close $fh;

    if ( ($width <= 0) || ($height <= 0) ) {
        warn("File '$filename' seems to be missing header, cannot load.");
        return undef;
    }

    # process RLE data
    $rle_data =~ s/!//g;
    
    my @rows;
    my $x = 0;
    my $y = 0;
    my $count = "";

    foreach my $char (split //, $rle_data) {
        if ($char =~ /\d/) {
            $count .= $char;  # Accumulate digit characters
        } elsif ($char eq 'b' || $char eq 'o') {
            $count = $count eq "" ? 1 : $count; # Default count is 1
            my $state = ($char eq 'o') ? 1 : 0; # 'o' is live (1), 'b' is dead (0)
            
            # Fill the grid with the decoded run
            for (1 .. $count) {
                $rows[$y][$x++] = $state;
            }
            $count = "";  # Reset count
        } elsif ($char eq '$') {
            $count = $count eq "" ? 1 : $count;
            for (1 .. $count) {
                $y++;
                $x = 0; # Move to the next row
            }
            $count = "";
        }
    }

    # Ensure all rows have the same width
    for my $row (@rows) {
        push @{$row}, (0) x ($width - scalar @{$row});
    }    

    return { rows => $height, cols => $width, data => \@rows, birth => $birth, survival => $survival };
}

sub load_cells_file {
    my ($filename) = @_;

    my $fh;
    unless ( defined open($fh, "<", $filename) ) {
        warn("Could not open file '$filename': $!");      
        return undef;  
    }

    my $max_row_len = 0;
    my %cell_state_map = ( '.' => 0, 'o' => 1, 'O' => 1, 'x' => 1, 'X' => 1, );
    my @file_grid;

    READ_CELLS_FILE: while ( my $line = <$fh> ) {
        chomp($line);

        next READ_CELLS_FILE if $line =~ /!/;                # skip comments

        # sometimes in .cells files the trailing dead cells in a row are omitted
        my $row_len = length($line);
        if ( $row_len > $max_row_len ) {
            $max_row_len = $row_len;
        }

        my @row_cells = map { $cell_state_map{$_} } split(//, $line);
        push @file_grid, \@row_cells;   
    }

    close($fh);

    my @grid;
    # we can't guarantee that the grid read from the file has uniform length rows.
    foreach my $row (@file_grid) {
        my @file_row = @{$row};
        my $trailing = $max_row_len - scalar(@file_row);
        if ( $trailing < 0 ) {
            warn("Somehow calculating the row length went wrong");
            return undef;