Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # ruler.tcl -- |
2 | # | |
3 | # This demonstration script creates a canvas widget that displays a ruler | |
4 | # with tab stops that can be set, moved, and deleted. | |
5 | # | |
6 | # RCS: @(#) $Id: ruler.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ | |
7 | ||
8 | if {![info exists widgetDemo]} { | |
9 | error "This script should be run from the \"widget\" demo." | |
10 | } | |
11 | ||
12 | # rulerMkTab -- | |
13 | # This procedure creates a new triangular polygon in a canvas to | |
14 | # represent a tab stop. | |
15 | # | |
16 | # Arguments: | |
17 | # c - The canvas window. | |
18 | # x, y - Coordinates at which to create the tab stop. | |
19 | ||
20 | proc rulerMkTab {c x y} { | |
21 | upvar #0 demo_rulerInfo v | |
22 | $c create polygon $x $y [expr {$x+$v(size)}] [expr {$y+$v(size)}] \ | |
23 | [expr {$x-$v(size)}] [expr {$y+$v(size)}] | |
24 | } | |
25 | ||
26 | set w .ruler | |
27 | global tk_library | |
28 | catch {destroy $w} | |
29 | toplevel $w | |
30 | wm title $w "Ruler Demonstration" | |
31 | wm iconname $w "ruler" | |
32 | positionWindow $w | |
33 | set c $w.c | |
34 | ||
35 | 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." | |
36 | pack $w.msg -side top | |
37 | ||
38 | frame $w.buttons | |
39 | pack $w.buttons -side bottom -fill x -pady 2m | |
40 | button $w.buttons.dismiss -text Dismiss -command "destroy $w" | |
41 | button $w.buttons.code -text "See Code" -command "showCode $w" | |
42 | pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 | |
43 | ||
44 | canvas $c -width 14.8c -height 2.5c | |
45 | pack $w.c -side top -fill x | |
46 | ||
47 | set demo_rulerInfo(grid) .25c | |
48 | set demo_rulerInfo(left) [winfo fpixels $c 1c] | |
49 | set demo_rulerInfo(right) [winfo fpixels $c 13c] | |
50 | set demo_rulerInfo(top) [winfo fpixels $c 1c] | |
51 | set demo_rulerInfo(bottom) [winfo fpixels $c 1.5c] | |
52 | set demo_rulerInfo(size) [winfo fpixels $c .2c] | |
53 | set demo_rulerInfo(normalStyle) "-fill black" | |
54 | if {[winfo depth $c] > 1} { | |
55 | set demo_rulerInfo(activeStyle) "-fill red -stipple {}" | |
56 | set demo_rulerInfo(deleteStyle) [list -fill red \ | |
57 | -stipple @[file join $tk_library demos images gray25.bmp]] | |
58 | } else { | |
59 | set demo_rulerInfo(activeStyle) "-fill black -stipple {}" | |
60 | set demo_rulerInfo(deleteStyle) [list -fill black \ | |
61 | -stipple @[file join $tk_library demos images gray25.bmp]] | |
62 | } | |
63 | ||
64 | $c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1 | |
65 | for {set i 0} {$i < 12} {incr i} { | |
66 | set x [expr {$i+1}] | |
67 | $c create line ${x}c 1c ${x}c 0.6c -width 1 | |
68 | $c create line $x.25c 1c $x.25c 0.8c -width 1 | |
69 | $c create line $x.5c 1c $x.5c 0.7c -width 1 | |
70 | $c create line $x.75c 1c $x.75c 0.8c -width 1 | |
71 | $c create text $x.15c .75c -text $i -anchor sw | |
72 | } | |
73 | $c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \ | |
74 | -outline black -fill [lindex [$c config -bg] 4]] | |
75 | $c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \ | |
76 | [winfo pixels $c .65c]] | |
77 | ||
78 | $c bind well <1> "rulerNewTab $c %x %y" | |
79 | $c bind tab <1> "rulerSelectTab $c %x %y" | |
80 | bind $c <B1-Motion> "rulerMoveTab $c %x %y" | |
81 | bind $c <Any-ButtonRelease-1> "rulerReleaseTab $c" | |
82 | ||
83 | # rulerNewTab -- | |
84 | # Does all the work of creating a tab stop, including creating the | |
85 | # triangle object and adding tags to it to give it tab behavior. | |
86 | # | |
87 | # Arguments: | |
88 | # c - The canvas window. | |
89 | # x, y - The coordinates of the tab stop. | |
90 | ||
91 | proc rulerNewTab {c x y} { | |
92 | upvar #0 demo_rulerInfo v | |
93 | $c addtag active withtag [rulerMkTab $c $x $y] | |
94 | $c addtag tab withtag active | |
95 | set v(x) $x | |
96 | set v(y) $y | |
97 | rulerMoveTab $c $x $y | |
98 | } | |
99 | ||
100 | # rulerSelectTab -- | |
101 | # This procedure is invoked when mouse button 1 is pressed over | |
102 | # a tab. It remembers information about the tab so that it can | |
103 | # be dragged interactively. | |
104 | # | |
105 | # Arguments: | |
106 | # c - The canvas widget. | |
107 | # x, y - The coordinates of the mouse (identifies the point by | |
108 | # which the tab was picked up for dragging). | |
109 | ||
110 | proc rulerSelectTab {c x y} { | |
111 | upvar #0 demo_rulerInfo v | |
112 | set v(x) [$c canvasx $x $v(grid)] | |
113 | set v(y) [expr {$v(top)+2}] | |
114 | $c addtag active withtag current | |
115 | eval "$c itemconf active $v(activeStyle)" | |
116 | $c raise active | |
117 | } | |
118 | ||
119 | # rulerMoveTab -- | |
120 | # This procedure is invoked during mouse motion events to drag a tab. | |
121 | # It adjusts the position of the tab, and changes its appearance if | |
122 | # it is about to be dragged out of the ruler. | |
123 | # | |
124 | # Arguments: | |
125 | # c - The canvas widget. | |
126 | # x, y - The coordinates of the mouse. | |
127 | ||
128 | proc rulerMoveTab {c x y} { | |
129 | upvar #0 demo_rulerInfo v | |
130 | if {[$c find withtag active] == ""} { | |
131 | return | |
132 | } | |
133 | set cx [$c canvasx $x $v(grid)] | |
134 | set cy [$c canvasy $y] | |
135 | if {$cx < $v(left)} { | |
136 | set cx $v(left) | |
137 | } | |
138 | if {$cx > $v(right)} { | |
139 | set cx $v(right) | |
140 | } | |
141 | if {($cy >= $v(top)) && ($cy <= $v(bottom))} { | |
142 | set cy [expr {$v(top)+2}] | |
143 | eval "$c itemconf active $v(activeStyle)" | |
144 | } else { | |
145 | set cy [expr {$cy-$v(size)-2}] | |
146 | eval "$c itemconf active $v(deleteStyle)" | |
147 | } | |
148 | $c move active [expr {$cx-$v(x)}] [expr {$cy-$v(y)}] | |
149 | set v(x) $cx | |
150 | set v(y) $cy | |
151 | } | |
152 | ||
153 | # rulerReleaseTab -- | |
154 | # This procedure is invoked during button release events that end | |
155 | # a tab drag operation. It deselects the tab and deletes the tab if | |
156 | # it was dragged out of the ruler. | |
157 | # | |
158 | # Arguments: | |
159 | # c - The canvas widget. | |
160 | # x, y - The coordinates of the mouse. | |
161 | ||
162 | proc rulerReleaseTab c { | |
163 | upvar #0 demo_rulerInfo v | |
164 | if {[$c find withtag active] == {}} { | |
165 | return | |
166 | } | |
167 | if {$v(y) != $v(top)+2} { | |
168 | $c delete active | |
169 | } else { | |
170 | eval "$c itemconf active $v(normalStyle)" | |
171 | $c dtag active | |
172 | } | |
173 | } |