Code Kukarektoring (2)

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";
+say '';