The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

use strict;
use warnings;
use lib qw(lib lib/stripes) ;

use Test::More 'no_plan';

#-----------------------------------------------------------------------------

use Readonly ;
Readonly my $QUOTE_GLYPH => "'" ;
Readonly my $DOT_GLYPH => '.' ;
Readonly my $MINUS_GLYPH => '-' ;
Readonly my $PIPE_GLYPH => '|' ;
Readonly my $SLASH_GLYPH => '/' ;
Readonly my $BACKSLAH_GLYPH => '\\' ;

for my $multi_wirl
		(
		# expected   # 2 points                      
		
		#right + diagonal
		[$QUOTE_GLYPH, [4, 0, 'right'], [7, -3, '45']],
		[$QUOTE_GLYPH, [4, 0, 'right'], [1, -3, '315']],
		[$DOT_GLYPH, [4, 0, 'right'], [7, 3, '135']],
		[$DOT_GLYPH, [4, 0, 'right'], [1, 3, '225']],
		
		#down + diagonal
		[$QUOTE_GLYPH, [0, 4, 'down'], [3, 1, '45']], #5
		[$QUOTE_GLYPH, [0, 4, 'down'], [-3, 1, '315']],
		[$DOT_GLYPH, [0, 4, 'down'], [3, 7, '135']],
		[$DOT_GLYPH, [0, 4, 'down'], [-3, 7, '225']],

		#45+ diagonal
		[$SLASH_GLYPH, [4, -4, '45'], [7, -7, '45']], #9
		[$QUOTE_GLYPH, [4, -4, '45'], [1, -7, '315']],
		[$DOT_GLYPH, [4, -4, '45'], [7, -1, '135']],
		[$DOT_GLYPH, [4, -4, '45'], [1, -1, '225']],
		
		#225 + diagonal
		[$QUOTE_GLYPH, [-4, 4, '225'], [-1, 1, '45']], #13
		[$QUOTE_GLYPH, [-4, 4, '225'], [-7, 1, '315']],
		[$DOT_GLYPH, [-4, 4, '225'], [-1, 7, '135']],
		[$SLASH_GLYPH, [-4, 4, '225'], [-7, 7, '225']],
		
		#left + diagonal
		[$QUOTE_GLYPH, [-4, 0, 'left'], [-1, -3, '45']], #17
		[$QUOTE_GLYPH, [-4, 0, 'left'], [-7, -3, '315']],
		[$DOT_GLYPH, [-4, 0, 'left'], [-1, 3, '135']],
		[$DOT_GLYPH, [-4, 0, 'left'], [-7, 3, '225']],
		
		#up + diagonal
		[$QUOTE_GLYPH, [0, -4, 'up'], [3, -7, '45']], # 21
		[$QUOTE_GLYPH, [0, -4, 'up'], [-3, -7, '315']],
		[$DOT_GLYPH, [0, -4, 'up'], [3, -1, '135']],
		[$DOT_GLYPH, [0, -4, 'up'], [-3, -1, '225']],
		
		#135 + diagonal
		[$QUOTE_GLYPH, [4, 4, '135'], [7, 1, '45']], # 25
		[$QUOTE_GLYPH, [4, 4, '135'], [1, 1, '315']],
		[$BACKSLAH_GLYPH, [4, 4, '135'], [7, 7, '135']],
		[$DOT_GLYPH, [4, 4, '135'], [1, 7, '225']],
		
		#315 + diagonal
		[$QUOTE_GLYPH, [-4, -4, '315'], [-1, -7, '45']], # 29
		[$BACKSLAH_GLYPH, [-4, -4, '315'], [-7, -7, '315']],
		[$DOT_GLYPH, [-4, -4, '315'], [-1, -1, '135']],
		[$DOT_GLYPH, [-4, -4, '315'], [-7, -1, '225']],
		
		# digonal + non diagonal
		#45
		[$QUOTE_GLYPH, [4, -4, '45'], [4, -7, 'up']], #33
		[$DOT_GLYPH, [4, -4, '45'], [7, -4, 'right']],
		[$DOT_GLYPH, [4, -4, '45'], [4, 1, 'down']],
		[$DOT_GLYPH, [4, -4, '45'], [1, -4, 'left']],
		
		#225
		[$QUOTE_GLYPH, [-4, 4, '225'], [-4, 1, 'up']], #37
		[$QUOTE_GLYPH, [-4, 4, '225'], [1, 4, 'right']],
		[$DOT_GLYPH, [-4, 4, '225'], [-4, 7, 'down']],
		[$QUOTE_GLYPH, [-4, 4, '225'], [-7, 4, 'left']],
		
		#135
		[$QUOTE_GLYPH, [4, 4, '135'], [4, 1, 'up']], # 41
		[$QUOTE_GLYPH, [4, 4, '135'], [7, 4, 'right']],
		[$DOT_GLYPH, [4, 4, '135'], [4, 7, 'down']],
		[$QUOTE_GLYPH, [4, 4, '135'], [1, 4, 'left']],
		
		#315
		[$QUOTE_GLYPH, [-4, -4, '315'], [-4, -7, 'up']], # 45
		[$DOT_GLYPH, [-4, -4, '315'], [-1, -4, 'right']],
		[$DOT_GLYPH, [-4, -4, '315'], [-4, -1, 'down']],
		[$DOT_GLYPH, [-4, -4, '315'], [-7, -4, 'left']],
		)
		{
		my ($expected_connection_character, $point_1, $point_2) = @{$multi_wirl} ;
		my $origin = [10, 10] ; # offset the arrow as character with negative indexes don't ger rendered
		
		my ($text, $arrow_1_direction,$arrow_2_direction)  = get_multi_wirl_connection_text($origin, $point_1, $point_2) ;
		#~ print $text ;
		
		my @buffer ;
		my $line_index = 0 ;
		
		for my $line (split "\n", $text)
			{
			$buffer[$line_index++] = [split '', $line] ;
			}
		
		my ($origin_x, $origin_y) = @{$origin} ;
		my ($point_1_x, $point_1_y) = @{$point_1} ;
		
		is($buffer[$point_1_y + $origin_y][$point_1_x + $origin_x], $expected_connection_character)
			 or diag <<EOD ;
directions:$point_1->[2], $point_2->[2]
real directions: $arrow_1_direction,$arrow_2_direction
$text
EOD
		}

#-----------------------------------------------------------------------------

sub get_multi_wirl_connection_text
{
my ($origin, @points) = @_ ;

use App::Asciio ;
use App::Asciio::stripes::section_wirl_arrow;
my $asciio = new App::Asciio() ;
$asciio->set_character_size(8, 16) ;

my $new_element = new App::Asciio::stripes::section_wirl_arrow
					({
					POINTS => [@points],
					DIRECTION => '',
					ALLOW_DIAGONAL_LINES => 1,
					EDITABLE => 1,
					RESIZABLE => 1,
					}) ;
					
my ($character_width, $character_height) = $asciio->get_character_size() ; 
my ($origin_x, $origin_y) = @{$origin} ;
@$new_element{'X', 'Y'} = ($origin_x, $origin_y) ;

$asciio->add_elements($new_element) ;

return 
	$asciio->transform_elements_to_ascii_buffer(),
	$new_element->{ARROWS}[0]{DIRECTION},
	$new_element->{ARROWS}[1]{DIRECTION},
	;
}

#-----------------------------------------------------------------------------