# # This file is part of Language::Befunge. # Copyright (c) 2008 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::Storage; use strict; use warnings; use Carp; use Language::Befunge::Vector; use Language::Befunge::IP; use aliased 'Language::Befunge::Vector' => 'LBV'; # -- PUBLIC METHODS # # store( code, [vector] ) # # Store the given code at the specified vector. If the coordinates # are omitted, then the code is stored at the origin (0, 0). # # Return the size of the code inserted, as a vector. # # The code is a string, representing a block of Funge code. Rows are # separated by newlines. Planes are separated by form feeds. A complete list of # separators follows: # # Axis Delimiter # X (none) # Y \n # Z \f # 4 \0 # # The new-line and form-feed delimiters are in the Funge98 spec. However, there # is no standardized separator for dimensions above Z. Currently, dimensions 4 # and above use \0, \0\0, \0\0\0, etc. These are dangerously ambiguous, but are # the only way I can think of to retain reverse compatibility. Suggestions for # better delimiters are welcome. (Using XML would be really ugly, I'd prefer not # to.) # sub store { my ($self, $code, $base) = @_; my $nd = $$self{nd}; $base = Language::Befunge::Vector->new_zeroes($$self{nd}) unless defined $base; # support for any eol convention $code =~ s/\r\n/\n/g; $code =~ s/\r/\n/g; # The torus is a tree of arrays of numbers. # The tree is N levels deep, where N is the number of dimensions. # Each number is the ordinal value of the character held in this cell. my @separators = ("", "\n", "\f"); push(@separators, "\0"x($_-3)) for (4..$nd); # , "\0", "\0\0", "\0\0\0"... my $separators = join("", @separators); my %separators = ( map { $separators[$_] => $_ } (1..@separators-1)); my @sizes = map { 0 } (1..$nd); my @newvalues; my $this = $base->copy; while(length($code)) { my $value = substr($code, 0, 1, ''); if(index($separators, $value) > -1) { last unless length $code; my $d = $separators{$value}; my $new = $this->get_component($d) + 1; $this->set_component($d, $new); $sizes[$d] = $new if $new > $sizes[$d]; foreach my $i (0..$d-1) { my $last = $this->get_component($i); $this->set_component($i, $base->get_component($i)); $sizes[$i] = $last if $last > $sizes[$i]; } } else { my $last = $this->get_component(0); unless($value eq ' ') { push(@newvalues, [$this->copy, ord($value)]); $sizes[0] = $last if $last > $sizes[0]; } $this->set_component(0, $last + 1); } } return unless scalar @newvalues; # Figure out the rectangle size and the end-coordinate (max). my $size = Language::Befunge::Vector->new(map { $_ + 1 } @sizes); my $max = Language::Befunge::Vector->new(@sizes); $size -= $base; # Enlarge torus to make sure our new values will fit. $self->expand( $base ); $self->expand( $max ); # Store code. foreach my $pair (@newvalues) { $self->set_value(@$pair); } return $size; } # # store_binary( code, [vector] ) # # Store the given code at the specified coordinates. If the coordinates # are omitted, then the code is stored at the Origin(0, 0) coordinates. # # Return the size of the code inserted, as a vector. # # This is binary insertion, that is, EOL and FF sequences are stored in # Funge-space instead of causing the dimension counters to be reset and # incremented. The data is stored all in one row. # sub store_binary { my ($self, $code, $base) = @_; my $nd = $$self{nd}; $base = Language::Befunge::Vector->new_zeroes($$self{nd}) unless defined $base; # The torus is a tree of arrays of numbers. # The tree is N levels deep, where N is the number of dimensions. # Each number is the ordinal value of the character held in this cell. my @sizes = length($code); push(@sizes,1) for(2..$nd); # Figure out the min, max, and size my $size = Language::Befunge::Vector->new(@sizes); my $max = Language::Befunge::Vector->new(map { $_ - 1 } (@sizes)); $max += $base; # Enlarge torus to make sure our new values will fit. $self->expand( $base ); $self->expand( $max ); # Store code. for(my $v = $base->copy; defined($v); $v = $v->rasterize($base, $max)) { my $char = substr($code, 0, 1, ""); next if $char eq " "; $self->set_value($v, ord($char)); } return $size; } # # get_char( vector ) # # Return the character stored in the torus at the specified location. If # the value is not between 0 and 255 (inclusive), get_char will return a # string that looks like "". # # B As in Funge, code and data share the same playfield, the # character returned can be either an instruction B raw data. No # guarantee is made that the return value is printable. # sub get_char { my $self = shift; my $v = shift; my $ord = $self->get_value($v); # reject invalid ascii return sprintf("",$ord) if ($ord < 0 || $ord > 255); return chr($ord); } # # my $str = rectangle( start, size ) # # Return a string containing the data/code in the specified rectangle. # sub rectangle { my ($self, $v1, $v2) = @_; my $nd = $$self{nd}; # Fetch the data. my $data = ""; my $min = $v1; foreach my $d (0..$nd-1) { # each dimension must >= 1, otherwise the rectangle will be empty. return "" unless $v2->get_component($d); # ... but we need to offset by -1, to calculate $max $v2->set_component($d, $v2->get_component($d) - 1); } my $max = $v1 + $v2; # No separator is used for the first dimension, for obvious reasons. # Funge98 specifies lf/cr/crlf for a second-dimension separator. # Funge98 specifies a form feed for a third-dimension separator. # Funge98 doesn't specify what dimensions 4 and above should use. # We use increasingly long strings of null bytes. # (4d uses 1 null byte, 5d uses 2, 6d uses 3, etc) my @separators = ""; push(@separators,"\n") if $nd > 1; push(@separators,"\f") if $nd > 2; push(@separators,"\0"x($_-3)) for (4..$nd); # , "\0", "\0\0", "\0\0\0"... my $prev = $min->copy; for(my $v = $min->copy; defined($v); $v = $v->rasterize($min, $max)) { foreach my $d (0..$$self{nd}-1) { $data .= $separators[$d] if $prev->get_component($d) != $v->get_component($d); } $prev = $v; $data .= $self->get_char($v); } return $data; } # expand( vector ) # Expand the storage range to include the specified point, if necessary. # This version of expand() is meant for Sparse modules; it only adjusts the min # and max vectors with no other effect. Non-sparse modules should supercede # this method to do something more meaningful. sub expand { my ($self, $v) = @_; my $min = $$self{min}; my $max = $$self{max}; foreach my $d (0..$$self{nd}-1) { $min->set_component($d, $v->get_component($d)) if $v->get_component($d) < $min->get_component($d); $max->set_component($d, $v->get_component($d)) if $v->get_component($d) > $max->get_component($d); } } #- misc methods # # my %labels = labels_lookup( ) # # Parse the Lahey space to find sequences such as C<;:(\w[^\s;])[^;]*;> # and return a hash reference whose keys are the labels and the values # an anonymous array with two vectors: a vector describing the absolute # position of the character B the trailing C<;>, and a # vector describing the velocity that lead to this label. # # This method will only look in the cardinal directions; west, east, # north, south, up, down and so forth. # # This allow to define some labels in the source code, to be used by # C (and maybe some extensions). # sub labels_lookup { my $self = shift; my $labels = {}; my ($min, $max) = ($$self{min}, $$self{max}); my $nd = $$self{nd}; my @directions = (); foreach my $dimension (0..$nd-1) { # build the array of (non-diagonal) vectors my $v1 = Language::Befunge::Vector->new_zeroes($nd); my $v2 = $v1->copy; $v1->set_component($dimension,-1); push(@directions,$v1); $v2->set_component($dimension, 1); push(@directions,$v2); } R: for(my $this = $min->copy; defined($this); $this = $this->rasterize($min, $max)) { V: for my $v (@directions) { next R unless $self->get_char($this) eq ";"; my ($label, $loc) = $self->_labels_try( $this, $v ); next V unless defined($label); # How exciting, we found a label! croak "Help! I found two labels '$label' in the funge space" if exists $labels->{$label}; $$labels{$label} = [$loc, $v]; } } return $labels; } # # my $dims = get_dims() # # Returns the number of dimensions this storage object operates in. # sub get_dims { my $self = shift; return $$self{nd}; } # # my $vector = min() # # Returns a Vector object, pointing at the beginning of the torus. # If nothing has been stored to a negative offset, this Vector will # point at the origin (0,0). # sub min { my $self = shift; return $$self{min}->copy; } # # my $vector = max() # # Returns a Vector object, pointing at the end of the torus. # This is usually the largest position which has been written to. # sub max { my $self = shift; return $$self{max}->copy; } # -- PRIVATE METHODS # # $storage->_labels_try( $x, $y, $dx, $dy ) # # Try in the specified direction if the funge space matches a label # definition. Return undef if it wasn't a label definition, or the name # of the label if it was a valid label. # sub _labels_try { my ($self, $start, $delta) = @_; my $comment = ""; my $wrapping = $$self{wrapping}; my $ip = Language::Befunge::IP->new($$self{nd}); my $min = $self->min; my $max = $self->max; $ip->set_position($start->copy); $ip->set_delta($delta); # Fetch the whole comment stuff. do { # Calculate the next cell coordinates. my $v = $ip->get_position; my $d = $ip->get_delta; # now, let's move the ip. $v += $d; if ( $v->bounds_check($min, $max) ) { $ip->set_position( $v ); } else { $wrapping->wrap( $self, $ip ); } $comment .= $self->get_char($ip->get_position()); } while ( $comment !~ /;.$/ ); # Check if the comment matches the pattern. $comment =~ /^:(\w[^\s;]*)[^;]*;.$/; return ($1, $ip->get_position()); } 1; __END__ =head1 NAME Language::Befunge::Storage - a generic Storage base class =head1 SYNOPSIS my $storage = Language::Befunge::Storage::Generic::AoA->new; $storage->clear; $storage->store(<store_binary( $code [, $position] ); Store the given C<$code> at the specified C<$position> (defaulting to the origin coordinates). Return the size of the code inserted, as a vector. The code is a string, representing a block of Funge code. This is binary insertion, that is, EOL sequences are stored in Funge-space instead of causing the dimension counters to be resetted and incremented. =item my $size = $storage->store( $code [, $position] ); Store the given $code at the specified $position (defaulting to the origin coordinates). Return the size of the code inserted, as a vector. The code is a string, representing a block of Funge code. Rows are separated by newlines. =item $storage->expand( vector ); Expand the storage range to include the specified point, if necessary. This is a stub method, to be superceded by subclasses which do something meaningful here. It is usually called for new "min" and "max" values, for efficiency reasons: if we expand the storage ahead of time, we only have to do the expansion once, rather than expanding it again and again every time a rasterize loop reaches new ground. Sparse storage models do not need this; all other storage models should implement a specific method to resize their data structure. =back =head2 Data retrieval =over 4 =item my $dims = $storage->get_dims; Return the number of dimensions this storage object operates in. =item my $vmin = $storage->min; Return a LBV pointing to the lower bounds of the storage. =item my $vmax = $storage->max; Return a LBV pointing to the upper bounds of the storage. =item my $chr = $storage->get_char( $offset ) Return the character stored in the torus at the specified C<$offset>. If the value is not between 0 and 255 (inclusive), get_char will return a string that looks like C<< >>. B As in Befunge, code and data share the same playfield, the character returned can be either an instruction B raw data. No guarantee is made that the return value is printable. =item my $str = $storage->rectangle( $pos, $size ); Return a string containing the data/code in the rectangle defined by the supplied vectors. =back =head2 Miscellaneous methods =over 4 =item my $href = $storage->labels_lookup; Parse the storage to find sequences such as C<;:(\w[^\s;])[^;]*;> and return a hash reference whose keys are the labels and the values an anonymous array with four values: a vector describing the absolute position of the character just after the trailing C<;>, and a vector describing the velocity that leads to this label. This method will only look in the four cardinal directions, and does wrap basically like befunge93 (however, this should not be a problem since we're only using cardinal directions) This allow to define some labels in the source code, to be used by C (and maybe some exstensions). =begin pod_coverage =item LBV - alias for Language::Befunge::Vector =end pod_coverage =back =head1 SEE ALSO L. =head1 AUTHOR Mark Glines, C<< >> Jerome Quelin, C<< >> =head1 COPYRIGHT & LICENSE Copyright (c) 2001-2008 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