# This demonstration script creates a canvas widget that displays a ruler
# with tab stops that can be set, moved, and deleted.
# RCS: @(#) $Id: ruler.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo
]} {
error "This script should be run from the \"widget\" demo."
# This procedure creates a new triangular polygon in a canvas to
# x, y - Coordinates at which to create the tab stop.
proc rulerMkTab
{c x y
} {
upvar #0 demo_rulerInfo v
$c create polygon
$x $y [expr {$x+$v(size
)}] [expr {$y+$v(size
)}] \
[expr {$x-$v(size
)}] [expr {$y+$v(size
)}]
wm title
$w "Ruler Demonstration"
label $w.msg
-font $font -wraplength 5i
-justify left
-text "This canvas widget shows a mock-up of a ruler. You can create tab stops by dragging them out of the well to the right of the ruler. You can also drag existing tab stops. If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button."
pack $w.buttons
-side bottom
-fill x
-pady 2m
button $w.buttons.dismiss
-text Dismiss
-command "destroy $w"
button $w.buttons.code
-text "See Code" -command "showCode $w"
pack $w.buttons.dismiss
$w.buttons.code
-side left
-expand 1
canvas $c -width 14.8c
-height 2.5c
pack $w.c
-side top
-fill x
set demo_rulerInfo
(grid) .25c
set demo_rulerInfo
(left
) [winfo fpixels
$c 1c
]
set demo_rulerInfo
(right
) [winfo fpixels
$c 13c
]
set demo_rulerInfo
(top
) [winfo fpixels
$c 1c
]
set demo_rulerInfo
(bottom
) [winfo fpixels
$c 1.5c
]
set demo_rulerInfo
(size
) [winfo fpixels
$c .2c
]
set demo_rulerInfo
(normalStyle
) "-fill black"
if {[winfo depth
$c] > 1} {
set demo_rulerInfo
(activeStyle
) "-fill red -stipple {}"
set demo_rulerInfo
(deleteStyle
) [list -fill red
\
-stipple @[file join $tk_library demos images gray25.bmp
]]
set demo_rulerInfo
(activeStyle
) "-fill black -stipple {}"
set demo_rulerInfo
(deleteStyle
) [list -fill black
\
-stipple @[file join $tk_library demos images gray25.bmp
]]
$c create line
1c
0.5c
1c
1c
13c
1c
13c
0.5c
-width 1
for {set i
0} {$i < 12} {incr i
} {
$c create line
${x
}c
1c
${x
}c
0.6c
-width 1
$c create line
$x.25c
1c
$x.25c
0.8c
-width 1
$c create line
$x.5c
1c
$x.5c
0.7c
-width 1
$c create line
$x.75c
1c
$x.75c
0.8c
-width 1
$c create
text $x.15c
.75c
-text $i -anchor sw
$c addtag well withtag
[$c create rect
13.2c
1c
13.8c
0.5c
\
-outline black
-fill [lindex [$c config
-bg] 4]]
$c addtag well withtag
[rulerMkTab
$c [winfo pixels
$c 13.5c
] \
$c bind well
<1> "rulerNewTab $c %x %y"
$c bind tab
<1> "rulerSelectTab $c %x %y"
bind $c <B1-Motion
> "rulerMoveTab $c %x %y"
bind $c <Any-ButtonRelease-1
> "rulerReleaseTab $c"
# Does all the work of creating a tab stop, including creating the
# triangle object and adding tags to it to give it tab behavior.
# x, y - The coordinates of the tab stop.
proc rulerNewTab
{c x y
} {
upvar #0 demo_rulerInfo v
$c addtag active withtag
[rulerMkTab
$c $x $y]
$c addtag tab withtag active
# This procedure is invoked when mouse button 1 is pressed over
# a tab. It remembers information about the tab so that it can
# be dragged interactively.
# x, y - The coordinates of the mouse (identifies the point by
# which the tab was picked up for dragging).
proc rulerSelectTab
{c x y
} {
upvar #0 demo_rulerInfo v
set v
(x
) [$c canvasx
$x $v(grid)]
set v
(y
) [expr {$v(top
)+2}]
$c addtag active withtag current
eval "$c itemconf active $v(activeStyle)"
# This procedure is invoked during mouse motion events to drag a tab.
# It adjusts the position of the tab, and changes its appearance if
# it is about to be dragged out of the ruler.
# x, y - The coordinates of the mouse.
proc rulerMoveTab
{c x y
} {
upvar #0 demo_rulerInfo v
if {[$c find withtag active
] == ""} {
set cx
[$c canvasx
$x $v(grid)]
if {($cy >= $v(top
)) && ($cy <= $v(bottom
))} {
set cy
[expr {$v(top
)+2}]
eval "$c itemconf active $v(activeStyle)"
set cy
[expr {$cy-$v(size
)-2}]
eval "$c itemconf active $v(deleteStyle)"
$c move active
[expr {$cx-$v(x
)}] [expr {$cy-$v(y
)}]
# This procedure is invoked during button release events that end
# a tab drag operation. It deselects the tab and deletes the tab if
# it was dragged out of the ruler.
# x, y - The coordinates of the mouse.
upvar #0 demo_rulerInfo v
if {[$c find withtag active
] == {}} {
if {$v(y
) != $v(top
)+2} {
eval "$c itemconf active $v(normalStyle)"