#!/afs/athena/contrib/perl5/perl

use English;
use Tk;

#$font = "-Adobe-times-medium-r-normal-";
%fonts = ('Symbol', '-*-symbol-*-*-*-*-',
	  'Times' => '-*-times-*-*-*-*-',
	  'Tymes' => '-*-tymes-*-*-*-*-',
	  'Generic' => '-*-*-*-*-*-',
	  );

@sizes = (10, 12, 18, 24, 36, 48, 60, 72, 100);


# Control Window
my $newtext = MainWindow->new();

my $f1 = $newtext->Frame;
my $f2 = $newtext->Frame;

my $textentry = $f1->Entry(-textvariable => \$text);

$textentry->bind("<Return>" => \&addtext);
$textentry->pack(-side => 'left',
		 -padx => 10,
		 -pady => 5,
		 -fill => 'y');

my $but = $f1->Button(-text => 'Add',
			   -command => \&addtext);

$but->pack(-side => "right");

my $f3 = $f2->Frame;
my $f4 = $f2->Frame;
$f3->pack(-side => top);
$f4->pack(-side => bottom);

$sb = $f3->Scrollbar;
$sb->pack(-side => 'left',
	  -fill => 'y');

$lb = $f3->Listbox(-yscrollcommand => [$sb => 'set'],
			-width          => 20,
			-height         => 3,
			);
$lb->pack();
$sb->configure(-command => [$lb => 'yview']);

#$lb->bind("<1>" => sub { $font_a = $fonts{$_[0]->get('active')};});

$lb->insert(0, keys %fonts);

$ssb = $f4->Scrollbar;
$ssb->pack(-side => 'left',
	  -fill => 'y');

$slb= $f4->Listbox(-yscrollcommand => [$ssb => 'set'],
			-width          => 20,
			-height         => 3,
			);
$slb->pack();
$ssb->configure(-command => [$slb => 'yview']);

#$slb->bind("<1>" => sub { $font_b = $_[0]->get('active');});

$slb->insert(0, @sizes);

$f1->pack(-side => top);
$f2->pack(-side => bottom);

# View Window

my $win = MainWindow->new;

my $canvas = $win->Canvas(-height => "11i",
			  -width => "8.5i");

$canvas->pack();

$c = $canvas;

$c->Tk::bind("<3>" => \&printme);

sub printme {
    $canvas->postscript(-file => "/tmp/pic.ps", -fontmap => \%fm);
}

$canvas->create(qw(line 0.2i 0.7i 1.5i 1.4i -tags item));
    $canvas->bind('item', '<Any-Enter>' => [\&items_enter, \%iinfo]);
    $canvas->bind('item', '<Any-Leave>' => [\&items_leave, \%iinfo]);
    $canvas->Tk::bind('<1>' => sub {
	my($c) = @ARG;
        my $e = $c->XEvent;
	&items_start_drag( $c, $e->x, $e->y, \%iinfo);
    });
    $canvas->Tk::bind('<B1-Motion>' => sub {
	my($c) = @ARG;
        my $e = $c->XEvent;
	&items_drag( $c, $e->x, $e->y, \%iinfo);
    });

sub addtext {
    print("Lbcurselection: ", $slb->curselection, "\n");
    $font_a = $fonts{$lb->get($lb->curselection, 0)};
    $font_b = $fonts{$slb->get($slb->curselection,0)};
    $it = $c->create(qw(text 1i 1i), 
	       -text => $text,
	       -font => $font_a.$font_b."-*-*-*-*-*-*-*",
	       -tags => item);
    $fm{$font_a.$font_b."-*-*-*-*-*-*-*"} = "Times-Roman";
    print("Created item $it\n");
    $text = "";
}

sub items_drag {

    my($c, $x, $y, $iinfo) = @ARG;

    $x = $c->canvasx($x);
    $y = $c->canvasy($y);
    $c->move('current', $x-$iinfo->{'lastX'}, $y-$iinfo->{'lastY'});
    $iinfo->{'lastX'} = $x;
    $iinfo->{'lastY'} = $y;

} # end items_drag
sub items_start_drag {

    my($c, $x, $y, $iinfo) = @ARG;

    $iinfo->{'lastX'} = $c->canvasx($x);
    $iinfo->{'lastY'} = $c->canvasy($y);

} # end items_start_drag

sub items_enter {

    my($c, $iinfo) = @ARG;

    $iinfo->{'restore_cmd'} = '';

    if ($win->depth == 1) {
	$iinfo->{'restore_cmd'} = '';
	return;
    }
    my $type = $c->type('current');
    if ($type eq 'window') {
	$iinfo->{'restore_cmd'} = '';
	return;
    }

    if ($type eq 'bitmap') {
	my $bg = ($c->itemconfigure('current', -background))[4];
	if (defined $bg) {
	    $iinfo->{'restore_cmd'} = "\$c->itemconfigure('current',
                -background => '$bg');";
	} else {
	    $iinfo->{'restore_cmd'} = "\$c->itemconfigure('current',
                -background => undef);";
	}
	$c->itemconfigure('current', -background => 'SteelBlue2');
	return;
    }
    my $fill = ($c->itemconfigure('current', -fill))[4];
    if (($type eq 'rectangle' or $type eq 'oval' or $type eq 'arc')
	    and not defined $fill) {
	my $outline = ($c->itemconfigure('current', -outline))[4];
	$iinfo->{'restore_cmd'} = "\$c->itemconfigure('current',
            -outline => '$outline')";
	$c->itemconfigure('current', -outline => 'SteelBlue2');
    } else {
	$iinfo->{'restore_cmd'} = "\$c->itemconfigure('current',
            -fill => '$fill')";
	$c->itemconfigure('current', -fill => 'SteelBlue2');
    }

} # end items_enter
sub items_leave {

    my($c, $iinfo) = @ARG;

    eval $iinfo->{'restore_cmd'};

} # end items_leave

MainLoop;