diff options
Diffstat (limited to 'Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl')
| -rw-r--r-- | Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl | 67 |
1 files changed, 24 insertions, 43 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl b/Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl index c872f82..6b4e86a 100644 --- a/Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl +++ b/Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl @@ -13,23 +13,6 @@ my $mw = MainWindow->new(); ########################################### -# Text zone -########################################### - -my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true - -height 6 -scrollbars e/); -$text->pack(qw/-expand yes -fill both/); - -$text->insert('0.0', - 'This toy-appli shows some interactions on different parts of a flight track item. -The following operations are possible: - Drag Button 1 on the track to move it. - Please Note the position history (past positions) - Enter/Leave flight label fields - Enter/Leave the speedvector, symbol (i.e. current position), label leader' ); - - -########################################### # Zinc ########################################### my $zinc_width=600; @@ -39,6 +22,18 @@ my $zinc = $mw->Zinc(-width => $zinc_width, -height => $zinc_height, -borderwidth => 3, -relief => 'sunken', )->pack; +# The explanation displayed when running this demo +$zinc->add('text', 1, + -position=> [10,10], + -text => 'This toy-appli shows some interactions on different parts of a flight track item. +The following operations are possible: + - Drag Button 1 on the track to move it. + Please Note the position history (past positions) + - Enter/Leave flight label fields + - Enter/Leave the speedvector, symbol (i.e. current position), label leader', + -font => "9x15", + ); + ########################################### # Track ########################################### @@ -50,9 +45,9 @@ my $labelformat = "x80x60+0+0 x60a0^0^0 x30a0^0>1 a0a0>2>1 x30a0>3>1 a0a0^0>2"; my $x=250; my $y=200; my $track=$zinc->add('track', 1, 6, # 6 is the number of field in the flightlabel - -labelformat => $labelformat, - -position => [$x, $y],#position of the marker - -speedvector => [30, -15],#ccords of the speed vector + -labelformat => $labelformat, + -position => [$x, $y],#position of the marker + -speedvector => [30, -15],#ccords of the speed vector -markersize => 10, ); # moving the track, to display past positions @@ -218,28 +213,14 @@ $zinc->bind("$track:leader", ); }); -# $zinc->bind("$track:marker", -# '<Enter>', -# sub { $zinc->itemconfigure("$track", -# -markercolor=>"red", -# ); -# }); -# -# $zinc->bind("$track:marker", -# '<Leave>', -# sub { $zinc->itemconfigure("$track", -# -markercolor=>"black", -# ); -# }); - #--------------------------------------------- # Drag and drop the track #--------------------------------------------- #Binding to ButtonPress event -> "move_on" state# -$zinc -> bind("$track",'<ButtonPress-1>'=>[sub{ - select_color_on(); #change the color - move_on($_[1],$_[2]); #"move_on" state - },Ev('x'),Ev('y')]); +$zinc -> bind("$track",'<ButtonPress-1>'=>[ sub { select_color_on(); #change the color + move_on(Tk::Ev('x'),Tk::Ev('y')); #"move_on" state + } + ]); #"move_on" state# @@ -252,7 +233,7 @@ sub move_on{ [sub{move($xi,$yi,$_[1],$_[2]); #move the track $xi=$_[1]; $yi=$_[2]; - },Ev('x'),Ev('y')]); + },Tk::Ev('x'),Tk::Ev('y')]); #Binding to ButtonRelease event -> "move_off" state# $zinc -> bind("$track",'<ButtonRelease-1>'=>sub{select_color_off(); #change the color move_off();}); #"move_off" state @@ -261,10 +242,10 @@ sub move_on{ #"move_off" state# sub move_off{ #Binding to ButtonPress event -> "move_on" state# - $zinc -> bind("$track",'<ButtonPress-1>'=>[sub{ - select_color_on(); #change the color - move_on($_[1],$_[2]); #"move_on" state - },Ev('x'),Ev('y')]); + $zinc -> bind("$track",'<ButtonPress-1>'=>[sub { select_color_on(); #change the color + move_on(Tk::Ev('x'),Tk::Ev('y')) + } + ]); #Motion event not allowed on track $zinc -> bind("$track",'<Motion>'=>""); |