view release on metacpan or  search on metacpan

lib/Acme/Aheui.pm  view on Meta::CPAN

        my @row = ();
        for my $char (split //, $line) {
            my $disassembled = disassemble_hangul_char($char);
            push @row, $disassembled;
        }
        push @rows, \@row;
    }
    return \@rows;
}

sub disassemble_hangul_char {
    my ($char) = @_;

    if ($char =~ /[가-힣]/) {
        my $code = unpack 'U', $char;
        $code -= 0xAC00;
        my ($cho, $jung, $jong) = (int($code/28/21), ($code/28)%21, $code%28);
        return {cho => $cho, jung => $jung, jong => $jong};
    }
    else {
        return {cho => -1, jung => -1, jong => -1};
    }
}

=head2 execute

    $interpreter->execute();

This method will execute the aheui program and return the exit code.
It may use C<STDIN> and/or C<STDOUT> if the aheui program uses I/O.

=cut

sub execute {
    my ($self) = @_;

    return 0 unless $self->_has_initial_command();
    return $self->_loop_steps();
}

sub _has_initial_command {
    my ($self) = @_;

    for my $row (@{ $self->{_codespace} }) {
        my $first_command = @$row[0];
        if ($first_command && $$first_command{cho} != -1) {
            return 1;
        }
    }
    return 0;
}

sub _loop_steps {
    my ($self) = @_;

    while (1) {
        my $codespace = $self->{_codespace};
        my ($x, $y) = ($self->{_x}, $self->{_y});

        if ($x > $#{$$codespace[$y]}) {
            $self->_move_cursor();
            next;
        }

        my $c = $$codespace[$y][$x];

        if (!$c || $c->{cho} == -1) {
            $self->_move_cursor();
            next;
        }

        my $cho = $c->{cho};
        my $jung = $c->{jung};
        my $jong = $c->{jong};
        my $si = $self->{_stack_index};

        my ($dx, $dy) = $self->_get_deltas_upon_jung($jung);
        $self->{_dx} = $dx;
        $self->{_dy} = $dy;

        my $stack = $self->{_stacks}->[$si];
        my $elem_num = ($stack) ? scalar @{$stack} : 0;
        if ($elem_num < REQUIRED_ELEM_NUMS->[$cho]) {
            $self->{_dx} = -($self->{_dx});
            $self->{_dy} = -($self->{_dy});
        }
        else {
            if ($cho == 2) { # ã„´
                my $m = $self->_pop($si);
                my $n = $self->_pop($si);
                $self->_push($si, int($n/$m));
            }
            elsif ($cho == 3) { # ã„·
                my $m = $self->_pop($si);
                my $n = $self->_pop($si);
                $self->_push($si, $n+$m);
            }
            elsif ($cho == 16) { # ㅌ
                my $m = $self->_pop($si);
                my $n = $self->_pop($si);
                $self->_push($si, $n-$m);
            }
            elsif ($cho == 4) { # ㄸ
                my $m = $self->_pop($si);
                my $n = $self->_pop($si);
                $self->_push($si, $n*$m);
            }
            elsif ($cho == 5) { # ㄹ
                my $m = $self->_pop($si);
                my $n = $self->_pop($si);
                $self->_push($si, $n%$m);
            }
            elsif ($cho == 6) { # ㅁ
                my $v = $self->_pop($si);
                if ($jong == 21) { # jongã…‡
                    $self->_output_number($v);
                }
                elsif ($jong == 27) { # jongã…Ž
                    $self->_output_code_as_character($v);
                }
            }
            elsif ($cho == 7) { # ã…‚
                my $v = 0;
                if ($jong == 21) { # jongã…‡
                    $v = $self->_get_input_number();
                }
                elsif ($jong == 27) { # jongã…Ž
                    $v = $self->_get_input_character_as_code();
                }
                else { # the other jongs
                    $v = JONG_STROKE_NUMS->[$jong];
                }
                $self->_push($si, $v);
            }
            elsif ($cho == 8) { # ã…ƒ
                $self->_duplicate($si);
            }
            elsif ($cho == 17) { # ㅍ
                $self->_swap($si);
            }
            elsif ($cho == 9) { # ã……
                $self->{_stack_index} = $jong;
            }
            elsif ($cho == 10) { # ã…†
                $self->_push($jong, $self->_pop($si));
            }
            elsif ($cho == 12) { # ã…ˆ
                my $m = $self->_pop($si);
                my $n = $self->_pop($si);
                my $in = ($n >= $m) ? 1 : 0;
                $self->_push($si, $in);
            }
            elsif ($cho == 14) { # ã…Š
                if ($self->_pop($si) == 0) {
                    $self->{_dx} = -($self->{_dx});
                    $self->{_dy} = -($self->{_dy});
                }
            }
            elsif ($cho == 18) { # ã…Ž
                my $ret = $self->_pop($si) || 0;
                return $ret;
            }
        }

        $self->_move_cursor();
    }
}

sub _move_cursor {
    my ($self) = @_;
    my $codespace = $self->{_codespace};

    $self->{_x} += $self->{_dx};
    $self->{_y} += $self->{_dy};

    my $last_row_index = $#{ $codespace };
    if ($self->{_y} < 0) {
        $self->{_y} = $last_row_index;
    }
    if ($self->{_y} > $last_row_index) {
        $self->{_y} = 0;
    }

    my $last_char_index = $#{ @$codespace[$self->{_y}] };
    if ($self->{_x} < 0) {
        $self->{_x} = $last_char_index;
    }
    if ($self->{_x} > $last_char_index &&
        $self->{_dx} != 0) {
        $self->{_x} = 0;
    }
}

sub _get_deltas_upon_jung {
    my ($self, $jung) = @_;

    my $dx = $self->{_dx};
    my $dy = $self->{_dy};

    if ($jung == 0) {
        return (1, 0); # ㅏ
    }
    elsif ($jung == 2) {
        return (2, 0); # ã…‘
    }
    elsif ($jung == 4) {
        return (-1, 0); # ã…“
    }
    elsif ($jung == 6) {
        return (-2, 0); # ã…•
    }
    elsif ($jung == 8) {
        return (0, -1); # ã…—
    }
    elsif ($jung == 12) {
        return (0, -2); # ã…›
    }
    elsif ($jung == 13) {
        return (0, 1); # ㅜ
    }
    elsif ($jung == 17) {
        return (0, 2); # ã… 
    }
    elsif ($jung == 18) {
        return ($dx, -$dy); # ã…¡
    }
    elsif ($jung == 19) {
        return (-$dx, -$dy); # ã…¢
    }