#!/usr/bin/perl use warnings; use strict; use Tk; require Tk::DialogBox; # right click on the canvas to pop a dialog # to get text, the text will be placed on the canvas where you # clicked, and will be draggable to desired position. # canvases can be saved as postscript, then converted to # whatever you want. my $dx; my $dy; my $current; my $mw = MainWindow->new; $mw->geometry("700x600"); $mw->fontCreate('big', -family=>'arial', -weight=>'bold', -size=>int(-18*18/14)); my $canvas = $mw->Canvas(-width => 700, -height => 565, -bg => 'black', -borderwidth => 3, -relief => 'sunken', )->pack; my $closebutton = $mw->Button(-text => 'Exit', -command => sub{Tk::exit(0)}) ->pack; my $dialog = $mw->DialogBox( -buttons => [qw/Ok Cancel/], -title => "Enter Text" ); my $dialogT = $dialog->add("Text"); $dialogT->pack(qw/-padx 10 -pady 10/); $canvas->bind('move', '<1>', sub {&mobileStart();}); $canvas->bind('move', '', sub {&mobileMove();}); $canvas->bind('move', '', sub {&mobileStop();}); #right click to post text $canvas->Tk::bind("", [\&getText, Ev('x'), Ev('y') ]); MainLoop; sub getText { # print "@_\n"; my ($canv, $x, $y) = @_; my $x1 = $canv->canvasx($x); my $y1 = $canv->canvasx($y); print "$x1 $y1\n"; $dialog->configure(-focus => $dialogT); $dialog->bind('' => undef); ## Determine whether or not the user hit "Ok" my $button = $dialog->Show(); if ( $button eq "Ok" ) { my $letters = $dialogT->get( '1.0', 'end' ); #print "$letters was submitted\n"; $dialogT->delete( '1.0', 'end' ); my $dragster = $canvas->createText( $x1, $y1, -fill => 'red', -tags => ['move'], -text => $letters, -font => 'big', -anchor => 'nw', ); $current = $dragster; } } sub mobileStart { my $ev = $canvas->XEvent; ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); $canvas->raise('current'); print "START MOVE-> $dx $dy\n"; } sub mobileMove { my $ev = $canvas->XEvent; $canvas->move('current', $ev->x + $dx, $ev->y +$dy); ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); print "MOVING-> $dx $dy\n"; } sub mobileStop{ $canvas->dtag($current,'move'); } __END__