File Coverage

blib/lib/Language/Befunge/lib/BASE.pm

Criterion	Covered	Total	%
statement	9	35	25.7
branch	0	6	0.0
condition	0	12	0.0
subroutine	3	9	33.3
pod	6	6	100.0
total	18	68	26.4

#
# 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::BASE;

use strict;
use warnings;

use Math::BaseCalc;

sub new { return bless {}, shift; }

my @digits = ( 0 .. 9, 'a'..'z' );

# -- outputs

#
# B( $n )
#
# Output top of stack in binary.
#
sub B {
	my ($self, $lbi) = @_;
	printf "%b", $lbi->get_curip->spop;
}


#
# H( $n )
#
# Output top of stack in binary.
#
sub H {
	my ($self, $lbi) = @_;
	printf "%x", $lbi->get_curip->spop;
}


#
# N( $n, $b )
#
# Output $n in base $b.
#
sub N {
	my ($self, $lbi) = @_;
	my $ip = $lbi->get_curip;
	my $b = $ip->spop;
	my $n = $ip->spop;
	if ( $b == 0 || $b == 1 || $b > scalar(@digits) ) {
		# bases 0 and 1 are not valid.
		# bases greater than 36 require too much chars.
		$ip->dir_reverse;
		return;
	}
	my $bc = Math::BaseCalc->new(digits=> [ @digits[0..$b-1] ]);
	print $bc->to_base( $n );
}

#
# O( $n )
#
# Output top of stack in octal.
#
sub O {
	my ($self, $lbi) = @_;
	printf "%o", $lbi->get_curip->spop;
}


# -- input

#
# $n = I( $b )
#
# Input value in specified base, and push it on the stack.
#
sub I {
    my ($self, $lbi) = @_;
    my $ip = $lbi->get_curip;
    my $in = $lbi->get_input;
    return $ip->dir_reverse unless defined $in;
    my $b = $ip->spop;
    if ( $b == 0 || $b == 1 || $b > scalar(@digits) ) {
		# bases 0 and 1 are not valid.
		# bases greater than 36 require too much chars.
		$ip->dir_reflect;
		return;
	}
	my $bc = Math::BaseCalc->new(digits=> [ @digits[0..$b-1] ]);

    $ip->spush( $bc->to_base( $in ) );
}



1;

__END__