use strict;
use warnings;
use Tk;
use Tk::Pane;
use utf8;      # <-- update: see choroba below. Used to make sterling and degree work

my $mw = Tk::MainWindow->new(-bg=>'ivory',-title=>'ASCII draw');
$mw->geometry("700x600+0+0");

$mw->optionAdd('*font', 'Courier 12');
$mw->optionAdd( '*Entry.background',   'lavender' );
$mw->optionAdd( '*Entry.font',   'Courier 12 bold'  );


# TOP FRAME
my $top_frame0 = $mw->Frame( -borderwidth => 2, -relief => 'groove',)->pack(-anchor=>'ne', -fill => 'both');

$top_frame0->Label( -text=>"press a key to set brush (or choose it from the below menu)\n".
							"hold CRTL and move the pointer to paint",)->pack( -side=>'top');


my $top_frame1 = $mw->Frame( -borderwidth => 2,-relief => 'groove',)->pack(-anchor=>'ne', -fill => 'both');

my $default_char = ' ';

my $maxy = 29;
my $maxx = 29; 

my $tile_w = 15;
my $tile_h = 15;

my $cur_tile_lbl = 'tile (y-x): 0-0';

$top_frame1->Label( -textvariable=>\$cur_tile_lbl,)->pack( -side=>'left',-padx=>5);


my $list_brushes = $top_frame1->Optionmenu( -textvariable=>\$default_char, )->pack( -side=>'right' ,-padx=>5);
$top_frame1->Label( -text=>"actual brush: ",)->pack( -side=>'right' ,-padx=>5);

foreach my $charnum (32..127){
	$list_brushes->addOptions( chr($charnum) );
}


my $top_frame2 = $mw->Frame( -borderwidth => 2, 
							-relief => 'groove',
)->pack(-anchor=>'ne', -fill => 'both');

$top_frame2->Label(-text => "rows: 0-")->pack(-side => 'left');

$top_frame2->Entry(	
					-width => 3,
					-borderwidth => 4, 
					-textvariable => \$maxy
)->pack(-side => 'left',-padx=>5);

$top_frame2->Label(-text => "columns: 0-")->pack(-side => 'left',-padx=>5);

$top_frame2->Entry(	
					-width => 3,
					-borderwidth => 4, 
					-textvariable => \$maxx
)->pack(-side => 'left',,-padx=>5);

$top_frame2->Button(	-padx=> 5,
					-text => "new",
					-borderwidth => 4, 
					-command => sub{ &setup_new }
)->pack(-side => 'left',-padx=>5);



$top_frame2->Button(	-padx=> 5,
					-text => "toggle grid",
					-borderwidth => 4, 
					-command => sub{&toggle_grid()},
)->pack(-side => 'right',-padx=>5);

$top_frame2->Button(	-padx=> 5,
					-text => "export",
					-borderwidth => 4, 
					-command => sub{&export_aoa()},
)->pack(-side => 'right',-padx=>5);

# $top_frame2->Button(	-padx=> 5,
					# -text => "import",
					# -borderwidth => 4, 
					# -command => sub{exit}
# )->pack(-side => 'right',-padx=>5);




# MAP FRAME
my $map_frame = $mw->Scrolled(	'Frame',
								-scrollbars => 'osoe',
								-relief => 'groove',
)->pack(-anchor=>'n',-expand => 1, -fill => 'both');

 
my $canvas;
my $grid_show = 1;
my @aoa;
setup_new();	

				  
MainLoop();


sub setup_new{
	$default_char = ' ';
	
	$canvas->packForget if Tk::Exists($canvas); 
	
	@aoa = map{ [ ($default_char) x ($maxx + 1)  ] } 0..$maxy;
	$canvas = $map_frame->Canvas(
							-bg => 'ivory',
							-width 	=> $maxx * $tile_w + $tile_w - 2, # -2 correction for the grid
							-height => $maxy * $tile_h + $tile_h - 2,
              )->pack(-anchor=>'n',-expand => 1, -fill => 'both');
	
	$canvas->focusForce;
	
	$canvas->createGrid(0,0, $tile_w, $tile_h, lines=>1,-width=>1,-tags=>['thegrid']);
	 
	my $start_y = 0;
	my $end_y = $start_y + $tile_h;

	my $start_x = 0;
	my $end_x = $start_x + $tile_w;

	foreach my $row (0..$#aoa){
		foreach my $col( 0..$#{$aoa[$row]} ){
			$canvas->createText(
									($start_x + $end_x ) / 2,
									($start_y + $end_y ) / 2,
									
									 -text => $aoa[$row][$col],
									 -tags => ["$row-$col"],
									 -font=> 'Courier 14 bold'
			);
			$start_x += $tile_w;
			$end_x	+= $tile_w;
		}
		$start_x = 0;
		$end_x = $start_x + $tile_w;
		$start_y += $tile_h;
		$end_y	+= $tile_h;
	
	}
	$mw->bind("<Key>", [ \&set_default_char, Ev('K') ] );
	#$mw->bind("<Key-space>", [ \&set_default_char_to_space, Ev('K') ] );
	#$canvas->Tk::bind("<Motion>", [ \&get_coord, Ev('x'), Ev('y') ]);
	$canvas->Tk::bind("<Control-Motion>", [ \&set_coord, Ev('x'), Ev('y') ]);
	#$canvas->Tk::bind("<Button1-Motion>", [ \&set_coord, Ev('x'), Ev('y') ]);
	$canvas->Tk::bind("<Button-1>", [ \&get_coord, Ev('x'), Ev('y') ]);
	#$canvas->Tk::bind("<Button-3>",  [ \&reset_motion, Ev('x'), Ev('y') ]);
	
	
}

sub set_default_char {
		my ($canv, $k) = @_;
		print "DEBUG [$k] was pressed..\n";
		#return 0 unless $k =~ /^.$/;
		my %other_chars = (
				space		=> ' ',
				at			=> '@',
				numbersign	=> '#',				
				backslash 	=> '\\',
				bar			=> '|',
				exclam		=> '!',
				quotedbl	=> '"',
		sterling	=> '£', # need utf8
				dollar		=> '$',
				percent		=> '%',
				ampersand	=> '&',
				slash		=> '/',
				parenleft	=> '(',
				parenright	=> ')',
				equal		=> '=',
				quoteright	=>	"'",
				question	=> '?',
				asciicircum	=> '^',
				comma 		=> ',',
				period		=> '.',
				minus		=> '-',
				semicolon	=> ';',
				colon		=> ':',
				underscore	=> '_',
				plus		=> '+',
				asterisk	=> '*',
		degree		=> '°', # need utf8
				greater		=> '>',
				less		=> '<',
								
				
		);
		if( $k =~ /^.$/){
			$default_char = $k;
			print "setting brush to [$k]\n";
		}
		elsif( exists $other_chars{$k} ){
			$default_char = $other_chars{$k};
			print "setting brush to [$other_chars{$k}]\n";
		}
		else{
			print "WARNING: cannot use [$k] as char to draw!\n";
		}
		
		
}
sub set_coord {
	my ($canv, $x, $y) = @_;
	#print "SETtING (x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n";
	my $cur = $canv->find('withtag' =>'current' );
	my @list = grep{$_ ne 'current'} $canv->gettags($cur);
	
		if ( $list[0] ){
		
		$canv->itemconfigure($cur, -text=> $default_char);
		my ($tile_y,$tile_x)=split /-/, $list[0];
		$cur_tile_lbl = "tile (y-x): $tile_y-$tile_x";
		print "SET $tile_y - $tile_x\n";
		$aoa[$tile_y][$tile_x]= $default_char;
	}
}

sub toggle_grid{
	if ( $grid_show ){
		$canvas->itemconfigure('thegrid',-color=>'ivory');
	}
	else{
		$canvas->itemconfigure('thegrid',-color=>'black');
	}
	$grid_show = !$grid_show;
}

# from https://www.perlmonks.org/?node_id=987407 zentara rules!!
sub get_coord {
	my ($canv, $x, $y) = @_;
	#print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n";
	my $cur = $canv->find('withtag' =>'current' );
	my @list = grep{$_ ne 'current'} $canv->gettags($cur);
	
	$cur_tile_lbl = "tile (y-x): $list[0] " if $list[0];
	
}
sub export_aoa{
	foreach my $row (0..$#aoa){
		foreach my $col( 0..$#{$aoa[$row]} ){
			print $aoa[$row][$col];
		}
		print "\n";	
	}
}