#!/usr/bin/perl # $Id: simple_interaction_track.pl,v 1.5 2003/09/15 12:25:05 mertz Exp $ # This simple demo has been developped by C. Schlienger package simple_interaction_track; # for avoiding symbol collision between different demos use vars qw( $VERSION ); ($VERSION) = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/); use Tk; use Tk::Zinc; use strict; my $mw = MainWindow->new(); ########################################### # Zinc ########################################### my $zinc_width=600; my $zinc_height=500; my $zinc = $mw->Zinc(-width => $zinc_width, -height => $zinc_height, -font => "10x20", -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, or leader', -font => "9x15", ); ########################################### # Track ########################################### #the label format (6 formats for 6 fields)# my $labelformat = "x80x60+0+0 x60a0^0^0 x30a0^0>1 a0a0>2>1 x30a0>3>1 a0a0^0>2"; #the track# 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 -markersize => 10, ); # moving the track, to display past positions foreach my $i (0..5) { $zinc->coords($track,[$x+$i*10,$y-$i*5]); } #fields of the label# $zinc->itemconfigure($track, 0,#configuration of field 0 of the label -filled => 0, -bordercolor => 'DarkGreen', -border => "contour", ); $zinc->itemconfigure($track, 1, -filled => 1, -backcolor => 'gray60', -text => "AFR6128"); $zinc->itemconfigure($track, 2, -filled => 0, -backcolor => 'gray65', -text => "390"); $zinc->itemconfigure($track, 3, -filled => 0, -backcolor => 'gray65', -text => "/"); $zinc->itemconfigure($track, 4, -filled => 0, -backcolor => 'gray65', -text => "350"); $zinc->itemconfigure($track, 5, -filled => 0, -backcolor => 'gray65', -text => "TUR"); ########################################### # Events on the track ########################################### #--------------------------------------------- # Enter/Leave a field of the label of the track #--------------------------------------------- foreach my $field (0..5) { #Entering the field $field higlights it# $zinc->bind("$track:$field", '', sub { if ($field==0){ higlight_label_on(); # print "CP=", $zinc->currentpart, "\n"; } else{ highlight_fields_on($field); # print "CP=", $zinc->currentpart, "\n"; } }); #Leaving the field cancels the highlight of $field# $zinc->bind("$track:$field", '', sub { if($field==0){ higlight_label_off(); } else{ if ($field==1){ highlight_field1_off(); } else{ highlight_other_fields_off($field); } } }); } #fonction# sub higlight_label_on{ $zinc->itemconfigure('current', 0, -filled => 0, -bordercolor => 'red', -border => "contour", ); } sub higlight_label_off{ $zinc->itemconfigure('current', 0, -filled => 0, -bordercolor => 'DarkGreen', -border => "contour", ); } sub highlight_fields_on{ my $field=$_[0]; $zinc->itemconfigure('current', $field, -border => 'contour', -filled => 1, -color => 'white' ); } sub highlight_field1_off{ $zinc->itemconfigure('current', 1, -border => '', -filled => 1, -color => 'black', -backcolor => 'gray60' ); } sub highlight_other_fields_off{ my $field=$_[0]; $zinc->itemconfigure('current', $field, -border => '', -filled => 0, -color => 'black', -backcolor => 'gray65' ); } #--------------------------------------------- # Enter/Leave other parts of the track #--------------------------------------------- $zinc->bind("$track:position", '', sub { $zinc->itemconfigure($track, -symbolcolor=>"red", ); # print "CP=", $zinc->currentpart, "\n"; }); $zinc->bind("$track:position", '', sub { $zinc->itemconfigure($track, -symbolcolor=>"black", ); }); $zinc->bind("$track:speedvector", '', sub { $zinc->itemconfigure($track, -speedvectorcolor=>"red", ); }); $zinc->bind("$track:speedvector", '', sub { $zinc->itemconfigure($track, -speedvectorcolor=>"black", ); }); $zinc->bind("$track:leader", '', sub { $zinc->itemconfigure($track, -leadercolor=>"red", ); }); $zinc->bind("$track:leader", '', sub { $zinc->itemconfigure($track, -leadercolor=>"black", ); }); #--------------------------------------------- # Drag and drop the track #--------------------------------------------- #Binding to ButtonPress event -> "move_on" state# $zinc -> bind($track,''=>[ sub { &select_color_on(); #change the color &move_on($_[1],$_[2]); #"move_on" state }, Tk::Ev('x'),Tk::Ev('y') ]); #Binding to ButtonRelease event -> "move_off" state# $zinc -> bind($track,''=>sub{&select_color_off(); #change the color &move_off();}); #"move_off" state #"move_on" state# sub move_on{ my ($xi,$yi)=@_; #Binding to Motion event -> move the track# $zinc -> bind($track,''=> [sub{move($xi,$yi,$_[1],$_[2]); #move the track $xi=$_[1]; $yi=$_[2]; },Tk::Ev('x'),Tk::Ev('y')]); } #"move_off" state# sub move_off{ #Motion event not allowed on track $zinc -> bind($track,''=>""); } #move the track# sub move{ my ($xi,$yi,$x,$y)=@_; select_color_on(); my @coords=$zinc->coords($track); $zinc->coords($track,[$coords[0]+$x-$xi,$coords[1]+$y-$yi]); } sub select_color_on{ $zinc->itemconfigure($track, -speedvectorcolor=>"white", -markercolor=>"white", -leadercolor=>"white" ); } sub select_color_off{ $zinc->itemconfigure($track, -speedvectorcolor=>"black", -markercolor=>"black", -leadercolor=>"black" ); } Tk::MainLoop;