package Prima::Widget::Link;
use strict;
use warnings;
use base qw(Prima::Widget::EventRectangles);
use Prima::Drawable::TextBlock;
use Prima::Drawable::Markup;
use Prima::Drawable::Pod;

sub notification_types {{
	Link           => nt::Action,
	LinkPreview    => nt::Action,
	LinkAdjustRect => nt::Action,
}}
sub profile_default    {{ color => cl::Green  }}

*op_link_enter = \&Prima::Drawable::Markup::op_link_enter;
*op_link_leave = \&Prima::Drawable::Markup::op_link_leave;

sub new
{
	my $class = shift;
	my %profile = @_;
	my $self = {
		last_link_pointer => [-1, cr::Default],
	};
	bless( $self, $class);
	$self-> {$_} = $profile{$_} ? $profile{$_} : []
		for qw( rectangles references);
	$self->{color} = $profile{color} // profile_default->{color};
	$self->bind_markup($profile{markup}) if defined $profile{markup};
	return $self;
}

sub contains
{
	my ( $self, $x, $y) = @_;
	my $rec = 0;

	for ( @{$self-> {rectangles}}) {
		return $rec if $x >= $$_[0] && $y >= $$_[1] && $x < $$_[2] && $y < $$_[3];
		$rec++;
	}
	return -1;
}

sub id2rectangles
{
	my ( $self, $link_id ) = @_;
	return grep { $_->[4] == $link_id } @{ $self->{rectangles} };
}

sub rectangles
{
	return $_[0]-> {rectangles} unless $#_;
	$_[0]-> {rectangles} = $_[1];
}

sub references
{
	return $_[0]-> {references} unless $#_;
	$_[0]-> {references} = $_[1];
}

sub color
{
	return $_[0]-> {color} unless $#_;
	my ( $self, $color ) = @_;
	$self->{color} = $color;
	$self->{colormap}->[ $self->{link_color_index} ] = $color if $self->{colormap};
}

sub bind_markup
{
	my ( $self, $m ) = @_;
	if ( $m ) {
		my $cm = $m->colormap;
		my $ix = @$cm;
		push @$cm, $self->color;
		$m->linkColor( $ix | tb::COLOR_INDEX );
		$m->reparse;
		$self->{link_color_index} = $ix;
		$self->{colormap}         = $cm;
		$self->{references}       = $m->link_urls;
	} else {
		$self->{references}       = [];
		$self->{link_color_index} = undef;
		$self->{colormap}         = undef;
	}
}

sub open_podview
{
	my ( $self, $url, $btn, $mod ) = @_;
	$::application->open_help($url);
}

sub open_browser
{
	my ( $self, $url, $btn, $mod ) = @_;

	if ( Prima::Application-> get_system_info-> {apc} == apc::Win32) {
		open UNIQUE_FILE_HANDLE_NEVER_TO_BE_CLOSED, "|start $url";
		close UNIQUE_FILE_HANDLE_NEVER_TO_BE_CLOSED if 0;
	} elsif ( $^O eq 'darwin') {
		return !system( open => $url );
	} else {
		my $pg;
		CMD: for my $cmd ( qw(xdg-open x-www-browser www-browser firefox mozilla sensible-browser netscape)) {
			for ( split /:/, $ENV{PATH} ) {
				$pg = "$_/$cmd", last CMD if -x "$_/$cmd";
			}
		}
		return 0 unless defined $pg && ! system( "$pg $url &");
	}

	return 1;
}

sub on_link
{
	my ( $self, $owner, $url, $btn, $mod ) = @_;

	return unless $owner->notify(q(Link), $self, $url, $btn, $mod);
	return 0 if $btn != mb::Left;

	if ( $url =~ m[^pod://(.*)] ) {
		my $link = $1;
		# if it is a path or module? 
		if ( $link !~ /::/ && $link =~ m/^(.*?)\/([^\/]*)$/) {
			$link = "file://$1|$2";
		}
		$self->open_podview($link, $btn, $mod);
	} elsif ( $url =~ m[^(ftp|https?)://]) {
		$self->open_browser($url, $btn, $mod);
	} elsif ( $url =~ m[^tip://]) {
		# nothing
	}
}

sub on_linkpreview
{
	my ( $self, $owner, $url ) = @_;

	return unless $owner->notify(q(LinkPreview), $self, $url);

	if ( $$url =~ m[^(pod|tip)://(.*)] ) {
		$$url = undef;

		require Prima::PodView;
		my ($tip, $link) = ($1 eq 'tip', $2);
		my $topicView = ($link =~ m[/]) ? 1 : 0;

		# if it is a path or module? 
		if ( $link !~ /::/ && $link =~ m/^(.*?)\/([^\/]*)$/) {
			$link = "file://$1|$2";
		}

		my $pod = Prima::Drawable::Pod->new;
		return unless $pod->load_link($link, create_index => 0);

		my @sz = Prima::HintWidget-> max_extents;

		my $x = $::application;
		$x->begin_paint_info;
		if ( my $polyblock = $pod->export_blocks(
			canvas        => $x,
			width         => $sz[0],
			max_height    => $sz[1],
			trim_footer   => 1,
			trim_header   => $topicView || $tip,
		)) {
			$$url = $polyblock;
		}
		$x->end_paint_info;

	} elsif ( $url =~ m[^(ftp|https?)://]) {
		# same
	}
}

sub on_mousedown
{
	my ( $self, $owner, $btn, $mod, $x, $y) = @_;
	my $r = $self-> contains( $x, $y);
	return 1 if $r < 0;
	$r = $self-> {rectangles}-> [$r];
	$r = $self-> {references}-> [$$r[4]];
	$self->on_link( $owner, $r, $btn, $mod);
	return 0;
}

sub on_mousemove
{
	my ( $self, $owner, $mod, $x, $y) = @_;
	my $r = $self-> contains( $x, $y);
	$self->{owner_pointer} //= $owner->pointer;
	$r = $self->rectangles->[$r]->[4] if $r >= 0;
	return if $r == $self-> {last_link_pointer}->[0];

	my $url     = ($r >= 0) ? $self->references->[$r] : '';
	my $new_ptr = ($r >= 0) ? (($url =~ /^tip:/ ? cr::QuestionArrow : cr::Hand)) : cr::Default;
	my $old_ptr = $self->{last_link_pointer}->[1];
	if ( $new_ptr != $old_ptr ) {
		$owner-> pointer(( $new_ptr == cr::Default) ? $self->{owner_pointer} : $new_ptr);
		delete $self->{owner_pointer} if $new_ptr == cr::Default;
	}

	my $rr = $self->rectangles;
	my $or = $self->{last_link_pointer}->[0];
	$self-> {last_link_pointer} = [$r, $new_ptr];

	my @around = (-1,-1,-1,-1);
	for my $rc (
		($or < 0) ? () : $self->id2rectangles( $or ),
		($r  < 0) ? () : $self->id2rectangles( $r  ),
	) {
		my @rc = @$rc;
		$owner-> notify(qw(LinkAdjustRect), $self, \@rc);
		$owner-> invalidate_rect(@rc[0..3]);
		@around = $owner->client_to_screen(@rc[0..3])
			if $rc[0] <= $x && $rc[1] <= $y && $rc[2] > $x && $rc[3] > $y;
	}

	if ( $r >= 0 ) {
		my $hint = $self-> {references}-> [$r];
		$self-> on_linkpreview( $owner, \$hint);
		goto NO_HINT unless length($hint // '');
		$owner->hint( $hint );
		$owner->showHint(1);
		$::application->set_hint_action($owner, 1, 1, @around);
	} else {
	NO_HINT:
		$owner->hint('');
		$owner->showHint(0);
	}
}

sub on_paint
{
	my ( $self, $owner, $canvas ) = @_;
	return if $self->{last_link_pointer} < 0;

	$canvas->graphic_context( sub {
		$canvas-> rop2(rop::NoOper);
		$canvas-> color( $self->color );
		$canvas-> antialias(0);
		$canvas-> lineWidth(1);
		$canvas-> translate(0,0);

		my $tip = ($self->references->[$self->{last_link_pointer}->[0]] // '') =~ /^tip:/;
		$canvas-> linePattern($tip ? lp::ShortDash : lp::Solid);

		for my $rc ( $self->id2rectangles( $self->{last_link_pointer}->[0] )) {
			my @rc = @$rc;
			$owner-> notify(qw(LinkAdjustRect), $self, \@rc);
			$rc[4] = $rc[1] < $rc[3] ? $rc[1] : $rc[3];
			$canvas-> line( @rc[0,4,2,4]);
		}
	});
}

sub clear_positions { shift->{rectangles} = [] }

sub add_positions_from_blocks
{
	my ( $self, $linkId, $blocks, %defaults ) = @_;
	my $linkState = 0;
	my $linkStart = 0;
	my @rect;
	my $rects = $self->{rectangles};
	$linkId //= 0;

	for my $b ( @$blocks ) {
		my @pos = ( $$b[tb::BLK_X], 0 );

		if ( $linkState) {
			$rect[0] = $$b[ tb::BLK_X];
			$rect[1] = $$b[ tb::BLK_Y];
		}

		tb::walk( $b, %defaults,
			position => \@pos,
			trace    => tb::TRACE_POSITION,
			link     => sub {
				if ( $linkState = shift ) {
					$rect[0] = $pos[0];
					$rect[1] = $$b[ tb::BLK_Y];
				} else {
					$rect[2] = $pos[0];
					$rect[3] = $$b[ tb::BLK_Y] + $$b[ tb::BLK_HEIGHT];
					push @$rects, [@rect, $linkId++];
				}
			},
		);

		if ( $linkState) {
			$rect[2] = $pos[0];
			$rect[3] = $$b[ tb::BLK_Y] + $$b[ tb::BLK_HEIGHT];
			push @$rects, [@rect, $linkId];
		}
	}

	return $linkId;
}

sub reset_positions_markup
{
	my ($self, $blocks, %defaults) = @_;
	$self->clear_positions;
	$self->add_positions_from_blocks(undef, [map { $_->text_block } @$blocks ], %defaults);
}

1;

=pod

=head1 NAME

Prima::Widget::Link - routines for interactive links

=head1 DESCRIPTION

The class can be used in widgets that need to feature I<links>, i e highlighted
rectangles, usually with a line of text. When the user moves the mouse or clicks on
a link, depending on the link type, various actions can be executed. A
"tooltip" link can display a hint with (rich) text, and a "hyperlink" link can
open a browser or a pod viewer. The programmer can also customize these
actions.

=head1 SYNOPSIS

  use Prima qw(Label Application);

  my $main_window = Prima::MainWindow->new( size => [400, 100] );
  $main_window->insert( Label =>
    centered => 1,
    text   => \ "L<tip://$0/ttt|tip>, L<pod://Prima/|podviewer>, L<http://google.com/|browser>, L<id|custom>",
    onLink => sub { print "$_[2]\n" },
  );
  run Prima;

  =pod

  =head1 ttt

  this is a tooltip

  =for podview <img src="data:base64">
  R0lGODdhFgAVAIAAAAAAAP///ywAAAAAFgAVAIAAAAD///8CLIyPqcutsKALQKI6qT11R69lWDJm
  5omm6jqBjucycEx+bVOSNNf1+/NjCREFADs=

=for podview <img src="link.gif">

=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/Widget/link.gif">

=head1 Link types

Link types can be set with the I<url> syntax. Four recognized link
types behave differently

=head2 Tooltips

These are not links in the strict sense, as clicking on them doesn't
cause any action, however when the user hovers the mouse over a tooltip, the module
loads the pod content from the URL and displays it as a hint.

The idea behind this feature is to collect all tooltip cards in a pod section and reference them
in the text like in the example code in L<SYNOPSIS> above.

Syntax: C<< LE<lt>tip://FILEPATH_OR_MODULE/SECTIONE<gt> >> or
C<< LE<lt>tip://FILEPATH_OR_MODULEE<gt> >> where C<FILEPATH_OR_MODULE> can refer either to
a file (path with slashes/backslashes) or a perl module (with C<::>s ).

The tooltip text, when selected, is underscored by a dashed line, vs all other link types that
use a solid line.

=head2 Pod sections

These links display a pod section preview like the tooltip but also open a pod viewer
with the referred section when clicked on. 

Syntax: C<< LE<lt>pod://FILEPATH_OR_MODULE/SECTIONE<gt> >> or
C<< LE<lt>pod://FILEPATH_OR_MODULEE<gt> >> where C<FILEPATH_OR_MODULE> can refer either to
a file (path with slashes/backslashes) or a perl module (with C<::>s ).

=head2 Hyperlinks

Links with schemes C<ftp://>, C<http://>, and C<https://> open a browser when clicked on.

=head2 Custom links

All other URLs, not matched by either scheme above, are expected to be handled
programmatically.  The preview, if any, should be handled by the C<LinkPreview>
event, and the mouse click by the C<Link> event.

See L<Events> below.

=head1 Usage

Since C<Prima::Widget::Link> is not a widget by itself but a collection of routines in a class,
an object of such class should be instantiated programmatically and attached to an I<owner> widget
that needs to display links.

The owner widget needs to call the mouse and paint methods from inside its
C<on_mousedown> etc relevant events.  The owner widget class might also want to
overload link events, see below how.

=head1 Markup

L<Prima::Drawable::Markup> understands the C<< LE<lt>..|..E<gt> >> command,
which, unlike perlpod, is formatted with its arguments reversed, to stay
consistent with the other markup commands
(i e it is C<< LE<lt>http://google.com|searchE<gt> >>,
not C<< LE<lt>search|http://google.comE<gt> >> .

The simple way to incorporate rich text in both the widget and link handler is to
use C<Prima::Drawable::Markup> to handle the markup parsing and use the
resulting object from the same class both for widget drawing and for the link
reactions. One just needs to add C< markup => $markup_object > to C<
Prima::Widget::Link->new() >.

=head1 API

=head2 Properties

=over

=item rectangles

Contains an array of rectangles in arbitrary coordinates that could be used to map screen coordinates to a URL.
Filled automatically.

=item references

An array of URLs

=back

=head2 Methods

=over

=item add_positions_from_blocks LINK_ID, BLOCKS, %DEFAULTS

Used when the link object is not bound to any markup object but recalculation
of the visual rectangle that the link occupies is needed due to change in
formatting, f ex after a change in widget size, font size, etc. C<%DEFAULTS> is
sent internally to C<tb::block_walk> which may need eventual default parameters.

Scans BLOCKS and add monotonically increasing LINK_ID to new
link rectangles. Return new LINK_ID.

=item clear_positions

Clears the content of C<rectangles>

=item id2rectangles ID

Returns rectangles mapped to a link ID. There can be more than 1 rectangle bound
to a single link ID since link text could be f ex wrapped.

=item open_podview URL

Opens a pod viewer with the URL

=item open_browser URL

Opens a web browser with the URL

=item reset_positions_markup BLOCKS, %DEFAULTS

Used when the link object is bound to a markup object and recalculation of the
visual rectangle that the link occupies is needed due to change in formatting,
f ex after a change in widget size, font size, etc. C<%DEFAULTS> is sent
internally to C<tb::block_walk> which may need eventual default parameters.

=back

=head2 Events

All events are sent to the owner, not to the link object itself, however, the
C<SELF> parameter which contains the link object is always the first parameter

=over

=item Link SELF, URL, BUTTON, MOD

Sent to the owner, if any, from within the C<on_mousedown> event to indicate that
the link was pressed on.

=item LinkPreview SELF, URL_REF

Sent to the owner, if any, from within the C<on_mousemove> event.  The owner
may want to fill URL_REF with (rich) text that will be displayed as a link
preview

=item LinkAdjustRect SELF, RECT_REF

Since the owner may implement a scrollable view or any other view that has a
coordinate system that is not necessarily consistent with the rectangles stored in
the link object, this event will be called when a link rectangle needs to be
mapped to the owner coordinates.

=back

=head1 AUTHOR

Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.

=head1 SEE ALSO

L<Prima>, L<Prima::Drawable::Markup>, L<Prima::Label>, L<Prima::Drawable::Pod>

=cut
