view release on metacpan or  search on metacpan

lib/CAD/Drawing/IO/Tk.pm  view on Meta::CPAN

=head2 tkbindings

Setup the keybindings.

  $drw->tkbindings($mw, $cnv);

=cut
sub tkbindings {
	my $self = shift;
	my ($mw, $cnv, $stl) = @_;
	# FIXME: this should be much more robust

# maybe a vim-style modal binding? or possibly a command-line based
# system.
# just bind ":" to switch to the command bindings and <Esc> to go back
# to visual mode (and the end of every command must go to visual mode.)

	# this one basically means 'focusFollowsMouse', which is evil.
	# $mw->bind('<Any-Enter>' => sub{ $cnv->Tk::focus});

#    $mw->bind('<q>' => sub{$mw->destroy});
#    $cnv->CanvasBind('<q>' => sub{print "called\n";exit;});
	$mw->bind('<q>' => sub {$mw->destroy});

	# XXX move this...
	# middle-button pan:
	my @pan_start;
	my $drag_current;
	$cnv->CanvasBind(
		'<ButtonPress-2>' => sub {
			@pan_start = $cnv->eventLocation();
#            print "starting pan at @pan_start\n";
		});
	# have to have this here to prevent spurious panning with double-clicks
	$cnv->CanvasBind('<B2-Motion>' => sub {$drag_current = 1});
	$cnv->CanvasBind(
		'<ButtonRelease-2>' => sub {
			$drag_current || return();
			my @pan_stop = $cnv->eventLocation();
			my $scale = $cnv->pixelSize();
#            print "\tdouble: $isdouble\n";
#            print "\tdrag: $drag_current\n";
#            print "scale is $scale\n";
#            print "stopping pan at @pan_stop\n";
			my @diff = map({$pan_start[$_] - $pan_stop[$_]} 0,1);
#            my $panx = abs($diff[0])/$scale;
#            my $pany = abs($diff[1])/$scale;
#            print "pixels: ($panx,$pany)\n";
#            my $dopan = ( $panx > 10) | ( $pany > 10);
#            $dopan && print "panning by @diff\n";
#            $dopan && $cnv->panWorld(@diff);
			$cnv->panWorld(@diff);
			$drag_current = 0;
		});
	
	# OKAY, so we've got 4 zoom actions and we don't get text or images
	# for free.

	# this takes away all of our fun of having sizable texts (hmm. I
	# guess we could create this font from anywhere?)
	
	# XXX this is going to have some odd behaviour for now, but it isn't
	# worth trying to make a word-processor widget behave like scalable
	# text.
	$textsize = $text_base;
	$cnv->fontCreate(
			'cad-drawing-font',
			-family => 'lucidasans',
			-size   => $textsize,
			);
	text_size_reset($cnv);
#    print "view is @coords\n";
#    print "other configs:\n", 
#        join("\n", map({join(" ", @$_ )} $cnv->configure())), "\n";
#    print "width is: ", $cnv->cget(-width), "\n";
	
	# mouse-wheel zooming:
	$cnv->CanvasBind('<Button-4>' => sub{
				$cnv->zoom(1.125);
				text_size_reset($cnv);
				# print "$textsize\n";
				if(0) {
					package Tk::WorldCanvas;
					my $pdata = $cnv->privateData();
					print "pdata: $pdata\n";
					foreach my $key (keys(%$pdata)) {
						print "$key: $pdata->{$key}\n";
					}
					print "size is now $pdata->{width} x $pdata->{height}\n";
				}

			}
			);
	$cnv->CanvasBind('<Button-5>' => sub{
				$cnv->zoom(1/1.125);
				text_size_reset($cnv);
			}
			);
	# zoom extents:
	$cnv->CanvasBind('<Double-Button-2>' => sub{
				$cnv->viewAll();
				text_size_reset($cnv);
			}
			);
	# zoom window:
	$mw->bind(
		'<z>' => sub {
			$stl->configure(-text=>"Pick window corners");
			windowzoom($cnv, $stl);
			});
	# measure:
	$mw->bind(
		'<m>' => sub {
			$stl->configure(-text=>"Pick ends");
			free_dist($cnv, $stl);
			});


} # end subroutine tkbindings definition
########################################################################