lib/Language/Befunge/lib/ORTH.pm

   1 #
   2 # This file is part of Language::Befunge.
   3 # Copyright (c) 2001-2008 Jerome Quelin, all rights reserved.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the same terms as Perl itself.
   7 #
   8 #
   9
  10 package Language::Befunge::lib::ORTH;
  11
  12 use strict;
  13 use warnings;
  14
  15 use Language::Befunge::Vector;
  16
  17 sub new { return bless {}, shift; }
  18
  19 # -- bit operations
  20
  21 sub A {
  22     my ($self, $interp) = @_;
  23     my $ip = $interp->get_curip();
  24
  25     # pop the values
  26     my $b = $ip->spop;
  27     my $a = $ip->spop;
  28
  29         # push the result
  30         $ip->spush( $a&$b );
  31 }
  32
  33 sub E {
  34     my ($self, $interp) = @_;
  35     my $ip = $interp->get_curip();
  36
  37     # pop the values
  38     my $b = $ip->spop;
  39     my $a = $ip->spop;
  40
  41         # push the result
  42         $ip->spush( $a^$b );
  43 }
  44
  45 sub O {
  46     my ($self, $interp) = @_;
  47     my $ip = $interp->get_curip();
  48
  49     # pop the values
  50     my $b = $ip->spop;
  51     my $a = $ip->spop;
  52
  53         # push the result
  54         $ip->spush( $a|$b );
  55 }
  56
  57
  58 # -- push / get
  59
  60 sub G {
  61         my ($self, $lbi) = @_;
  62         my $ip = $lbi->get_curip;
  63
  64     my $x = $ip->spop;
  65     my $y = $ip->spop;
  66         my $v = Language::Befunge::Vector->new($x,$y);
  67     my $val = $lbi->storage->get_value( $v );
  68     $ip->spush( $val );
  69 }
  70
  71 sub P {
  72         my ($self, $lbi) = @_;
  73         my $ip = $lbi->get_curip;
  74
  75     my $x = $ip->spop;
  76     my $y = $ip->spop;
  77         my $v = Language::Befunge::Vector->new($x,$y);
  78         my $val = $ip->spop;
  79     $lbi->storage->set_value( $v, $val );
  80 }
  81
  82
  83 # -- output
  84
  85 sub S {
  86     my ($self, $lbi) = @_;
  87     print $lbi->get_curip->spop_gnirts;
  88 }
  89
  90
  91 # -- coordinates & velocity changes
  92
  93 sub X {
  94     my ($self, $lbi) = @_;
  95     my $ip = $lbi->get_curip;
  96     my $v = $ip->get_position;
  97     my $x = $ip->spop;
  98         $v->set_component(0,$x);
  99 }
 100
 101 sub Y {
 102     my ($self, $lbi) = @_;
 103     my $ip = $lbi->get_curip;
 104     my $v = $ip->get_position;
 105     my $y = $ip->spop;
 106         $v->set_component(1,$y);
 107 }
 108
 109 sub V {
 110     my ($self, $lbi) = @_;
 111     my $ip = $lbi->get_curip;
 112     my $v  = $ip->get_delta;
 113     my $dx = $ip->spop;
 114         $v->set_component(0,$dx);
 115 }
 116
 117 sub W {
 118     my ($self, $lbi) = @_;
 119     my $ip = $lbi->get_curip;
 120     my $v  = $ip->get_delta;
 121     my $dy = $ip->spop;
 122         $v->set_component(1,$dy);
 123 }
 124
 125
 126 # -- misc
 127
 128 sub Z {
 129         my ($self, $lbi) = @_;
 130     my $ip = $lbi->get_curip;
 131     my $v  = $ip->spop;
 132         $lbi->_move_ip_once($ip) if $v == 0;
 133 }
 134
 135
 136 1;
 137
 138 __END__
 139
 140
 141 =head1 NAME
 142
 143 Language::Befunge::IP::lib::ORTH - Orthogonal Easement Library
 144
 145
 146
 147 =head1 DESCRIPTION
 148
 149 The ORTH fingerprint (0x4f525448) is designed to ease transition between the
 150 Orthogonal programming language and Befunge-98 (or higher dimension Funges).
 151
 152 Even if transition from Orthogonal is not an issue, the ORTH library contains
 153 some potentially interesting instructions not in standard Funge-98.
 154
 155
 156
 157 =head1 FUNCTIONS
 158
 159 =head2 new
 160
 161 Create a new ORTH instance.
 162
 163
 164 =head2 Bit operations
 165
 166 =over 4
 167
 168 =item A( $a, $b )
 169
 170 Push back C<$a & $b> (bitwise AND).
 171
 172
 173 =item O( $a, $b )
 174
 175 Push back C<$a | $b> (bitwise OR).
 176
 177
 178 =item E( $a, $b )
 179
 180 Push back C<$a ^ $b> (bitwise XOR).
 181
 182
 183 =back
 184
 185
 186
 187 =head2 Push & get
 188
 189 =over 4
 190
 191 =item G( $y, $x )
 192
 193 Push back value stored at coords ($x, $y). Note that Befunge get is C<g($x,$y)>
 194 (ie, the arguments are reversed).
 195
 196
 197 =item P( $v, $y, $x )
 198
 199 Store value C<$v> at coords ($x, $y). Note that Befunge put is C<p($v,$x,$y)> (ie,
 200 the coordinates are reversed).
 201
 202
 203 =back
 204
 205
 206
 207 =head2 Output
 208
 209 =over 4
 210
 211 =item S( 0gnirts )
 212
 213 Print popped 0gnirts on STDOUT.
 214
 215 =back
 216
 217
 218
 219 =head2 Coordinates & velocity changes
 220
 221 =over 4
 222
 223 =item X( $x )
 224
 225 Change X coordinate of IP to C<$x>.
 226
 227
 228 =item Y( $y )
 229
 230 Change Y coordinate of IP to C<$y>.
 231
 232
 233 =item V( $dx )
 234
 235 Change X coordinate of IP velocity to C<$dx>.
 236
 237
 238 =item W( $dy )
 239
 240 Change Y coordinate of IP velocity to C<$dy>.
 241
 242
 243 =back
 244
 245
 246
 247 =head1 SEE ALSO
 248
 249 L<Language::Befunge>, L<http://www.muppetlabs.com/~breadbox/orth/orth.html>
 250 and L<http://catseye.tc/projects/funge98/library/ORTH.html>
 251
 252
 253 =head1 AUTHOR
 254
 255 Jerome Quelin, C<< <jquelin@cpan.org> >>
 256
 257
 258 =head1 COPYRIGHT & LICENSE
 259
 260 Copyright (c) 2001-2008 Jerome Quelin, all rights reserved.
 261
 262 This program is free software; you can redistribute it and/or modify
 263 it under the same terms as Perl itself.
 264
 265
 266 =cut