#!/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);