diff options
| -rw-r--r-- | Perl/Makefile.PL | 18 | ||||
| -rw-r--r-- | Perl/Zinc.pm | 41 | ||||
| -rw-r--r-- | Perl/Zinc.xs | 53 | ||||
| -rw-r--r-- | Perl/t/zinc.t | 222 |
4 files changed, 334 insertions, 0 deletions
diff --git a/Perl/Makefile.PL b/Perl/Makefile.PL new file mode 100644 index 0000000..c453a5b --- /dev/null +++ b/Perl/Makefile.PL @@ -0,0 +1,18 @@ + +use Tk::MMutil; +use Tk::Config; + +Tk::MMutil::TkExtMakefile( + 'NAME' => 'Tk::Radar', + 'OBJECT' => '$(O_FILES)', + 'MYEXTLIB' => '../libptkradar.a', + 'VERSION_FROM' => 'Radar.pm', + 'XS_VERSION' => $Tk::Config::VERSION, + 'INC' => "-I. -I/usr/lib/perl5/i386-linux/5.004/Tk/pTk", + 'LIBS' => '-L/usr/X11R6/lib -lX11' +); + + + + + diff --git a/Perl/Zinc.pm b/Perl/Zinc.pm new file mode 100644 index 0000000..7b1a9db --- /dev/null +++ b/Perl/Zinc.pm @@ -0,0 +1,41 @@ +package Tk::Radar; + +#require Tk; +use Tk; +#use AutoLoader; +#use Exporter; + +use base qw(Tk::Widget); +Construct Tk::Widget 'Radar'; + + +use vars qw($VERSION); +$VERSION = '1.000'; + +bootstrap Tk::Radar $Tk::VERSION; + +sub Tk_cmd { \&Tk::radar } + +Tk::Methods("add","addtag","bbox","bind","class","cget","configure","currentpart", + "dtag","find","gettags","hasfields","hasparts","hastag","itemcget", + "itemconfigure","lower","overlapmethod","raise","remove","scale", + "translate","worldcoords"); + +#use Tk::Submethods ( 'create' => [qw(arc bitmap image line oval +# polygon rectangle text window)], +# 'scan' => [qw(mark dragto)], +# 'select' => [qw(from clear item to)], +# ); + +# *CanvasBind = \&Tk::bind; +# *CanvasFocus = \&Tk::focus; + +# sub ClassInit +# { +# my ($class,$mw) = @_; +# $mw->XYscrollBind($class); +# return $class; +# } + +1; +__END__ diff --git a/Perl/Zinc.xs b/Perl/Zinc.xs new file mode 100644 index 0000000..02df3c1 --- /dev/null +++ b/Perl/Zinc.xs @@ -0,0 +1,53 @@ +/* + Copyright (c) 1995-1997 Nick Ing-Simmons. All rights reserved. + This program is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. +*/ + +#include <EXTERN.h> +#include <perl.h> +#include <XSUB.h> + +#include "tkGlue.def" + +#include "pTk/tkPort.h" +#include "pTk/tkInt.h" +#include "pTk/tkVMacro.h" +#include "tkGlue.h" +#include "tkGlue.m" + +extern int +RadarCmd( + ClientData client_data, + Tcl_Interp* interp, + int argc, + Arg* args ); + +extern int +VideomapCmd( + ClientData client_data, + Tcl_Interp* interp, + int argc, + Arg* args ); + +extern int +MapInfoCmd( + ClientData client_data, + Tcl_Interp* interp, + int argc, + Arg* args ); + +DECLARE_VTABLES; + + +MODULE = Tk::Radar PACKAGE = Tk::Radar + +PROTOTYPES: DISABLE + +BOOT: + { + IMPORT_VTABLES; + Lang_TkCommand("radar", RadarCmd); + Lang_TkCommand("videomap", VideomapCmd); + Lang_TkCommand("mapinfo", MapInfoCmd); + } diff --git a/Perl/t/zinc.t b/Perl/t/zinc.t new file mode 100644 index 0000000..41c3637 --- /dev/null +++ b/Perl/t/zinc.t @@ -0,0 +1,222 @@ +#!/usr/bin/perl + +use Tk; + +$mw = MainWindow->new; +$logo = $mw->Photo(-file => "/home/etienne/images/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 radar +################################################### + +#$mw->Radar()->pack; +#MainLoop; exit; +$radar = $mw->Radar(-backcolor => 'skyblue', -relief => 'sunken'); +$radar->pack(-expand => t, -fill => 'both'); + +$radar->configure(-width => 800, -height => 500); +$color = $radar->cget("-backcolor"); print "radar backcolor=$color\n"; + +################################################### +# creation track +################################################### +$track = $radar->add("track", 10); +#$radar->itemconfigure($track, -tags => 'toto'); + +$radar->itemconfigure($track, -position => [1, 1]); +$radar->itemconfigure($track, -position => [10, 10]); +$radar->itemconfigure($track, -position => [20, 20]); +$radar->itemconfigure($track, -position => [30, 30]); +$radar->itemconfigure($track, -position => [40, 40]); +$radar->itemconfigure($track, -position => [50, 50]); +$radar->itemconfigure($track, -position => [60, 50]); +$radar->itemconfigure($track, -speedvector => [20, 0]); +$radar->itemconfigure($track, -symbolcolor => 'red', -labeldistance => 60); +$radar->itemconfigure($track, -markersize => 10, -filledmarker => 1, + -markercolor => "green"); + +print "radar itemconfigure :\n\n"; +for $attr ($radar->itemconfigure($track)) { + print " ( ",join(',', @$attr)," )\n" ; +} +print "\n"; + +$size = $radar->itemcget($track, -markersize); print "track markersize=$size\n"; +(@coords) = $radar->itemcget($track, "-position"); +print "track position=",$coords[0],"+",$coords[1],"\n"; + + +$radar->itemconfigure($track, -labelformat => + "150x60|40+20|40+20|40+20,0:40x20+0+0,1:40x20+40+0,2:150x60+0+0"); + +$radar->itemconfigure($track, 0, -filled => 1 , -backcolor => "red", + -border => "contour"); +$radar->itemconfigure($track, 0, -text => "TO"); +$radar->itemconfigure($track, 1, -filled => 1 , -backcolor => "green", + -border => "contour"); +$radar->itemconfigure($track, 1, -filled => 1 , -backcolor => "green", + -border => "contour"); +$radar->itemconfigure($track, 2, -image => $logo , -alignment => "center"); +$mk = $radar->itemcget($track, -markercolor); + +$radar->itemconfigure($track, 0, -reliefthickness => 2, -relief => "sunken", + -bordercolor => "red", -border => "noborder"); + +$radar->bind($track.":-3", "<Enter>", + sub {$radar->itemconfigure($track, -speedvectorcolor => 'red')}); +$radar->bind($track.":-3", "<Leave>", + sub {$radar->itemconfigure($track, -speedvectorcolor => 'black')}); + + +################################################### +# creation way point +################################################### +print "creating way point\n"; +my $wp = $radar->add("waypoint", 10); +$radar->itemconfigure($wp, + -symbolcolor => "green", + -position => [0, 80], + -labelformat => "80x40|40+20|40+20|40+20,0:40x20+0+0,1:40x20+40+0,2:80x40+0+0" + ); +$radar->itemconfigure($wp, 0 ,-filled => 1 ,-backcolor => "tan",-text => "TO"); +$radar->itemconfigure($wp, 1 ,-filled => 1 ,-backcolor => "wheat",-text => "TO"); +$radar->itemconfigure($wp, 2 ,-border => "contour"); +$radar->bind($wp, "<Enter>", [ \&borders, "on"]); +$radar->bind($wp, "<Leave>", [ \&borders, "off"]); + +################################################### +# creation 2nd track +################################################### +print "creating second track\n"; +$track2 = $radar->add("track", 10, -speedvector => [-20, 0], -position => [0, 50]); +$radar->itemconfigure($track2, -connecteditem => $track); + +################################################### +# creation macro +################################################### +print "creating macro\n"; +$macro = $radar->add("macro", 10, + -labelformat => "80x40|40+20|40+20|40+20,0:40x20+0+0,1:40x20+40+0" + ); +$radar->itemconfigure($macro, 0 , -text => "une"); +$radar->itemconfigure($macro, 1, -text => "macro"); +$radar->itemconfigure($macro, -connecteditem => $track); +$radar->bind($macro.":0", "<Enter>", [ \&borders, "on"]); +$radar->bind($macro.":0", "<Leave>", [ \&borders, "off"]); + +################################################### +# creation ministrip +################################################### +print "creating ministrip\n"; +$ministrip = $radar->add("ministrip", 10, + -labelformat => "80x40|40+20|40+20|40+20,0:40x20+0+0,1:40x20+40+0", + -position => [100, 10] + ); +$radar->itemconfigure($ministrip, 0 , -text => 'ministrip'); + +################################################### +# creation map +################################################### +print "creating map\n"; +$mw->videomap("load", "/home/etienne/tmp/videomap_paris-w_90_2", 0, "paris-w"); +$mw->videomap("load", "/home/etienne/tmp/videomap_orly", 17, "orly"); +$mw->videomap("load", "/home/etienne/tmp/hegias_parouest_TE.vid", 0, "paris-ouest"); + +print "videomap ids : ", + join('|', $mw->videomap("ids", "/home/etienne/tmp/videomap_orly")),"\n"; +$map = $radar->add("map", -color => red); +$radar->itemconfigure($map,-mapinfo => orly); + +$map2 = $radar->add("map", -color => green, -filled => 1, -priority => 0, + -fillpattern => AlphaStipple6); +#$radar->itemconfigure($map2, -mapinfo => paris-ouest); + +$map3 = $radar->add("map", -color => orange); +$radar->itemconfigure($map3,-mapinfo => "paris-w"); + + +################################################### +#creation rectangle, arc, multipoint +################################################### + +$rect = $radar->add(rectangle, -50, -50, 50, -80, -linecolor => bisque); +$radar->bind($rect, '<Enter>', sub { $radar->itemconfigure($rect, -linecolor => red)}); +$radar->bind($rect, '<Leave>', sub { $radar->itemconfigure($rect, -linecolor => bisque)}); + +$arc = $radar->add(arc, -100, 80, -50, 30, -linecolor => bisque, + -tags => ["arc"]); +#$radar->addtag("fleche",'withtag', $arc); +#$radar->addtag("carquois",'withtag', $arc); +$radar->add(rectangle, -101, 81, -49, 29, -linecolor => green); +$radar->raise($arc); +$radar->bind($arc, '<Enter>', sub {$radar->itemconfigure($arc, -linecolor => red)}); +$radar->bind($arc, '<Leave>', sub {$radar->itemconfigure($arc, -linecolor => bisque)}); +print "arc tags=", join('|',$radar->gettags($arc)),"\n"; + +$radar->itemconfigure($arc, -startangle => 0, -extent => 360); + +$mp = $radar->add(multipoint, -300, 0, -250, 100, -80, 20); +$radar->itemconfigure($mp, -filled => 1, -linewidth => 4, -linecolor => yellow, + -fillcolor => tan, -fillpattern => AlphaStipple8); +$radar->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); +$radar->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 ($radar->find('all')) { + print $_, " -> ", $radar->class($_),"\n"; +} +$radar->Tk::bind("<2>", [sub { + print $_[1], "@" ,$_[2], ", closest: ", + join(' ',$radar->find('closest', $_[1], $_[2])),"\n"; + }, Ev('x'), Ev('y')]); + + +$radar->Tk::bind('<ButtonPress-1>', + [ sub {($origx, $origy) = ($_[1], $_[2]); }, Ev('x'), Ev('y') ]); + +$radar->Tk::bind('<ButtonRelease-1>', + [ sub {&finditems($_[1], $_[2]); }, Ev('x'), Ev('y') ]); + +$radar->Tk::bind("<2>", sub {$radar->translate('all', 10,10); }); +$radar->Tk::bind("<3>", sub {$radar->scale(1.1, 1.1); }); + + +MainLoop; + +sub borders { + my($widget, $onoff) = @_; + my $part = $radar->currentpart; + my $contour = "noborder"; + $contour = "contour" if ($onoff eq 'on'); + $radar->itemconfigure('current', $part, -border => $contour) if ($part >= 0); +} + +sub finditems { + my($cornerx, $cornery) = @_; + print "--- enclosed --->", + join('|', $radar->find('enclosed',$origx, $origy, $cornerx, $cornery)),"\n"; + print "--- overlapping --->", + join('|',$radar->find('overlapping',$origx, $origy, $cornerx, $cornery)),"\n\n"; +} |