#!/usr/bin/perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl zinc.t' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use Tk::Zinc; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): use Tk; $map_path = "/usr/share/toccata/maps"; $image_path = "/usr/share/toccata/images"; $mw = MainWindow->new; $logo = $mw->Photo(-file => "$image_path/logo.gif"); # $canvas = $mw->Canvas; # $canvas->pack(-expand => t, -fill => 'both'); # $text = $canvas->create('text', 30, 20, -width => 45, -text => "hello"); # @listOfList = $canvas->itemconfigure($text); # for (@listOfList) { # ($option, $name, $class, $default, $value) = @$_; # print "$option, $value\n"; # } # MainLoop; # exit; ################################################### # creation zinc ################################################### #$mw->Zinc()->pack; #MainLoop; exit; $top = 1; $zinc = $mw->Zinc(-backcolor => 'skyblue', -relief => 'sunken'); $zinc->pack(-expand => 't', -fill => 'both'); $zinc->configure(-width => 800, -height => 500); $color = $zinc->cget("-backcolor"); print "zinc backcolor=$color\n"; ################################################### # creation track ################################################### $track = $zinc->add("track", $top, 10); #$zinc->itemconfigure($track, -tags => 'toto'); $zinc->itemconfigure($track, -position => [1, 1]); $zinc->itemconfigure($track, -position => [10, 10]); $zinc->itemconfigure($track, -position => [20, 20]); $zinc->itemconfigure($track, -position => [30, 30]); $zinc->itemconfigure($track, -position => [40, 40]); $zinc->itemconfigure($track, -position => [50, 50]); $zinc->itemconfigure($track, -position => [60, 50]); $zinc->itemconfigure($track, -speedvector => [20, 0]); $zinc->itemconfigure($track, -symbolcolor => 'red', -labeldistance => 60); $zinc->itemconfigure($track, -markersize => 10, -filledmarker => 1, -markercolor => "green"); print "zinc itemconfigure :\n\n"; for $attr ($zinc->itemconfigure($track)) { print " ( ",join(',', @$attr)," )\n" ; } print "\n"; $size = $zinc->itemcget($track, -markersize); print "track markersize=$size\n"; (@coords) = $zinc->itemcget($track, "-position"); print "track position=",$coords[0],"+",$coords[1],"\n"; $zinc->itemconfigure($track, -labelformat => "x40x20+0+0 x40x20+40+0 x150x60+0+0"); $zinc->itemconfigure($track, 0, -filled => 1 , -backcolor => "red", -border => "contour"); $zinc->itemconfigure($track, 0, -text => "TO"); $zinc->itemconfigure($track, 1, -filled => 1 , -backcolor => "green", -border => "contour"); $zinc->itemconfigure($track, 1, -filled => 1 , -backcolor => "green", -border => "contour"); $zinc->itemconfigure($track, 2, -image => $logo , -alignment => "center"); #$mk = $zinc->itemcget($track, -markercolor); $zinc->itemconfigure($track, 0, -reliefthickness => 2, -relief => "sunken", -bordercolor => "red", -border => "noborder"); $zinc->bind($track.":speedvector", "", sub {$zinc->itemconfigure($track, -speedvectorcolor => 'red')}); $zinc->bind($track.":speedvector", "", sub {$zinc->itemconfigure($track, -speedvectorcolor => 'black')}); ################################################### # creation way point ################################################### print "creating way point\n"; my $wp = $zinc->add("waypoint", $top, 10); $zinc->itemconfigure($wp, -symbolcolor => "green", -position => [0, 80], -labelformat => "x40x20+0+0x40x20+40+0x80x40+0+0" ); $zinc->itemconfigure($wp, 0 ,-filled => 1 ,-backcolor => "tan",-text => "TO"); $zinc->itemconfigure($wp, 1 ,-filled => 1 ,-backcolor => "wheat",-text => "TO"); $zinc->itemconfigure($wp, 2 ,-border => "contour"); $zinc->bind($wp, "", \&borders); $zinc->bind($wp, "", [ \&borders, "off"]); ################################################### # creation 2nd track ################################################### print "creating second track\n"; $track2 = $zinc->add("track", $top, 10, -speedvector => [-20, 0], -position => [0, 50]); $zinc->itemconfigure($track2, -connecteditem => $track); ################################################### # creation macro ################################################### print "creating macro\n"; $macro = $zinc->add("tabular", $top, 10, -labelformat => "x40x20+0+0 x40x20+40+0" ); $zinc->itemconfigure($macro, 0 , -text => "une"); $zinc->itemconfigure($macro, 1, -text => "macro"); $zinc->itemconfigure($macro, -connecteditem => $track); $zinc->bind($macro.":0", "", [ \&borders, "on"]); $zinc->bind($macro.":0", "", [ \&borders, "off"]); ################################################### # creation ministrip ################################################### print "creating ministrip\n"; $ministrip = $zinc->add("tabular", $top, 10, -labelformat => "x40x20+0+0 x40x20+40+0", -position => [100, 10] ); $zinc->itemconfigure($ministrip, 0 , -text => 'ministrip'); ################################################### # creation map ################################################### print "creating map\n"; $mw->videomap("load", "$map_path/videomap_paris-w_90_2", 0, "paris-w"); $mw->videomap("load", "$map_path/videomap_orly", 17, "orly"); $mw->videomap("load", "$map_path/hegias_parouest_TE.vid", 0, "paris-ouest"); print "videomap ids : ", join('|', $mw->videomap("ids", "$map_path/videomap_orly")),"\n"; $map = $zinc->add("map", $top, -color => 'red'); $zinc->itemconfigure($map,-mapinfo => 'orly'); #$map2 = $zinc->add("map", $top, -color => 'green', -filled => 1, -priority => 0, # -fillpattern => AlphaStipple6); #$zinc->itemconfigure($map2, -mapinfo => 'paris-ouest'); $map3 = $zinc->add("map", $top, -color => 'orange'); $zinc->itemconfigure($map3,-mapinfo => "paris-w"); ################################################### #creation rectangle, arc, curve ################################################### $rect = $zinc->add('rectangle', $top, [-50, -50, 50, -80], -linecolor => 'bisque'); $zinc->bind($rect, '', sub { $zinc->itemconfigure($rect, -linecolor => 'red')}); $zinc->bind($rect, '', sub { $zinc->itemconfigure($rect, -linecolor => 'bisque')}); $arc = $zinc->add('arc', $top, [-100, 80, -50, 30], -linecolor => 'bisque', -tags => ["arc"]); #$zinc->addtag("fleche",'withtag', $arc); #$zinc->addtag("carquois",'withtag', $arc); $zinc->add('rectangle', $top, [-101, 81, -49, 29], -linecolor => 'green'); $zinc->raise($arc); $zinc->bind($arc, '', sub {$zinc->itemconfigure($arc, -linecolor => 'red')}); $zinc->bind($arc, '', sub {$zinc->itemconfigure($arc, -linecolor => 'bisque')}); print "arc tags=", join('|',$zinc->gettags($arc)),"\n"; $zinc->itemconfigure($arc, -startangle => 0, -extent => 360); $mp = $zinc->add('curve', $top, [-300, 0, -250, 100, -80, 20]); $zinc->itemconfigure($mp, -filled => 1, -linewidth => 4, -linecolor => 'yellow', -fillcolor => 'tan', -fillpattern => AlphaStipple8); $zinc->itemconfigure($mp, -marker => AtcSymbol9 , -markercolor => 'red'); ################################################### # Map info ################################################### $mw->mapinfo('mpessai', 'create'); $mw->mapinfo('mpessai', 'add', 'text', 'normal', 'simple', 0, 200, "Et voilą"); $mw->mapinfo('mpessai', 'add', 'line', 'simple', 0, 0, 0, 0, 200); #$mw->mapinfo('mpessai', 'add', 'line', 'simple', 5, -100, 100, 0, 0); $zinc->itemconfigure($map3, -mapinfo => 'mpessai'); print "mapinfo count line : ", $mw->mapinfo('mpessai', 'count', 'line'),"\n"; print "mapinfo get line 3: ", join('|',$mw->mapinfo('mpessai', 'get', 'line', 0)),"\n"; ################################################### # tests diverses methodes ################################################### for ($zinc->find('all')) { print $_, " -> ", $zinc->type($_),"\n"; } $zinc->Tk::bind("<2>", [sub { print $_[1], "@" ,$_[2], ", closest: ", join(' ',$zinc->find('closest', $_[1], $_[2])),"\n"; }, Ev('x'), Ev('y')]); $zinc->Tk::bind('', [ sub {($origx, $origy) = ($_[1], $_[2]); }, Ev('x'), Ev('y') ]); $zinc->Tk::bind('', [ sub {&finditems($_[1], $_[2]); }, Ev('x'), Ev('y') ]); $zinc->Tk::bind("<2>", sub {$zinc->translate($top, 10,10); }); $zinc->Tk::bind("<3>", sub {$zinc->scale($top, 1.1, 1.1); }); MainLoop; sub borders { my($widget, $onoff) = @_; $onoff = "on" unless $onoff; my $part = $zinc->currentpart; my $contour = "noborder"; $contour = "contour" if ($onoff eq 'on'); $zinc->itemconfigure('current', $part, -border => $contour) if ($part >= 0); } sub finditems { my($cornerx, $cornery) = @_; print "--- enclosed --->", join('|', $zinc->find('enclosed',$origx, $origy, $cornerx, $cornery)),"\n"; print "--- overlapping --->", join('|',$zinc->find('overlapping',$origx, $origy, $cornerx, $cornery)),"\n\n"; } 1;