File Coverage

blib/lib/Language/Befunge/lib/SUBR.pm

Criterion	Covered	Total	%
statement	12	53	22.6
branch	0	4	0.0
condition	0	4	0.0
subroutine	4	10	40.0
pod	6	6	100.0
total	22	77	28.5

#
# This file is part of Language::Befunge.
# Copyright (c) 2001-2009 Jerome Quelin, all rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
#

package Language::Befunge::lib::SUBR;

use 5.010;
use strict;
use warnings;

use Language::Befunge::Vector;

sub new { return bless {}, shift; }

sub A {
    my ($self, $interp) = @_;
    my $ip = $interp->get_curip;
    $ip->extdata('SUBR', 0);
}

sub C {
    my ($self, $interp) = @_;
    my $ip    = $interp->get_curip;
    my $count = $ip->spop;
    my $to    = $ip->spop_vec;

    # set new position
    my $is_rel = $ip->extdata('SUBR') // 0;
    my $from   = $ip->get_position;
    $to       += $ip->get_storage if $is_rel;
    $ip->set_position($to);

    # new delta is (1, 0, ...)
    my $old = $ip->get_delta;
    my $new = Language::Befunge::Vector->new_zeroes( $to->get_dims );
    $new->set_component(0,1);
    $ip->set_delta($new);

    # mess with stack
    my @stack = $ip->spop_mult($count);
    $ip->spush_vec( $from );
    $ip->spush_vec( $old );
    $ip->spush_args( @stack );
}

sub J {
    my ($self, $interp) = @_;
    my $ip = $interp->get_curip;

    # compute where to jump
    my $is_rel = $ip->extdata('SUBR') // 0;
    my $vec    = $ip->spop_vec;
    $vec += $ip->get_storage if $is_rel;

    # new delta is (1, 0, ...)
    my $delta = Language::Befunge::Vector->new_zeroes( $vec->get_dims );
    $delta->set_component(0,1);
    $ip->set_delta( $delta );

    # set new position
    $ip->set_position($vec);
}

sub O {
    my ($self, $interp) = @_;
    my $ip = $interp->get_curip;
    $ip->extdata('SUBR', 1);
}

sub R {
    my ($self, $interp) = @_;
    my $ip    = $interp->get_curip;
    my $count = $ip->spop;

    # mess with stack
    my @stack = $ip->spop_mult($count);
    my $delta = $ip->spop_vec;
    my $pos   = $ip->spop_vec;
    $ip->spush_args( @stack );

    # set new position
    $ip->set_position($pos);
    $ip->set_delta($delta);
}


1;

__END__