diff --git a/Perl/petooh.pl b/Perl/petooh.pl index 85aac65..849ee24 100755 --- a/Perl/petooh.pl +++ b/Perl/petooh.pl @@ -1,82 +1,56 @@ #!/usr/bin/env perl - use strict; use warnings; +use v5.10; +use experimental qw(switch autoderef); -do { print "\n USAGE: $0 /path/to/file.koko\n" } unless $ARGV[0]; - -open my $fh, "<", $ARGV[0] or die $!; - -my ($char, @result); -my $instruction = ''; +my @result = (); my $current_cell = 0; -my $stack = {}; +my %stack = (); my $level = 0; - -while ( read($fh, $char, 1) != 0 ) { - next if $char !~ m/[adehkKoOru]/; - - my $temp = $instruction . $char; - - if ($temp eq "Ko") { - ($level > 0) ? - push $stack->{$level}, $temp : - $result[$current_cell]++; - - $instruction = ''; - } - elsif ($temp eq "kO") { - ($level > 0) ? - push $stack->{$level}, $temp : - $result[$current_cell]--; - - $instruction = ''; - } - elsif ($temp eq "Kudah") { - ($level > 0) ? - push $stack->{$level}, $temp : - $current_cell++; - - $instruction = ''; - } - elsif ($temp eq "kudah") { - ($level > 0) ? - push $stack->{$level}, $temp : - $current_cell--; - - $instruction = ''; - } - elsif ($instruction eq "Kud" and $char ne "a") { - $stack->{++$level} = []; - $instruction = $char; - } - elsif ($instruction eq "kud" and $char ne "a") { - &cycle(); - $level--; - $instruction = $char; - } - elsif ($temp eq "Kukarek") { - ($level > 0) ? - push $stack->{$level}, $temp : - print chr $result[$current_cell]; - - $instruction = ''; - } - else { $instruction .= $char } +my $comment = 0; + +sub run { + for ($_[0]) { + when (/^Ko$/) { $result[$current_cell]++ } + when (/^kO$/) { $result[$current_cell]-- } + when (/^Kudah$/) { $current_cell++ } + when (/^kudah$/) { $current_cell-- } + when (/^Kukarek$/) { print chr $result[$current_cell] } + default { say "\nUnexpected pkokoblem" } + } } -close $fh; - sub cycle { - while ( $result[$current_cell] > 0 ) { - foreach my $item ( @{$stack->{$level}} ) { - if ($item eq "Ko") { $result[$current_cell]++ } - elsif ($item eq "kO") { $result[$current_cell]-- } - elsif ($item eq "Kudah") { $current_cell++ } - elsif ($item eq "kudah") { $current_cell-- } - elsif ($item eq "Kukarek") { print chr $result[$current_cell] } - } - } + while ($result[$current_cell] > 0) { + run $_ for @{$stack{$level}} + } +} + +while (<>) { + while (1) { + if (/\G[\s!?.,:;()-]+/gc) { # skip whitespace and punctuation + } elsif (/\Gz+/gci) { + $comment++; + } elsif ($comment and /\G.*?(morning)?/gc) { + $comment-- if $1; + } elsif (/\G(Ko|kO|Kudah|kudah|Kukarek)/gc) { + if ($level > 0) { + push $stack{$level}, $1; + } else { + run $1; + } + } elsif (/\GKud/gc) { + $stack{++$level} = []; + } elsif (/\Gkud/gc) { + cycle(); + $level--; + } elsif (/\G(.)/gc) { + say "\nChicktax errorek: $1"; + } else { + last; + } + } } -print "\n"; \ No newline at end of file +say '';