#!/usr/local/bin/perl -w
use strict;
use Tk;

my $fw_font  = "-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*";

use Tk;
require Tk::Ghostview;

use strict qw(subs);

sub usage_death {
 print STDERR "usage: pgs <filename>\n";
 exit 1;
}

$ARGV[0] or usage_death();
(@ARGV == 1) or usage_death();

my $top = MainWindow->new();
my $gs  = $top->Ghostview(-file => $ARGV[0]);
my $f = $top->Frame();
my $l = $top->ScrlListbox('-width' => $gs->Doc->{'LabelLen'});
$l->bind('<Double-1>',[sub { shift; shift->SetPage(@_) },$gs,Ev('index','active')]);
$l->insert("end",@{$gs->Doc->{'Label'}});
$f->Button('-text'=>'Quit','-command'=>['destroy',$top])->pack('-side'=>'left');
$f->pack('-side'=>'top','-fill'=>'x');
$l->pack('-side'=>'left','-fill'=>'y');

my $mb = $f->Menubutton('-text'=>'Contents');

my $contents = $gs->Doc->Contents;
my $kind;
foreach $kind (sort keys %{$contents})
 {
  if ($kind !~ /#[LT]len$/)
   {
    Contents($mb,$kind,$contents->{$kind},
             $contents->{$kind.'#Llen'},
             $contents->{$kind.'#Tlen'},
             $gs);
   }
 }
$mb->pack('-side'=>'right');

$mb = $f->Optionmenu('-text'=>'Orientation',-options => [qw(Portrait Landscape Upsidedown Seascape)],
                     -command => [$gs,'Orientation']);

$mb->pack('-side'=>'right');

$gs->pack('-expand'=>'yes','-fill'=>'both');

$gs->update;
$gs->focus;

MainLoop;

sub Contents
{
 my ($mb,$kind,$it,$lw,$tw,$gs) = @_;
 my $base = $mb->toplevel;
 my $top  = $base->Toplevel(-popover => $base, -popanchor => 'nw', 
                   -overanchor => 'ne');
 $top->withdraw;
 $top->title($kind);
 $top->transient($base);
 $top->protocol('WM_DELETE_WINDOW',['withdraw',$top]);
 my $lb = $top->Scrolled('Listbox','-width' => $lw+$tw,'-font' => $fw_font);
 $top->Label('-text'=>$kind)->pack('-side'=>'top');
 $lb->insert('end',map(sprintf("%-${lw}s %s",${$_}[0],${$_}[1]),@$it));
 $lb->pack('-side'=>'right','-fill'=>'y');
 $mb->command('-label'=>$kind,'-command'=>['Popup',$top]);
 $lb->bind('<Double-1>',[\&DoContent,$it,$gs]);
}

sub DoContent
{
 my ($lb,$it,$gs) = @_;
 my $key = $lb->index('active');
 my $page = ${$it}[$key][2];
 $gs->SetPage($page);
}


