diff options
Diffstat (limited to 'library/demos/items.tcl')
| -rw-r--r-- | library/demos/items.tcl | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 1370560..1297046 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -17,7 +17,7 @@ wm iconname $w "Items" positionWindow $w set c $w.frame.c -label $w.msg -font $font -wraplength 5i -justify left -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Button-1 drag:\tmoves item under pointer.\n Button-2 drag:\trepositions view.\n Button-3 drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area." +label $w.msg -font $font -wraplength 5i -justify left -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Left-Button drag:\tmoves item under pointer.\n Middle-Button drag:\trepositions view.\n Right-Button drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area." pack $w.msg -side top ## See Code / Dismiss buttons @@ -173,10 +173,17 @@ $c create text 28.5c 17.4c -text Scale: -anchor s $c bind item <Enter> "itemEnter $c" $c bind item <Leave> "itemLeave $c" -bind $c <Button-2> "$c scan mark %x %y" -bind $c <B2-Motion> "$c scan dragto %x %y" -bind $c <Button-3> "itemMark $c %x %y" -bind $c <B3-Motion> "itemStroke $c %x %y" +if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} { + bind $c <Button-2> "itemMark $c %x %y" + bind $c <B2-Motion> "itemStroke $c %x %y" + bind $c <Button-3> "$c scan mark %x %y" + bind $c <B3-Motion> "$c scan dragto %x %y" +} else { + bind $c <Button-2> "$c scan mark %x %y" + bind $c <B2-Motion> "$c scan dragto %x %y" + bind $c <Button-3> "itemMark $c %x %y" + bind $c <B3-Motion> "itemStroke $c %x %y" +} bind $c <<NextChar>> "itemsUnderArea $c" bind $c <Button-1> "itemStartDrag $c %x %y" bind $c <B1-Motion> "itemDrag $c %x %y" @@ -250,14 +257,14 @@ proc itemsUnderArea {c} { set area [$c find withtag area] set items "" foreach i [$c find enclosed $areaX1 $areaY1 $areaX2 $areaY2] { - if {[lsearch [$c gettags $i] item] != -1} { + if {[lsearch [$c gettags $i] item] >= 0} { lappend items $i } } puts stdout "Items enclosed by area: $items" set items "" foreach i [$c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] { - if {[lsearch [$c gettags $i] item] != -1} { + if {[lsearch [$c gettags $i] item] >= 0} { lappend items $i } } |