diff options
Diffstat (limited to 'sandbox')
-rw-r--r-- | sandbox/controls.tcl | 158 | ||||
-rw-r--r-- | sandbox/testpoly.tcl | 149 | ||||
-rw-r--r-- | sandbox/testzinc.pl | 229 | ||||
-rw-r--r-- | sandbox/zinc.tcl | 258 |
4 files changed, 794 insertions, 0 deletions
diff --git a/sandbox/controls.tcl b/sandbox/controls.tcl new file mode 100644 index 0000000..9301d1a --- /dev/null +++ b/sandbox/controls.tcl @@ -0,0 +1,158 @@ +set tlbbox [.r add group $top -sensitive f -visible f -tags currentbbox] +.r add rectangle $tlbbox "-3 -3 +3 +3" +set trbbox [.r add group $top -sensitive f -visible f -tags currentbbox] +.r add rectangle $trbbox "-3 -3 +3 +3" +set blbbox [.r add group $top -sensitive f -visible f -tags currentbbox] +.r add rectangle $blbbox "-3 -3 +3 +3" +set brbbox [.r add group $top -sensitive f -visible f -tags currentbbox] +.r add rectangle $brbbox "-3 -3 +3 +3" +.r add rectangle $top "0 0 1 1" -linecolor red -tags "lasso" -visible f -sensitive f + +# +# Controls for the window transform. +# +proc press {lx ly action} { + global x y angle + set x $lx + set y $ly + set angle [expr atan2($y, $x)] + bind .r "<Motion>" "$action %x %y" +} + +proc motion {lx ly} { + global x y + set it [.r find withtag controls] + if {$it != ""} { + set it [.r group [lindex $it 0]] + } + set res [.r transform $it "$lx $ly $x $y"] + set nx [lindex $res 0] + set ny [lindex $res 1] + set ox [lindex $res 2] + set oy [lindex $res 3] + .r translate controls [expr $nx - $ox] [expr $ny - $oy] + set x $lx + set y $ly +} + +proc zoom {lx ly} { + global x y + + if {$lx > $x} { + set maxx $lx + } else { + set maxx $x + } + if {$ly > $y} { + set maxy $ly + } else { + set maxy $y + } + set sx [expr 1.0 + double($lx - $x)/$maxx] + set sy [expr 1.0 + double($ly - $y)/$maxy] + set x $lx + set y $ly + .r scale controls $sx $sy +} + +proc rotate {lx ly} { + global angle + + set langle [expr atan2($ly, $lx)] + .r rotate controls [expr -($langle-$angle)] + set angle $langle +} + +proc release {} { + bind .r "<Motion>" "" +} + +proc start_lasso {lx ly} { + global top x y cx cy + set x $lx + set y $ly + set cx $lx + set cy $ly + set coords [.r transform $top "$x $y"] + set fx [lindex $coords 0] + set fy [lindex $coords 1] + .r coords lasso "$fx $fy $fx $fy" + .r itemconfigure lasso -visible t + .r raise lasso + bind .r "<Motion>" "lasso %x %y" +} + +proc lasso {lx ly} { + global top x y cx cy + set cx $lx + set cy $ly + set coords [.r transform $top "$x $y $lx $ly"] + set fx [lindex $coords 0] + set fy [lindex $coords 1] + set fcx [lindex $coords 2] + set fcy [lindex $coords 3] + .r coords lasso "$fx $fy $fcx $fcy" +} + +proc fin_lasso {} { + global x y cx cy + + bind .r "<Motion>" "" + .r itemconfigure lasso -visible f +# puts "x=$x, y=$y, cx=$cx, cy=$cy" + puts "enclosed='[.r find enclosed $x $y $cx $cy]', overlapping='[.r find overlapping $x $y $cx $cy]'" +} + +proc getrect {x y} { + list [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3] +} + +proc showbox {} { + global top tlbbox trbbox blbbox brbbox + + if { ! [.r hastag current currentbbox]} { + if {[catch {.r find withtag current} item] } { + return + } + set coords [.r transform $top [.r bbox current]] + set xo [lindex $coords 0] + set yo [lindex $coords 1] + set xc [lindex $coords 2] + set yc [lindex $coords 3] + + .r coords $tlbbox "$xo $yo" + .r coords $trbbox "$xc $yo" + .r coords $brbbox "$xc $yc" + .r coords $blbbox "$xo $yc" + .r itemconfigure currentbbox -visible t + } +} + +proc hidebox {lx ly} { + set next [.r find atpoint $lx $ly] + if {[llength $next] > 1} { + set next [lindex $next 0] + } + if { $next == "" || ! [.r hastag $next currentbbox] ||\ + [.r hastag current currentbbox]} { + .r itemconfigure currentbbox -visible f + } +} + + +bind .r "<ButtonPress-1>" "start_lasso %x %y" +bind .r "<ButtonRelease-1>" fin_lasso + +bind .r "<ButtonPress-2>" {puts "at point='[.r find atpoint %x %y]'"} + +bind .r "<ButtonPress-3>" "press %x %y motion" +bind .r "<ButtonRelease-3>" release + +bind .r "<Shift-ButtonPress-3>" "press %x %y zoom" +bind .r "<Shift-ButtonRelease-3>" release + +bind .r "<Control-ButtonPress-3>" "press %x %y rotate" +bind .r "<Control-ButtonRelease-3>" release + +.r bind current "<Enter>" showbox +.r bind current "<Leave>" {hidebox %x %y} diff --git a/sandbox/testpoly.tcl b/sandbox/testpoly.tcl new file mode 100644 index 0000000..0341bf9 --- /dev/null +++ b/sandbox/testpoly.tcl @@ -0,0 +1,149 @@ +#!/usr/bin/wish -f + +load tkradar3.1.so +package require Img + +set top 1 +set lw 8 +set marker AtcSymbol9 +set arrow "8 10 6" + + +# +# Cap Join Filled Border Relief Title +# +set show {\ + {round round f t flat JoinRound}\ + {round bevel f t flat JoinBevel}\ + {round miter f t flat JoinMiter}\ + {butt round f t flat CapButt}\ + {projecting round f t flat CapProjecting}\ + {round round f t sunken Sunken}\ + {round round f t raised Raised}\ + {round round f t groove Groove}\ + {round round f t ridge Ridge}\ + {round round t t sunken FilledSunken}\ + {round round t t raised FilledRaised}\ + {round round t t groove FilledGroove}\ + {round round t t ridge FilledRidge}\ + {round round f f flat Marker}\ + {round round t f flat Fill}\ + {round round t t flat FillBorder}} + +image create photo logo -file /usr/share/toccata/images/logo.gif +#image create photo papier -file /usr/share/toccata/images/dgtexture-dragstrip.xpm + +set r [radar .r -backcolor gray -relief sunken] +pack .r -expand t -fill both +.r configure -width 1024 -height 800 +.r scale $top 1 -1 +#.r configure -drawbboxes t +set view [.r add group $top -tags controls] + +# +# Create the model +# +set model [.r add group $view] +set mp [.r add curve $model "50 -150 100 -50 270 -130 220 -200 200 -180 180 -300 140 -160 70 -300" \ + -linecolor yellow -fillcolor tan -fillpattern AlphaStipple8 \ + -markercolor red -tags "poly" -linewidth $lw] +set bbox [.r transform $model [.r bbox $mp]] +set x [expr ([lindex $bbox 2] + [lindex $bbox 0]) / 2] +set y [expr [lindex $bbox 1] + 5] +.r add text $model -text "CapRound" -color blue -alignment center -anchor s -tags "title" \ + -position "$x $y" + +# +# Now clone for each variation on the polygon +# +set col 0 +set row 0 +foreach current $show { + foreach {cap join filled border relief title} $current { + set grp [.r clone $model] + .r translate $grp [expr $col * 240] [expr $row * (-290 - (2 * $lw))] + .r itemconfigure [.r find withtag "poly" $grp] \ + -capstyle $cap -joinstyle $join -filled $filled \ + -linewidth [expr $border ? $lw : 0] -relief $relief + .r itemconfigure [.r find withtag "title" $grp] -text $title + incr col + if {$col >= 4} { + set col 0 + incr row + } + } +} + +# +# Suppress the model +# +.r remove $model + + +# +# Some optional graphic features +set closed 0 +set marks 0 +set smooth 0 +set arrows none + +proc toggle_arrows { } { + global arrows arrow + if {$arrows == "none"} { + set arrows first + set f $arrow + set l "" + } elseif {$arrows == "first"} { + set arrows last + set f "" + set l $arrow + } elseif {$arrows == "last"} { + set arrows both + set f $arrow + set l $arrow + } elseif {$arrows == "both"} { + set arrows none + set f "" + set l "" + } + .r itemconfigure poly -firstend $f -lastend $l +} + +proc toggle_marks { } { + global marks marker + set marks [expr ! $marks] + if {$marks} { + .r itemconfigure poly -marker $marker + } { + .r itemconfigure poly -marker "" + } +} + +proc toggle_smooth { } { + global smooth + set smooth [expr ! $smooth] + .r itemconfigure poly -smoothed $smooth +} + +proc toggle_closed { } { + global closed + set closed [expr ! $closed] + foreach curve [.r find withtag "poly"] { + if {$closed} { + .r coords $curve add [.r coords $curve 0] + } { + .r coords $curve remove -1 + } + } + +} + +focus .r + +bind .r "<a>" toggle_arrows +bind .r "<c>" toggle_closed +bind .r "<m>" toggle_marks +bind .r "<s>" toggle_smooth + + +source "controls.tcl" diff --git a/sandbox/testzinc.pl b/sandbox/testzinc.pl new file mode 100644 index 0000000..ebcb40c --- /dev/null +++ b/sandbox/testzinc.pl @@ -0,0 +1,229 @@ +#!/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, curve +################################################### + +$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(curve, -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->type($_),"\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); }); + + +@position = [20, 40, 50, 80]; +#@xy = $radar -> worldcoords (0, @position); +@xy = $radar -> worldcoords (0, [10, 23, 45, 65]); +print ("x = ",$xy[0]," y = ",$xy[1],"\n"); + + + +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"; +} diff --git a/sandbox/zinc.tcl b/sandbox/zinc.tcl new file mode 100644 index 0000000..a828934 --- /dev/null +++ b/sandbox/zinc.tcl @@ -0,0 +1,258 @@ +#!/usr/bin/wish -f + +load tkradar3.1.so +package require Img + +set top 1 + +image create photo logo -file /usr/share/toccata/images/logo.gif +image create photo logosmall -file /usr/share/toccata/images/logo-small.gif +#image create photo papier -file /usr/share/toccata/images/dgtexture-dragstrip.xpm + +set r [radar .r -backcolor gray -relief sunken] +pack .r -expand t -fill both +set scale 1.0 +set centerX 0.0 +set centerY 0.0 +set radarWidth 800 +set radarHeight 500 +.r configure -width $radarWidth -height $radarHeight +#.r configure -drawbboxes t +set view [.r add group $top -tags "controls"] + +frame .rc +button .rc.up -text "Up" \ + -command {set centerY [expr $centerY+30.0]; updateTransform .r} +button .rc.down -text "Down" \ + -command {set centerY [expr $centerY-30.0]; updateTransform .r} +button .rc.left -text "Left" \ + -command {set centerX [expr $centerX+30.0]; updateTransform .r} +button .rc.right -text "Right" \ + -command {set centerX [expr $centerX-30.0]; updateTransform .r} +button .rc.expand -text "Expand" \ + -command {set scale [expr $scale*1.1]; updateTransform .r} +button .rc.shrink -text "Shrink" \ + -command {set scale [expr $scale*0.9]; updateTransform .r} +button .rc.reset -text "Reset" \ + -command {set scale 1.0; set centerX 0.0; set centerY 0.0; \ + updateTransform .r} +grid .rc.up -row 0 -column 2 -sticky ew +grid .rc.down -row 2 -column 2 -sticky ew +grid .rc.left -row 1 -column 1 +grid .rc.right -row 1 -column 3 +grid .rc.expand -row 1 -column 4 +grid .rc.shrink -row 1 -column 0 +grid .rc.reset -row 1 -column 2 -sticky ew +pack .rc + +bind .r <Configure> "RadarStyleConfig %W %w %h" + +proc RadarStyleConfig {radar w h} { + global radarWidth radarHeight + + set bw [$radar cget -borderwidth] + set radarWidth [expr $w - 2*$bw] + set radarHeight [expr $h - 2*$bw] + updateTransform $radar +} + +proc updateTransform {radar} { + global radarWidth radarHeight + global scale centerX centerY + global top + + $radar treset $top + $radar scale $top 1 -1 + $radar translate $top [expr -$centerX] [expr -$centerY] + $radar scale $top $scale $scale + $radar translate $top [expr $radarWidth/2] [expr $radarHeight/2] +} + +# +# TRACKS +# +set track [.r add track $view 5 -tags track -leaderanchors "|0|0"] +.r itemconfigure $track -position "1 1" +.r itemconfigure $track -position "10 10" +.r itemconfigure $track -position "20 20" +.r itemconfigure $track -position "30 30" +.r itemconfigure $track -position "40 40" +.r itemconfigure $track -position "50 50" +.r itemconfigure $track -position "55 60" +.r itemconfigure $track -position "60 70" +.r itemconfigure $track -speedvector "20 0" +.r itemconfigure $track -symbolcolor salmon -speedvectorcolor salmon -leadercolor salmon \ + -labeldistance 20 +.r itemconfigure $track -markersize 20 \ + -filledmarker 1 \ + -markerfillpattern AlphaStipple4 \ + -markercolor salmon +.r itemconfigure $track -labelformat "120x40 x80x20+0+0 x40x20+80+0 x40x20+0+20 x20x20>2>1 x60x20>0>0" +.r itemconfigure $track 0 -filled 1 -backcolor tan -relief groove \ + -font "cenapii-etiquette-m17" -text "AFR451" +.r itemconfigure $track 1 -text "WPY" -filled 1 -backcolor wheat -relief ridge \ + -font "cenapii-etiquette-m17" +.r itemconfigure $track 2 -text "400" -filled 1 -backcolor wheat \ + -font "cenapii-etiquette-m17" +.r itemconfigure $track 3 -text "-" -filled 1 -backcolor wheat \ + -font "cenapii-etiquette-m17" +.r itemconfigure $track 4 -text "450" -filled 1 -backcolor wheat \ + -font "cenapii-etiquette-m17" + +.r bind $track:-3 <Enter> ".r itemconfigure $track -speedvectorcolor red" +.r bind $track:-3 <Leave> ".r itemconfigure $track -speedvectorcolor salmon" + +set track2 [.r add track $view 4 -speedvector "-20 0" \ + -symbolcolor salmon -speedvectorcolor salmon -leadercolor salmon \ + -labeldistance 20 -leaderanchors "%30x30"] +.r itemconfigure $track2 -labelformat "a3f110+0+0 a3f110>0^0 a3f110^0>0 a3f110>2>0" +.r itemconfigure $track2 0 -filled 1 -backcolor tan -text "BAW452" +.r itemconfigure $track2 1 -filled 1 -backcolor wheat -text "450" +.r itemconfigure $track2 2 -filled 1 -backcolor wheat -text "KMC" +#.r itemconfigure $track2 3 -filled 1 -backcolor wheat -text "" +.r itemconfigure $track2 -connecteditem $track -connectioncolor green +.r itemconfigure $track2 -position "1 1" +.r itemconfigure $track2 -position "-10 10" +.r itemconfigure $track2 -position "-20 20" +.r itemconfigure $track2 -position "-30 30" +.r itemconfigure $track2 -position "-40 40" +.r itemconfigure $track2 -position "-50 50" +.r itemconfigure $track2 -position "-60 50" + +# +# WAY POINTS +# +puts "creating way points" +set wp [.r add waypoint $view 1 -tags borders] +.r itemconfigure $wp -symbolcolor bisque -leadercolor bisque -position "-100 120" \ + -labelformat "40x20" +.r itemconfigure $wp 0 -bordercolor bisque -text "NCY" -tile logo -filled t +set wp2 [.r add waypoint $view 1 -tags borders] +.r itemconfigure $wp2 -symbolcolor bisque \ + -leadercolor bisque \ + -position "50 160" \ + -labelformat "40x20" \ + -connectioncolor bisque \ + -connecteditem $wp +.r itemconfigure $wp2 0 -bordercolor bisque -text "MPW" +set wp3 [.r add waypoint $view 1 -tags borders] +.r itemconfigure $wp3 -symbolcolor bisque \ + -leadercolor bisque \ + -position "200 140" \ + -labelformat "40x20" \ + -connectioncolor bisque \ + -connecteditem $wp2 +.r itemconfigure $wp3 0 -bordercolor bisque -text "ART" + +# +# MACROS +# +puts "creating macros" +set macro [.r add tabular $view 10 -labelformat "x40x20+0+0 x40x20+40+0" \ + -tags f0borders -connecteditem $track] +.r itemconfigure $macro 0 -text une +.r itemconfigure $macro 1 -text macro + +# +# MINISTRIPS +# +puts "creating ministrips" +set ministrip [.r add tabular $view 1 \ + -labelformat "60x20" -position "10 10"] +.r itemconfigure $ministrip 0 -text "ministrip" -sensitive f +set ministrip2 [.r add tabular $view 1 \ + -labelformat "60x20" -connecteditem $ministrip] +.r itemconfigure $ministrip2 0 -text "ministrip2" -sensitive f +set ministrip3 [.r add tabular $view 1 \ + -labelformat "60x20" -connecteditem $ministrip2] +.r itemconfigure $ministrip3 0 -text "ministrip3" -sensitive f + +# +# MAPS +# +puts "creating maps" +videomap load "/usr/share/toccata/maps/videomap_paris-w_90_2" 0 paris-w +videomap load "/usr/share/toccata/maps/videomap_orly" 17 orly +videomap load "/usr/share/toccata/maps/hegias_parouest_TE.vid" 0 paris-ouest + +set map [.r add map $view -color darkblue] +.r itemconfigure $map -mapinfo orly + +set map2 [.r add map $view -color darkblue -filled 1 -priority 0 -fillpattern AlphaStipple1] +.r itemconfigure $map2 -mapinfo paris-ouest + +set map3 [.r add map $view -color orange] + +mapinfo mpessai create +mapinfo mpessai add text normal simple 0 200 "Et voilà" +mapinfo mpessai add line simple 5 0 0 100 100 +mapinfo mpessai add line simple 0 100 100 0 200 +mapinfo mpessai add line simple 2 -100 100 0 0 +.r itemconfigure $map3 -mapinfo mpessai + +# +# Clip +# +puts "crée les clips" +set clip [.r add rectangle $view "-100 -100 300 200" -filled t \ + -linewidth 0 -fillcolor darkgray -visible f] +#.r rotate $clip [expr 3.14159 / 4] +.r lower $clip +#.r itemconfigure $view -clip $clip + +.r add rectangle $top "-5 -5 5 5" -filled t -fillcolor red +set topclip [.r add rectangle $top "-400 -400 400 400" \ + -filled t -fillcolor lightgray -linewidth 0 -visible t] +.r lower $topclip +#.r rotate $topclip [expr 3.14159 / 4] +#.r itemconfigure $top -clip $topclip + +# +# CONTROLS +# +proc borders {onoff} { + set part [.r currentpart] + set contour noborder + if { $onoff == "on" } { + set contour "contour" + } + if { $part >= 0 } { + .r itemconfigure current $part -border $contour + } +} + +.r bind borders <Enter> "borders on" +.r bind borders <Leave> "borders off" +.r bind f0borders:0 <Enter> "borders on" +.r bind f0borders:0 <Leave> "borders off" +.r bind track <Enter> {puts "Entre dans item"} +.r bind track <Leave> {puts "Sort d'item"} +.r bind track:0 <Enter> {puts "Entre dans champ 0"} +.r bind track:0 <Leave> {puts "Sort de champ 0"} +.r bind track:1 <Enter> {puts "Entre dans champ 1"} +.r bind track:1 <Leave> {puts "Sort de champ 1"} +.r bind track:2 <Enter> {puts "Entre dans champ 2"} +.r bind track:2 <Leave> {puts "Sort de champ 2"} +.r bind track:3 <Enter> {puts "Entre dans champ 3"} +.r bind track:3 <Leave> {puts "Sort de champ 3"} + +bind .r <2> {puts "%x@%y, item: [.r find atpoint %x %y]"} + +proc finditems {cornerx cornery} { + global origx origy + + puts "--- enclosed ---" + puts "++ [.r find enclosed $origx $origy $cornerx $cornery] ++" + puts "--- overlapping ---" + puts "++ [.r find overlapping $origx $origy $cornerx $cornery] ++" + puts "" +} + +bind .r <ButtonPress-1> "set origx %x; set origy %y" +bind .r <ButtonRelease-1> "finditems %x %y" + +.r bind all <1> { if {! [catch {.r find withtag current} item] } { \ + puts "<1> in $item" } else { puts "None" } } + +source "controls.tcl" + |