monster_truck_movement.pl

#!/usr/bin/perl

# Insanity in WUAS.

use strict;
use warnings;
use 5.010;

use Data::Dumper;

# pad_right($text, $n)
sub pad_right {
    my $text = shift;
    my $n = shift;
    $text = $text . " " while length($text) < $n;
    return $text;
}

# load_file($filename)
sub load_file {
    my $filename = shift;
    open my $in, '<', $filename;

    my %result;
    while (<$in>) {
        last if /^\+---/;
    }
    my $j = 0;
    while (<$in>) {
        my $line1 = $_;
        last if $line1 =~ /^$/;
        my $line2 = <$in>;
        my $line3 = <$in>;
        my $i = 0;
        my @line1 = split /\|/, $line1;
        my @line2 = split /\|/, $line2;
        $result{width} = (+@line1-2);
        for my $i (1..(@line1-1)) {
            my $space = $line1[$i];
            my $tokens = $line2[$i];
            $space =~ s/^\s+|\s+$//g;
            $tokens =~ s/^\s+|\s+$//g;
            $result{"@{[$i-1]},$j"} = [$space, $tokens];
        }
        $j++;
    }
    $result{height} = $j;
    close $in;
    return \%result;
}

# write_output($filename, $data)
sub write_output {
    my $filename = shift;
    my %data = %{(shift)};
    my ($width, $height) = @data{qw(width height)};
    open my $out, '>', $filename;

    for my $j (0..$height-1) {
        say "+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+";
        for my $i (0..$width-1) {
            my $content = $data{"$i,$j"}->[0];
            my $text = pad_right("| $content", 11);
            print $text;
        }
        say "|";
        for my $i (0..$width-1) {
            my $content = $data{"$i,$j"}->[1];
            my $text = pad_right("| $content", 11);
            print $text;
        }
        say "|";
    }
    say "+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+----------+";

}

# find_altar($data)
sub find_altar {
    my $data = shift;
    for my $i (0..$data->{width}-1) {
        for my $j (0..$data->{height}-1) {
            return ($i, $j) if $data->{"$i,$j"}->[0] =~ /^altar$/;
        }
    }
    die "No altar";
}

# is_protected($data, $i, $j)
sub is_protected {
    my $data = shift;
    my $i = shift;
    my $j = shift;
    my $curr = $data->{"$i,$j"};
    return 1 if $curr->[0] =~ /^altar$|^start$/; # Altar and start are protected
    return 1 if $curr->[1] =~ /G/; # Gold coin spaces are protected
    return '';
}

# sgn($x)
sub sgn {
    my $x = shift;
    return -1 if $x < 0;
    return  1 if $x > 0;
    return  0;
}

# is_monster_truck($data)
sub is_monster_truck {
    my $data = shift;
    return '' if $data->[1] =~ /[-~]/; # Boa Constructors
    return ($data->[0] =~ /^truck$/);
}

# is_flamey_steve($data)
sub is_flamey_steve {
    my $data = shift;
    return '' if $data->[1] =~ /[-~]/; # Boa Constructors
    return ($data->[0] =~ /^flamey$/);
}

# move_truck_at($old, $new, $i, $j, $ai, $aj)
sub move_truck_at {
    my $old = shift;
    my $new = shift;
    my $i = shift;
    my $j = shift;
    my $ai = shift;
    my $aj = shift;

    my $width = $old->{width};
    my $height = $old->{height};

    # If the truck's space is protected (i.e. if it has a coin on it), don't move it.
    if (is_protected($old, $i, $j)) {
        $new->{"$i,$j"}->[0] = 'truck';
        $new->{"$i,$j"}->[1] = $old->{"$i,$j"}->[1];
        return;
    }

    my ($i1, $j1) = ($i, $j);
    if (abs($i - $ai) >= abs($j - $aj)) {
        $i1 += sgn($ai - $i);
    } else {
        $j1 += sgn($aj - $j);
    }

    # Check for Flamey Steve.
    while ($old->{"$i1,$j1"}->[0] =~ /^flamey$/) {
        $i1 = int(rand($width));
        $j1 = int(rand($height));
        say STDERR "$i1,$j1"
    }

    if (is_protected($old, $i1, $j1)) {
        # Destination is protected: abort.
        $new->{"$i1,$j1"}->[1] .= $old->{"$i,$j"}->[1];
        return;
    }

    # Now do the magic
    if (is_monster_truck($new->{"$i1,$j1"}) || is_flamey_steve($new->{"$i1,$j1"})) {
        # Collide!
        $new->{"$i1,$j1"}->[0] = 'flamey';
    } else {
        $new->{"$i1,$j1"}->[0] = 'truck';
    }
    $new->{"$i1,$j1"}->[1] .= $old->{"$i,$j"}->[1];

}

# slightly_deeper_copy($hash)
sub slightly_deeper_copy {
    my $hash = shift;
    my %old = %$hash;
    my %new;
    for (keys %old) {
        $new{$_} = $old{$_};
        if (ref($new{$_}) eq 'ARRAY') {
            $new{$_} = [@{ $new{$_} }];
        }
    }
    return \%new;
}

# Load the file
my %olddata = %{load_file $ARGV[0]};
my %newdata = %{ slightly_deeper_copy( \%olddata ) };

# Eliminate the monster trucks from the new data (we'll deal with them in a minute)
for my $i (0..$newdata{width}-1) {
    for my $j (0..$newdata{height}-1) {
        my $curr = $newdata{"$i,$j"};
        if (is_monster_truck($curr)) {
            $curr->[0] = 'rubble';
            $curr->[1] = '';
        }
    }
}

my ($ax, $ay) = find_altar(\%olddata);
say "$ax $ay";

for my $i (0..$newdata{width}-1) {
    for my $j (0..$newdata{height}-1) {
        if (is_monster_truck($olddata{"$i,$j"})) {
            #print STDERR "$i,$j\n";
            move_truck_at(\%olddata, \%newdata, $i, $j, $ax, $ay);
        }
    }
}

write_output("/dev/stdout", \%newdata);