fork(108) download 
  1. #!/usr/bin/env perl
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. my ($char, @result);
  7. my $instruction = '';
  8. my $current_cell = 0;
  9. my $stack = {};
  10. my $level = 0;
  11.  
  12. foreach $char ( split //, join("", <>) ) {
  13.     next if $char !~ m/[adehkKoOru]/;
  14.  
  15.     my $temp = $instruction . $char;
  16.  
  17.     if ($temp eq "Ko")    {
  18.         ($level > 0) ?
  19.             push @{$stack->{$level}}, $temp :
  20.             $result[$current_cell]++;
  21.  
  22.         $instruction = '';
  23.     }
  24.     elsif ($temp eq "kO")    {
  25.         ($level > 0) ?
  26.             push @{$stack->{$level}}, $temp :
  27.             $result[$current_cell]--;
  28.  
  29.         $instruction = '';
  30.     }
  31.     elsif ($temp eq "Kudah") {
  32.         ($level > 0) ?
  33.             push @{$stack->{$level}}, $temp :
  34.             $current_cell++;
  35.  
  36.         $instruction = '';
  37.     }
  38.     elsif ($temp eq "kudah") {
  39.         ($level > 0) ?
  40.             push @{$stack->{$level}}, $temp :
  41.             $current_cell--;
  42.  
  43.         $instruction = '';
  44.     }
  45.     elsif ($instruction eq "Kud" and $char ne "a") {
  46.         $stack->{++$level} = [];
  47.         $instruction = $char;
  48.     }
  49.     elsif ($instruction eq "kud" and $char ne "a") {
  50.         &cycle();
  51.         $level--;
  52.         $instruction = $char;
  53.     }
  54.     elsif ($temp eq "Kukarek")                     {
  55.         ($level > 0) ?
  56.             push @{$stack->{$level}}, $temp :
  57.             print chr $result[$current_cell];
  58.  
  59.         $instruction = '';
  60.     }
  61.     else { $instruction .= $char }
  62. }
  63.  
  64. sub cycle {
  65.     while ( $result[$current_cell] > 0 ) {
  66.         foreach my $item ( @{$stack->{$level}} ) {
  67.             if ($item eq "Ko") { $result[$current_cell]++ }
  68.             elsif ($item eq "kO") { $result[$current_cell]-- }
  69.             elsif ($item eq "Kudah") { $current_cell++ }
  70.             elsif ($item eq "kudah") { $current_cell-- }
  71.             elsif ($item eq "Kukarek") { print chr $result[$current_cell] }
  72.         }
  73.     }
  74. }
  75.  
  76. print "\n";
Success #stdin #stdout 0s 4724KB
comments (?)
stdin 
KoKoKoKoKoKoKoKoKoKo Kud-Kudah
KoKoKoKoKoKoKoKo kudah kO kud-Kudah Kukarek kudah
KoKoKo Kud-Kudah
kOkOkOkO kudah kO kud-Kudah Ko Kukarek kudah
KoKoKoKo Kud-Kudah KoKoKoKo kudah kO kud-Kudah kO Kukarek
kOkOkOkOkO Kukarek Kukarek kOkOkOkOkOkOkO
Kukarek
stdout 
PETOOH
https://ideone.com/1Jenb
language:
Perl (perl 5.28.1)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!