t/1-classes/wrapping-lahey.t

   1 #!perl
   2 #
   3 # This file is part of Language::Befunge.
   4 # Copyright (c) 2001-2008 Jerome Quelin, all rights reserved.
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the same terms as Perl itself.
   8 #
   9 #
  10
  11 #
  12 # Language::Befunge::Wrapping::LaheySpace
  13 #
  14
  15 use strict;
  16 use warnings;
  17
  18 use Test::More tests => 12;
  19
  20 use Language::Befunge::IP;
  21 use Language::Befunge::Storage::2D::Sparse;
  22 use aliased 'Language::Befunge::Vector' => 'LBV';
  23 use Language::Befunge::Wrapping::LaheySpace;
  24
  25 # vars used within the file
  26 my ($w, $s);
  27 my $ip = Language::Befunge::IP->new(2);
  28
  29
  30 #-- constructor
  31
  32 #- new()
  33 $w = Language::Befunge::Wrapping::LaheySpace->new;
  34 isa_ok($w, 'Language::Befunge::Wrapping');
  35 isa_ok($w, 'Language::Befunge::Wrapping::LaheySpace');
  36 can_ok($w, 'wrap');
  37
  38
  39 #-- public methods
  40
  41 #- wrap()
  42 # main cardinal directions
  43 $s = Language::Befunge::Storage::2D::Sparse->new;
  44 $s->set_value( LBV->new(5,10), 32 );
  45 # east
  46 $ip->set_position( LBV->new(6,3) );
  47 $ip->set_delta( LBV->new(1,0) );
  48 $w->wrap($s,$ip);
  49 is($ip->get_position, '(0,3)', 'wrap() wraps xmax (east)');
  50 # west
  51 $ip->set_position( LBV->new(-1,4) );
  52 $ip->set_delta( LBV->new(-1,0) );
  53 $w->wrap($s,$ip);
  54 is($ip->get_position, '(5,4)', 'wrap() wraps xmin (west)');
  55 # south
  56 $ip->set_position( LBV->new(2,11) );
  57 $ip->set_delta( LBV->new(0,1) );
  58 $w->wrap($s,$ip);
  59 is($ip->get_position, '(2,0)', 'wrap() wraps ymax (south)');
  60 # north
  61 $ip->set_position( LBV->new(2,-1) );
  62 $ip->set_delta( LBV->new(0,-1) );
  63 $w->wrap($s,$ip);
  64 is($ip->get_position, '(2,10)', 'wrap() wraps ymin (north)');
  65 # east with delta that overflows width
  66 $ip->set_position( LBV->new(11,3) );
  67 $ip->set_delta( LBV->new(8,0) );
  68 $w->wrap($s,$ip);
  69 is($ip->get_position, '(3,3)', 'wrap() wraps xmax (big east delta)');
  70 # west with delta that overflows width
  71 $ip->set_position( LBV->new(-5,4) );
  72 $ip->set_delta( LBV->new(-8,0) );
  73 $w->wrap($s,$ip);
  74 is($ip->get_position, '(3,4)', 'wrap() wraps xmin (big west delta)');
  75 # south with delta that overflows height
  76 $ip->set_position( LBV->new(2,20) );
  77 $ip->set_delta( LBV->new(0,12) );
  78 $w->wrap($s,$ip);
  79 is($ip->get_position, '(2,8)', 'wrap() wraps ymax (big south delta)');
  80 # north with delta that overflows height
  81 $ip->set_position( LBV->new(2,-5) );
  82 $ip->set_delta( LBV->new(0,-12) );
  83 $w->wrap($s,$ip);
  84 is($ip->get_position, '(2,7)', 'wrap() wraps ymin (big north delta)');
  85
  86 # diagonals
  87 $s = Language::Befunge::Storage::2D::Sparse->new;
  88 $s->set_value( LBV->new(-1,-2), 32 );
  89 $s->set_value( LBV->new( 6, 5), 32 );
  90 $ip->set_position( LBV->new(1,-3) );
  91 $ip->set_delta( LBV->new(-2,-3) );
  92 $w->wrap($s,$ip);
  93 is($ip->get_position, '(5,3)', 'wrap() wraps even diagonals');
  94
  95