File Coverage

blib/lib/Language/Befunge/lib/FIXP.pm

Criterion	Covered	Total	%
statement	15	82	18.2
branch	0	6	0.0
condition			n/a
subroutine	5	22	22.7
pod	17	17	100.0
total	37	127	29.1

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

use 5.010;
use strict;
use warnings;

use constant PRECISION => 10000;
use Math::Trig;

sub new { return bless {}, shift; }

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

    my ($a, $b) = $ip->spop_mult(2);
    $ip->spush( $a & $b );
}

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

    my $a = $ip->spop / PRECISION;
    $ip->spush( int( rad2deg( acos_real($a) ) * PRECISION ) );
}

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

    my $a = deg2rad( $ip->spop / PRECISION );
    $ip->spush( int( cos($a) * PRECISION ) );
}

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

    my $n = $ip->spop;
    $ip->spush( int( rand($n) ) );
}

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

    my $a = deg2rad( $ip->spop / PRECISION );
    $ip->spush( int( sin($a) * PRECISION ) );
}

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

    my $a = $ip->spop / PRECISION;
    $ip->spush( int ( rad2deg( asin_real($a) ) * PRECISION ) );
}

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

    my $n = $ip->spop;
    $ip->spush( -$n );
}

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

    my ($a, $b) = $ip->spop_mult(2);
    $ip->spush( $a | $b );
}

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

    my $n = $ip->spop;
    $ip->spush( int($n * pi)  );
}

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

    my $n = $ip->spop;
    $ip->spush( int( sqrt($n) ) );
}

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

    my ($a, $b) = $ip->spop_mult(2);
    $ip->spush( int( $a ** $b ) );
}

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

    my $n = $ip->spop;
    $ip->spush(1)  if $n > 0;
    $ip->spush(0)  if $n == 0;
    $ip->spush(-1) if $n < 0;
}

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

    my $a = deg2rad( $ip->spop / PRECISION );
    $ip->spush( int( tan($a) * PRECISION ) );
}

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

    my $a = $ip->spop / PRECISION;
    $ip->spush( int ( rad2deg( atan($a) ) * PRECISION ) );
}

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

    my $n = $ip->spop;
    $ip->spush( abs $n );
}

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

    my ($a, $b) = $ip->spop_mult(2);
    $ip->spush( $a ^ $b );
}


1;

__END__