Acme-Aheui

 view release on metacpan or  search on metacpan

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

=head1 PUBLIC METHODS

=head2 new

    my $interpreter = Acme::Aheui->new( source => '아희' );

This method will create and return C<Acme::Aheui> object.

=cut

sub new {
    my $class = shift;
    my %args = @_;
    my $source = $args{source} || '';
    my $encoding = $args{output_encoding} || Term::Encoding::get_encoding();

    my $self = {
        _codespace => build_codespace($source),
        _stacks => [],
        _stack_index => 0,
        _x => 0,
        _y => 0,
        _dx => 0,
        _dy => 1,
        _encoding => $encoding,
    };
    bless $self, $class;

    return $self;
}

sub build_codespace {
    my ($source) = @_;

    my @lines = split /\r?\n/, $source;
    my @rows = ();
    for my $line (@lines) {
        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};

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

=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;
        }

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

            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;
    }

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

    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); # ã…‘

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

        return (-$dx, -$dy); # ã…¢
    }
    elsif ($jung == 20) {
        return (-$dx, $dy); # ã…£
    }
    else {
        return ($dx, $dy);
    }
}

sub _push {
    my ($self, $i, $n) = @_;

    if ($i == 27) { # ã…Ž
        return;
    }
    else {
        push @{$self->{_stacks}->[$i]}, $n;
    }
}

sub _pop {
    my ($self, $i) = @_;
    my $stack = $self->{_stacks}->[$i];

    if ($i == 21) { # ã…‡
        return shift @$stack;
    }
    elsif ($i == 27) { # ã…Ž
        return;
    }
    else {
        return pop @$stack;
    }
}

sub _duplicate {
    my ($self, $i) = @_;
    my $stack = $self->{_stacks}->[$i];

    if ($i == 21) { # ã…‡
        my $first = $$stack[0];
        unshift @$stack, $first;
    }
    elsif ($i == 27) { # ã…Ž
        return;
    }
    else {
        my $last = $$stack[-1];
        push @$stack, $last;
    }
}

sub _swap {
    my ($self, $i) = @_;
    my $stack = $self->{_stacks}->[$i];

    if ($i == 21) { # ã…‡
        my $first = $$stack[0];
        my $second = $$stack[1];
        $$stack[0] = $second;
        $$stack[1] = $first;
    }
    elsif ($i == 27) { # ã…Ž
        return;
    }
    else {
        my $last = $$stack[-1];
        my $next = $$stack[-2];
        $$stack[-1] = $next;
        $$stack[-2] = $last;
    }
}

sub _output_number {
    my ($self, $number) = @_;

    print $number;
}

sub _output_code_as_character {
    my ($self, $code) = @_;

    my $unichar = pack 'U', $code;
    print encode($self->{_encoding}, $unichar);
}

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

    my $char = ReadKey(0);
    return unpack 'U', $char;
}

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

    return int(ReadLine(0));
}

=head1 INSTALLATION

To install this module, run the following commands:

    perl Build.PL

t/01_aheui.t  view on Meta::CPAN

    is_deeply( [$interpreter->{_x}, $interpreter->{_y}], [2, 2] );
    $interpreter->_move_cursor();
    is_deeply( [$interpreter->{_x}, $interpreter->{_y}], [2, 0] );
    $interpreter->_move_cursor();
    is_deeply( [$interpreter->{_x}, $interpreter->{_y}], [2, 4] );
}

{ # storages

    my $counter = 0;
    sub test_stack {
        my ($interpreter, $storage_index) = @_;

        # a push and a pop
        my $in = $counter++;
        $interpreter->_push($storage_index, $in);
        my $out = $interpreter->_pop($storage_index);
        is( $in, $out );

        # pushes, pops
        my ($in1, $in2, $in3) = ($counter++, $counter++, $counter++);

t/01_aheui.t  view on Meta::CPAN

        $later_in = $counter++;
        $interpreter->_push($storage_index, $first_in);
        $interpreter->_push($storage_index, $later_in);
        $interpreter->_swap($storage_index);
        my $first_out = $interpreter->_pop($storage_index);
        my $later_out = $interpreter->_pop($storage_index);
        is( $first_in, $first_out );
        is( $later_in, $later_out );
    }

    sub test_queue {
        my ($interpreter, $storage_index) = @_;

        # a push and a pop
        my $in = $counter++;
        $interpreter->_push($storage_index, $in);
        my $out = $interpreter->_pop($storage_index);
        is( $in, $out );

        # pushes, pops
        my ($in1, $in2, $in3) = ($counter++, $counter++, $counter++);