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

use English;
use Tk;

$font = "10x20";
%fonts = ('Small Fixed' => '6x13',
	  'Medium Times' => '-Adobe-times-medium-r-normal--*-180-*-*-*-*-*-*',
	  );


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

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

$textentry->bind("<Return>" => \&addtext);
$textentry->bind("<Shift-KeyPress>" => sub { print "*", join("=", keys %{$ARG[0]}), "*\n"; print ${$ARG[0]->XEvent}, "\n" });
$textentry->pack(-side => 'top',
		 -padx => 10,
		 -pady => 5,
		 -fill => 'y');

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

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

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

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

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

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


# View Window

my $win = MainWindow->new;

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

$canvas->pack();

$c = $canvas;

$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 {
    $c->create(qw(text 1i 1i), 
	       -text => $text,
	       -font => $font,
	       -tags => item);
    $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;