#
# 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__
=head1 NAME
Language::Befunge::IP::lib::ORTH - Orthogonal easement extension
=head1 DESCRIPTION
The ORTH fingerprint (0x4f525448) is designed to ease transition between the
Orthogonal programming language and Befunge-98 (or higher dimension Funges).
Even if transition from Orthogonal is not an issue, the ORTH library contains
some potentially interesting instructions not in standard Funge-98.
=head1 FUNCTIONS
=head2 new
Create a new ORTH instance.
=head2 Bit operations
=over 4
=item A( $a, $b )
Push back C<$a & $b> (bitwise AND).
=item O( $a, $b )
Push back C<$a | $b> (bitwise OR).
=item E( $a, $b )
Push back C<$a ^ $b> (bitwise XOR).
=back
=head2 Push & get
=over 4
=item G( $y, $x )
Push back value stored at coords ($x, $y). Note that Befunge get is C<g($x,$y)>
(ie, the arguments are reversed).
=item P( $v, $y, $x )
Store value C<$v> at coords ($x, $y). Note that Befunge put is C<p($v,$x,$y)> (ie,
the coordinates are reversed).
=back
=head2 Output
=over 4
=item S( 0gnirts )
Print popped 0gnirts on STDOUT.
=back
=head2 Coordinates & velocity changes
=over 4
=item X( $x )
Change X coordinate of IP to C<$x>.
=item Y( $y )
Change Y coordinate of IP to C<$y>.
=item V( $dx )
Change X coordinate of IP velocity to C<$dx>.
=item W( $dy )
Change Y coordinate of IP velocity to C<$dy>.
=back
=head2 Miscellaneous
=over 4
=item 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).
=back
=head1 SEE ALSO
L<Language::Befunge>, L<http://catseye.tc/projects/funge98/library/ORTH.html>,
and L<http://www.muppetlabs.com/~breadbox/orth/orth.html>.
=head1 AUTHOR
Jerome Quelin, C<< <jquelin@cpan.org> >>
=head1 COPYRIGHT & LICENSE
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.
=cut