view release on metacpan or  search on metacpan

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

Version 0.05

=cut

our $VERSION = '0.05';


=head1 SYNOPSIS

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

=head1 DESCRIPTION

An aheui interpreter.

See aheui language specification at L<https://aheui.github.io/specification.en>

Most logic is based on the reference implementation by Puzzlet Chung.
(L<https://github.com/aheui/jsaheui>)

=cut

use constant {
    JONG_STROKE_NUMS =>
        [0, 2, 4, 4, 2, 5, 5, 3, 5, 7, 9, 9, 7, 9,
         9, 8, 4, 4, 6, 2, 4, 1, 3, 4, 3, 4, 4, 3],
    REQUIRED_ELEM_NUMS =>
        [0, 0, 2, 2, 2, 2, 1, 0, 1, 0, 1, 0, 2, 0, 1, 0, 2, 2, 0],
};

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

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