view release on metacpan or  search on metacpan

t/1-classes/ip.t  view on Meta::CPAN

$ip->ss_create( 3 );              # create new toss, filled with values (not enough).
is( $ip->scount, 3 );             # toss = (0,0,78)
is( $ip->soss_count, 0 );         # soss = ()
is( $ip->ss_count, 2 );
$ip->soss_push( 45 );             # soss = (45)
$ip->ss_transfer( 3 );            # move elems from soss to toss (not enough).
is( $ip->scount, 6 );             # toss = (0,0,78,45,0,0)
is( $ip->soss_count, 0 );         # soss = ()
is( $ip->spop, 0 );               # toss = (0,0,78,45,0)
is( $ip->spop, 0 );               # toss = (0,0,78,45)
is( $ip->spop, 45 );              # toss = (0,0,78)
$ip->soss_push( 12 );             # soss = (12)
$ip->ss_transfer( 0 );            # move 0 elems.
is( $ip->scount, 3 );
is( $ip->soss_count, 1 );
$ip->ss_remove( 0 );              # destroy toss, no values moved.
is( $ip->scount, 1 );             # toss = (12)
is( $ip->soss_count, 3 );         # soss = (11,12,13)
is( $ip->ss_count, 1 );
$ip->spush( 18 );                 # toss = (12,18)
$ip->ss_transfer( -1 );           # move elems from toss to soss (enough).
is( $ip->scount, 1 );             # toss = (12)
is( $ip->soss_count, 4 );         # soss = (11,12,13,18)
$ip->ss_remove( 1 );              # destroy toss, values filled (enough).
is( $ip->scount, 5 );             # toss = (11,12,13,18,12)
is( $ip->ss_count, 0 );
is( $ip->spop, 12 );              # toss = (11,12,13,18)
is( $ip->spop, 18 );              # toss = (11,12,13)
is( $ip->spop, 13 );              # toss = (11,12)
is( $ip->spop, 12 );              # toss = (11)
$ip->ss_create( 0 );              # toss = () soss = (11)
$ip->soss_push_vec( Language::Befunge::Vector->new(34, 48) );
is( $ip->soss_pop, 48 );
is( $ip->soss_pop, 34 );
$ip->soss_push_vec( Language::Befunge::Vector->new(49, 53) );
$v = $ip->soss_pop_vec;
is( ref($v), 'Language::Befunge::Vector' );
is( $v, "(49,53)" );
$ip->ss_remove( -3 );             # destroy toss, remove elems
is( $ip->scount, 0, "ss_remove can clear completely the soss-to-be-toss" );


#-- cardinal directions

$ip->dir_go_east;  is($ip->get_delta->as_string,  '(1,0)', "go_east changes delta");
$ip->dir_go_west;  is($ip->get_delta->as_string, '(-1,0)', "go_west changes delta");
$ip->dir_go_north; is($ip->get_delta->as_string, '(0,-1)', "go_north changes delta");
$ip->dir_go_south; is($ip->get_delta->as_string,  '(0,1)', "go_south changes delta");


#-- random direction

$ip->set_delta( Language::Befunge::Vector->new(3,2) );
my %wanted = ( map {$_=>undef} '(0,1)', '(0,-1)', '(1,0)', '(-1,0)' );
my $iter=0;
while ( keys %wanted ) {
    $iter++;
    $ip->dir_go_away;
    delete $wanted{ $ip->get_delta->as_string };
}
is(keys %wanted, 0, "go_away went north/east/south/west (in $iter iterations)");


#-- turn left

# cardinal directions
$ip->dir_go_east;
$ip->dir_turn_left; is($ip->get_delta->as_string, '(0,-1)', "turn left when going east works");
$ip->dir_turn_left; is($ip->get_delta->as_string, '(-1,0)', "turn left when going north works");
$ip->dir_turn_left; is($ip->get_delta->as_string,  '(0,1)', "turn left when going west works");
$ip->dir_turn_left; is($ip->get_delta->as_string,  '(1,0)', "turn left when going south works");

# non-cardinal delta
$ip->set_delta( Language::Befunge::Vector->new(3,2) );
$ip->dir_turn_left; is($ip->get_delta->as_string,  '(2,-3)', "turn left on non-cardinal delta works/1");
$ip->dir_turn_left; is($ip->get_delta->as_string, '(-3,-2)', "turn left on non-cardinal delta works/2");
$ip->dir_turn_left; is($ip->get_delta->as_string,  '(-2,3)', "turn left on non-cardinal delta works/3");
$ip->dir_turn_left; is($ip->get_delta->as_string,   '(3,2)', "turn left on non-cardinal delta works/4");


#-- turn right

# cardinal directions
$ip->dir_go_east;
$ip->dir_turn_right; is($ip->get_delta->as_string,  '(0,1)', "turn right when going east works");
$ip->dir_turn_right; is($ip->get_delta->as_string, '(-1,0)', "turn right when going south works");
$ip->dir_turn_right; is($ip->get_delta->as_string, '(0,-1)', "turn right when going west works");
$ip->dir_turn_right; is($ip->get_delta->as_string,  '(1,0)', "turn right when going north works");

# non-cardinal delta
$ip->set_delta( Language::Befunge::Vector->new(3,2) );
$ip->dir_turn_right; is($ip->get_delta->as_string,  '(-2,3)', "turn right on non-cardinal delta works/1");
$ip->dir_turn_right; is($ip->get_delta->as_string, '(-3,-2)', "turn right on non-cardinal delta works/2");
$ip->dir_turn_right; is($ip->get_delta->as_string,  '(2,-3)', "turn right on non-cardinal delta works/3");
$ip->dir_turn_right; is($ip->get_delta->as_string,   '(3,2)', "turn right on non-cardinal delta works/4");


#-- reverse

# cardinal directions
$ip->dir_go_east;
$ip->dir_reverse; is($ip->get_delta->as_string, '(-1,0)', "reverse from east works");
$ip->dir_reverse; is($ip->get_delta->as_string,  '(1,0)', "reverse from west works");

# non-cardinal delta
$ip->set_delta( Language::Befunge::Vector->new(2, -3) );
$ip->dir_reverse; is($ip->get_delta->as_string, '(-2,3)', "reverse on non-cardinal works/1");
$ip->dir_reverse; is($ip->get_delta->as_string, '(2,-3)', "reverse on non-cardinal works/2");


#-- cloning
$ip = Language::Befunge::IP->new;
$ip->spush( 1, 5, 6 );
$clone = $ip->clone;
isnt($ip->get_id, $clone->get_id, "clone change the IP unique id");
is($ip->spop,                  6, "clone did not changed the original IP");
is($clone->spop,               6, "clone also cloned the stack");


#-- extension data
$ip->extdata( "HELO", "foobar" );