File Coverage

blib/lib/Language/Befunge/lib/ORTH.pm

Criterion	Covered	Total	%
statement	9	65	13.8
branch	0	2	0.0
condition			n/a
subroutine	3	15	20.0
pod	12	12	100.0
total	24	94	25.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::ORTH;

use strict;
use warnings;

use Language::Befunge::Vector;

sub new { return bless {}, shift; }


# -- bit operations

#
# $v = A( $a, $b )
#
# push $a & $b back onto the stack (bitwise AND)
#
sub A {
    my ($self, $interp) = @_;
    my $ip = $interp->get_curip();

    # pop the values
    my $b = $ip->spop;
    my $a = $ip->spop;

	# push the result
	$ip->spush( $a&$b );
}


#
# $v = E( $a, $b )
#
# push $a ^ $b back onto the stack (bitwise XOR)
#
sub E {
    my ($self, $interp) = @_;
    my $ip = $interp->get_curip();

    # pop the values
    my $b = $ip->spop;
    my $a = $ip->spop;

	# push the result
	$ip->spush( $a^$b );
}


#
# $v = O( $a, $b )
#
# push $a | $b back onto the stack (bitwise OR)
#
sub O {
    my ($self, $interp) = @_;
    my $ip = $interp->get_curip();

    # pop the values
    my $b = $ip->spop;
    my $a = $ip->spop;

	# push the result
	$ip->spush( $a|$b );
}


# -- push / get

#
# $v = G( $y, $x )
#
# push back value stored at coords ($x, $y). note that befunge get is g($x,$y)
# (ie, the arguments are reversed).
#
sub G {
	my ($self, $lbi) = @_;
	my $ip = $lbi->get_curip;

    my $x = $ip->spop;
    my $y = $ip->spop;
	my $v = Language::Befunge::Vector->new($x,$y);
    my $val = $lbi->get_storage->get_value( $v );
    $ip->spush( $val );
}


#
# P( $v, $y, $x )
#
# store value $v at coords ($x, $y). note that befunge put is p($v,$x,$y) (ie,
# the coordinates are reversed).
#
sub P {
	my ($self, $lbi) = @_;
	my $ip = $lbi->get_curip;

    my $x = $ip->spop;
    my $y = $ip->spop;
	my $v = Language::Befunge::Vector->new($x,$y);
	my $val = $ip->spop;
    $lbi->get_storage->set_value( $v, $val );
}


# -- output

#
# S( 0gnirts )
#
# print popped 0gnirts on stdout.
#
sub S {
    my ($self, $lbi) = @_;
    print $lbi->get_curip->spop_gnirts;
}


# -- coordinates & velocity changes

#
# X( $x )
#
# Change X coordinate of IP to $x.
#
sub X {
    my ($self, $lbi) = @_;
    my $ip = $lbi->get_curip;
    my $v = $ip->get_position;
    my $x = $ip->spop;
	$v->set_component(0,$x);
}

#
# Y( $y )
#
# Change Y coordinate of IP to $y.
#
sub Y {
    my ($self, $lbi) = @_;
    my $ip = $lbi->get_curip;
    my $v = $ip->get_position;
    my $y = $ip->spop;
	$v->set_component(1,$y);
}


#
# V( $dx )
#
# Change X coordinate of IP velocity to $dx.
#
sub V {
    my ($self, $lbi) = @_;
    my $ip = $lbi->get_curip;
    my $v  = $ip->get_delta;
    my $dx = $ip->spop;
	$v->set_component(0,$dx);
}


#
# W( $dy )
#
# Change Y coordinate of IP velocity to $dy.
#
sub W {
    my ($self, $lbi) = @_;
    my $ip = $lbi->get_curip;
    my $v  = $ip->get_delta;
    my $dy = $ip->spop;
	$v->set_component(1,$dy);
}


# -- misc

#
# Z( $bool )
#
# Test the top stack element, and if zero, skip over the next cell (i.e., add
# the delta twice to the current position).
#
sub Z {
	my ($self, $lbi) = @_;
    my $ip = $lbi->get_curip;
    my $v  = $ip->spop;
	$lbi->_move_ip_once($ip) if $v == 0;
}


1;

__END__