diff --git a/Perl/petooh.pl b/Perl/petooh.pl index 40ef99f..df057d1 100755 --- a/Perl/petooh.pl +++ b/Perl/petooh.pl @@ -1,82 +1,49 @@ #!/usr/bin/env perl - use strict; use warnings; +use v5.10; +#use experimental qw(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; +my $comment = 0; + +sub run { + if ($_[0] =~ /^Ko$/) { $result[$current_cell]++ } + elsif ($_[0] =~ /^kO$/) { $result[$current_cell]-- } + elsif ($_[0] =~ /^Kudah$/) { $current_cell++ } + elsif ($_[0] =~ /^kudah$/) { $current_cell-- } + elsif ($_[0] =~ /^Kukarek$/) { print chr $result[$current_cell] } +} -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 = ''; +sub cycle { + while ($result[$current_cell] > 0) { + run $_ for @{$stack{$level}} } - else { $instruction .= $char } } -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 (<>) { + 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) { } + else { last } } } -print "\n"; \ No newline at end of file +say '';