#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

use strict;
require Exporter;
require Tk;

$W3C::Database::TableVisualizer::REVISION = '$Id: TableVisualizer.pm,v 1.4 2003/12/03 14:57:28 eric Exp $ ';

package W3C::Database::TableVisualizer;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK @TODO);
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 0.94;
$DSLI = 'adpO';
@TODO = ('hide internals of RDF_DB and NAMESPACE_HANDLER');

package W3C::Database::TableVisualizer::LabEntry;
require Tk::Frame;
@W3C::Database::TableVisualizer::LabEntry::ISA = qw(Tk::Frame);

Construct W3C::Database::TableVisualizer::LabEntry 'LabEntry';

sub Populate {
    require Tk::Entry;
    my ($cw, $args) = @_;
    $cw->SUPER::Populate($args);
    my $e = $cw->Entry();
    $e->pack(-expand => 1, -fill => 'both');
    $cw->Advertise('entry', => $e);
    $cw->ConfigSpecs(DEFAULT => [$e]);
    $cw->Delegates(DEFAULT => $e);
    $cw->AddScrollbars($e) if (exists $args->{-scrollbars});
}

package W3C::Database::TableVisualizer;

sub new {
    my ($proto, $dbName) = @_;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless ($self, $class);
    $self->makeMainWindow;
    return $self;
}

sub makeMainWindow {
    my ($self, $database) = @_;
    $self->{MW} = Tk::MainWindow->new(-title => 'browse '.$self->{DATABASE});
}

sub selectTable ($) {
    my ($self, $tables) = @_;
    $self->{MW}->Frame(-relief => 'groove', -bd => 2)->pack(-anchor => 'w', -side => 'top');

    # bottom row is just the exit button
    $self->{MW}->Button(-text => "exit", -underline => 1, -command => sub {$self->{MW}->destroy()})->pack(-side => 'bottom');
}

my ($X, $Y, $TS, $AW, $AH) = (300, 300, 10, 5, 8);

sub browse {
    my ($self) = @_;
    my $mw = Tk::MainWindow->new(-title => 'browse '.$self->{RDF_DB}->{SOURCE});

    # top row is some buttons
    {
	my $mw = $mw->Frame(-relief => 'groove', -bd => 2)->pack(-anchor => 'w', -side => 'top');

	$self->{RIGHT} = $mw->Button(-text => "->",  -underline => 1, -state => 'disabled', 
				     -command => [\&nav, $self, 0], -background => 'grey')->pack(-side => 'right');
	$self->{LEFT} = $mw->Button(-text => "<-", -underline => 0, -state => 'disabled', 
				    -command => [\&nav, $self, 1], -background => 'grey')->pack(-side => 'right');
	$mw->Checkbutton(-text => 'Show reifications', 
			 -underline => 5, 
			 -variable => \ $self->{SHOW_REIFICATIONS}, 
			 -command => [\&changeLazyReification, $self])->pack(-anchor => 'w', -side => 'left', -padx => 10);
    }

    # bottom row is just the exit button
    $mw->Button(-text => "exit", -underline => 1, -command => sub {$mw->destroy()})->pack(-side => 'bottom');

    # now the namespace options for each source
    foreach my $sourceId (keys %{$self->{NAMESPACE_HANDLER}->{NAMESPACE_REVERSE}}) {
	$mw->Label(-text => 'show namespaces from from source: '.$sourceId, -justify => 'left')->pack(-anchor => 'w');
	my $mw = $mw->Frame(-relief => 'groove', -bd => 2)->pack(-padx => 20);
	foreach my $expanded (keys %{$self->{NAMESPACE_HANDLER}->{NAMESPACE_REVERSE}{$sourceId}}) {
	    my $ns = $self->{NAMESPACE_HANDLER}->{NAMESPACE_REVERSE}{$sourceId}{$expanded};
	    $self->{ENS}{$sourceId}{$expanded} = 1;
	    $mw->Checkbutton(-text => "xmlns:$ns=\"$expanded\"", 
			     -anchor => 'e', 
			     -padx => 5, 
			     -variable => \ $self->{ENS}{$sourceId}{$expanded}, 
			     -command => [\&triplesPick, $self])->pack(-anchor => 'w');
	}
    }

    # a new frame provides the body for the search prompt, triple list, and graph canvas
    {
	my $mw = $mw->Frame(-relief => 'groove', -bd => 2)->pack(-anchor => 'w'); # -side => 'left');

	# graph canvas on the right
	$self->{GRAPH} = $mw->Scrolled('Canvas', -width => $X, -height => ($Y * 5)/4)->pack(-anchor => 'e', -side => 'right');
	$self->{GRAPH}->Subwidget('canvas')->Tk::bind("<Button-1>", [\&graphPick, $self]);
	{

	    # framed search prompt on the top
	    my $mw = $mw->Frame(-relief => 'groove', -bd => 2)->pack(-anchor => 'w', -side => 'top'); # -side => 'left');
	    $mw->Label(-text => 'Look for: ')->pack(-side => 'left');
	    $self->{SEARCH} = $mw->Scrolled('Entry', -scrollbars => 'os')->pack(-side => 'right', -anchor => 'w');
	    $self->{SEARCH}->bind("<Return>", [\&search, $self, 0]);
	    $self->{SEARCH}->bind("<Up>", [\&search, $self, 1]);
	    $self->{SEARCH}->bind("<Down>", [\&search, $self, 0]);
	}

	# triple list on the left
	$self->{TRIPLE_LIST} = $mw->Scrolled('Listbox', 
					     -scrollbars => 'e', 
					     -selectmode => 'extended', #'single', 
					     -width => 90, 
					     -height => ($Y * 5)/4/$TS/2, 
					     )->pack(-side => 'left');
	$self->{TRIPLE_LIST}->bind("<Button-1>", [\&triplesPick, $self]);
	$self->{TRIPLE_LIST}->bind("<Return>", [\&triplesPick, $self]);
#	$self->{TRIPLE_LIST}->bind("<Space>", [\&triplesPick, $self]);
	$self->{TRIPLE_LIST}->bind("<Control-Alt-Up>", [\&search, $self, 1]);
	$self->{TRIPLE_LIST}->bind("<Control-Alt-Down>", [\&search, $self, 0]);
    }
    $self->redisplayList;
    &Tk::MainLoop;
}

sub search {
    my ($entry, $self, $up) = @_;
    my $search = $self->{SEARCH};
    my $searchString = $search->get;
    return if ($searchString eq '');
    my $lb = $self->{TRIPLE_LIST};
#    print "{$search}->get: \"$searchString\" from {$self->{SEARCH_INDEX}}\n";
    if (!$up) {
	my $start = $self->{SEARCH_INDEX} == $lb->size - 1 ? 0 : $self->{SEARCH_INDEX}+1;
	my $end = $lb->size - 1;
	my $i;
      SEARCH_DOWN:
	for ($i = $start; $i <= $end; $i++) {
	    my $entry = $lb->get($i);
	    if ($entry =~ m/$searchString/) {
		$lb->selectionClear(0, 'end');
		$lb->selectionSet($i);
		$lb->see($i);
		$self->{SEARCH_INDEX} = $i;
		&triplesPick(undef, $self);
		return;
	    }
	}
	if ($i == $lb->size) {
	    $start = 0;
	    $end = $self->{SEARCH_INDEX};
	    goto SEARCH_DOWN;
	}
    } else {
	my $start = $self->{SEARCH_INDEX} == 0 ? $lb->size - 1 : $self->{SEARCH_INDEX}-1;
	my $end = 0;
	my $i;
      SEARCH_UP:
	for ($i = $start; $i >= $end; $i--) {
	    my $entry = $lb->get($i);
	    if ($entry =~ m/$searchString/) {
		$lb->selectionClear(0, 'end');
		$lb->selectionSet($i);
		$lb->see($i);
		$self->{SEARCH_INDEX} = $i;
		&triplesPick(undef, $self);
		return;
	    }
	}
	if ($i == -1) {
	    $start = $lb->size - 1;
	    $end = $self->{SEARCH_INDEX}+1;
	    goto SEARCH_UP;
	}
    }
    $lb->bell;
#    $search->flash; # find a button to do the flashing
#    print "not found\n";
}

sub changeLazyReification {
    my ($self) = @_;
    $self->{RDF_DB}->setLazyReification(!$self->{SHOW_REIFICATIONS});
    $self->redisplayList;
    &graphPick($self->{GRAPH}, $self, $self->{LAST_GRAPH_CURRENT});
}

sub redisplayList {
    my ($self) = @_;
    my $lb = $self->{TRIPLE_LIST};
    $lb->delete(0, 'end');
    my $i = 0;
    $self->{BY_TEXT} = undef;
    $self->{BY_INDEX} = undef;
    foreach my $triple (@{$self->{RDF_DB}{TRIPLES}}) { # sort {$a->subject cmp $b->subject} @{$self->{RDF_DB}{TRIPLES}}) {
	my $text = $triple->show('', $self->{NAMESPACE_HANDLER});
	$lb->insert('end', $text);
	$self->{BY_TEXT}{$text} = [$i, $triple];
	$self->{BY_INDEX}[$i++] = [$text, $triple];
	my $sourceId = $triple->attribution->source;
# experimental alternate way to show reifications
#	if ($self->{SHOW_REIFICATIONS}) {
#	    my @reifications = $triple->getReification($db, $atoms);
#	    foreach my $reification (@reifications) {
#		my $text = $reification->show('', $self->{NAMESPACE_HANDLER});
#		$lb->insert('end', $text);
#		$self->{BY_TEXT}{$text} = [$i, $reification];
#		$self->{BY_INDEX}[$i++] = [$text, $reification];
#	    }
#	}
    }
}

sub triplesPick {
    my ($caller, $self) = @_;
    my $lb = $self->{TRIPLE_LIST};
    my @selection = $lb->curselection;
    $self->{SEARCH_INDEX} = $selection[0];
    my @triples;
    foreach my $i (@selection) {
	push (@triples, $self->{BY_INDEX}[$i]->[1]);
    }
    $self->resetNav;
    my $graph = $self->{GRAPH};
    $graph->delete('stuff');
    $self->renderTriples(\@triples, 1);
}

sub renderTriples {
    my ($self, $triples, $fullScreen, $top) = @_;
    my $graph = $self->{GRAPH};
    my $tripleCount = $#$triples - $[ + 1;
    my $step = $X / ($tripleCount + 1);
    my $x = $step;
    my ($yTop, $yMid, $yBot) = $fullScreen ? ($TS+1, $Y/2, $Y-$TS) : $top ? ($TS+1, $Y/4, $Y/2) : ($Y/2, (3*$Y)/4, $Y-$TS);
    for (my $i = 0; $i < $tripleCount; $i++) {
	my $triple = $triples->[$i];
	my $text = $triple->show('', $self->{NAMESPACE_HANDLER});
	my ($predicate, $subject, $object, $source) = ($triple->predicate, $triple->subject, $triple->object, $triple->{SOURCE});
	my $namespaceHandler = $self->{NAMESPACE_HANDLER};
	my ($predicateShort, $subjectShort, $objectShort, $sourceShort) = ($predicate, $subject, $object, $source);
	if ($namespaceHandler) {
	    $predicateShort = $namespaceHandler->unmapNamespace($predicate);
	    $subjectShort = $namespaceHandler->unmapNamespace($subject);
	    $objectShort = $namespaceHandler->unmapNamespace($object);
	    $sourceShort = $namespaceHandler->unmapNamespace($source);
	}
#	my ($entryVector, $exitVector) = ($self->{NAV_STACK}[$self->{NAV_INDEX} - 1], $self->{NAV_STACK}[$self->{NAV_INDEX} + 1]);
	my $entryVector = $self->{NAV_INDEX} > 0                      ? $self->{NAV_STACK}[$self->{NAV_INDEX} - 1] : undef;
	my $exitVector  = $self->{NAV_INDEX} < $#{$self->{NAV_STACK}} ? $self->{NAV_STACK}[$self->{NAV_INDEX} + 1] : undef;
	my $vector = $top ? $subject : $object;
	my $lineColor = $entryVector eq $vector ? 'red' : $exitVector eq $vector ? 'green' : 'black';
	my $lineTag = $entryVector eq $vector ? 'nav_back' : $exitVector eq $vector ? 'nav_forward' : 'inert';
#	$graph->createOval(60,1, 140,31);
	my $xSubjCenter = ($fullScreen||!$top)?$X/2:$x;
	my $xPredCenter = ($fullScreen)?$X/2:$x;
	my $xObjCenter = ($fullScreen||$top)?$X/2:$x;
	# subject
	$graph->createText($xSubjCenter,$yTop, 
			   -justify => 'center', 
			   -text => $subjectShort, 
			   -fill => 'blue', 
			   -tags => ['node_'.$subject, 'stuff']);
	$graph->createLine($xSubjCenter,$yTop+$TS, $xPredCenter,$yMid-$TS, 
			   -tags => [$lineTag, 'stuff'], 
			   -fill => $lineColor);
	# predicate
	$graph->createText($xPredCenter,$yMid, 
			   -justify => 'left', 
			   -text => $predicateShort, 
			   -tags => ['triple_'.$text, 'stuff']);
	$graph->createLine($xPredCenter,$yMid+$TS, $xObjCenter,$yBot-$TS, 
			   -tags => [$lineTag, 'stuff'], 
			   -fill => $lineColor);
	# arrow
	$graph->createLine($xObjCenter-$AW,$yBot-$TS-$AH, $xObjCenter,$yBot-$TS, 
			   -tags => [$lineTag, 'stuff'], 
			   -fill => $lineColor);
	$graph->createLine($xObjCenter+$AW,$yBot-$TS-$AH-1, $xObjCenter,$yBot-$TS, 
			   -tags => [$lineTag, 'stuff'], 
			   -fill => $lineColor);
	# object
	$graph->createText($xObjCenter,$yBot, 
			   -justify => 'center', 
			   -text => $objectShort, 
			   -fill => 'blue', 
			   -tags => ['node_'.$object, 'stuff']);
#	$graph->createOval(60,170, 140,199);
	$x += $step;
	if (!$fullScreen) {
	    if ($top) {
		$yTop+=$TS;
	    } else {
		$yBot+=$TS;
	    }
	    $yMid+=$TS;
	}
    }
}

sub graphPick {
    my ($canvas, $self, $overrideCurrent) = @_;
    my $graph = $self->{GRAPH};
    my @current = $graph->gettags('current'); # || @{$self->{LAST_GRAPH_CURRENT}};
    @current = @$overrideCurrent if ($overrideCurrent);
    $self->{LAST_GRAPH_CURRENT} = \@current;
    return if ($current[0] !~ m/\A(triple|node|nav)_(.*)\Z/);
    if ($1 eq 'triple') {
	my $text = $2;
#	print $text.": ($x,$y) -> (".$canvas->canvasx($x).','.$canvas->canvasy($y).")\n";
	$self->findTriple($self->{BY_TEXT}{$text}->[0]);
    } elsif ($1 eq 'node') {
	my $node = $2;
#	print $node.": ($x,$y) -> (".$canvas->canvasx($x).','.$canvas->canvasy($y).")\n";
	# truncate and append NAV_STACK at     index      length (plus some extra)  new value
	splice (@{$self->{NAV_STACK}}, ++$self->{NAV_INDEX}, @{$self->{NAV_STACK}}, $node);
	$self->{LEFT}->configure(-state => 'active', -background => 'red') if ($self->{NAV_INDEX} != 0);
	$self->{RIGHT}->configure(-state => 'disabled', -background => 'grey');
	$self->renderNode($node);
    } elsif ($1 eq 'nav') {
	$self->nav($2 eq 'back');
    }
}

sub findTriple {
    my ($self, $index) = @_;
    my $lb = $self->{TRIPLE_LIST};
    $lb->selectionClear(0, 'end');
    $lb->selectionSet($index);
    $lb->see($index);
}

sub renderNode {
    my ($self, $node) = @_;
    my @triples;
    my $graph = $self->{GRAPH};
    $graph->delete('stuff');
    @triples = $self->{RDF_DB}->anyObjects(undef, [$node]);
    $self->renderTriples(\@triples, 0, 1);
    @triples = $self->{RDF_DB}->anySubjects(undef, [$node]);
    $self->renderTriples(\@triples, 0, 0);
}

sub nav {
    my ($self, $back) = @_;

    # update the nav_index and grey the arrows appropriately
    if ($back) {
	$self->{NAV_INDEX}--;
	$self->{LEFT}->configure(-state => 'disabled', -background => 'grey') if ($self->{NAV_INDEX} == 0);
	$self->{RIGHT}->configure(-state => 'active', -background => 'green');
    } else {
	$self->{NAV_INDEX}++;
	$self->{LEFT}->configure(-state => 'active', -background => 'red');
	$self->{RIGHT}->configure(-state => 'disabled', -background => 'grey') if ($self->{NAV_INDEX} == $#{$self->{NAV_STACK}});
    }

    # display node at resulting index in the nav stack
    $self->renderNode($self->{NAV_STACK}[$self->{NAV_INDEX}]);
}

sub show {
    my ($self, $prefix, $namespaceHandler) = @_; $prefix = '  ' if (!defined $prefix);
    my $ret = '';
    $ret .= $prefix.$self."\n";
    $ret .= $prefix.'RDF_PREFIX: '.$self->{RDF_PREFIX}."\n";
    $ret .= $prefix.'-sourceAttribution: '.$self->{-sourceAttribution}->dump."\n" if ($self->{-sourceAttribution});
#    $ret .= $prefix.'CURRENT_PROPERTY_ATTRIBUTION: '.$self->{CURRENT_PROPERTY_ATTRIBUTION}->dump."\n";
    $ret .= $prefix."NAMESPACES:\n";map {$ret .= $prefix.'  '.$_.': '.$self->{NAMESPACES}{$_}."\n"} keys %{$self->{NAMESPACES}};
    $ret .= $prefix."CONTAINERS:\n";map {$ret .= $self->{CONTAINERS}{$_}->show($prefix.'  ')} keys %{$self->{CONTAINERS}};
    $ret .= $prefix."ABOUT_EACH:\n";map {$ret .= $prefix.'  '.$_.': ('.join(',', @{$self->{ABOUT_EACH}{$_}}).")\n"} keys %{$self->{ABOUT_EACH}};
    $ret .= $prefix."ABOUT_EACH_PREFIX:\n";map {$ret .= $prefix.'  '.$_.': ('.join(',', @{$self->{ABOUT_EACH_PREFIX}{$_}}).")\n"} keys %{$self->{ABOUT_EACH_PREFIX}};
    $ret .= $prefix."TRIPLES:\n";
    $ret .= $self->showTriples($prefix.'  ', $namespaceHandler);
    return $ret;
}

1;


__END__

=head1 NAME

W3C::Database::TableVisualizer - PerlTk tool to view an DatabaseDB

=head1 SYNOPSIS

  use W3C::Database::DatabaseDB;
  use W3C::Database::TableVisualizer;
  my $DatabaseDB = new W3C::Database::DatabaseDB;
  my $TableVisualizer = new W3C::Database::TableVisualizer($DatabaseDB);
  my $desc = $DatabaseDB->addDescription(...);
  $desc->addPredicateObject($predicate, $object);
  $DatabaseDB->browse;

=head1 DESCRIPTION

TableVisualizer is a quick hack to prvide a Tk interface to browse the
triples in an DatabaseDB. It provides a list of triples and a canvas where
the user may click on a triple and explore the surrounding nodes. It's
also my first PerlTk app so if you notice something that may be awry,
assume it is.

This module is part of the W3C::Database CPAN module.

=head2 Hack

It's pricipal shortcoming is that I didn't use a defined interface to
NamespaceHandler and DatabaseDB but instead used their internal variables.

=head1 AUTHOR

Eric Prud\'hommeaux <eric@w3.org>

=head1 SEE ALSO

W3C::Database::DatabaseParser(3) perl(1).

=cut