~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

-text "This widget allows you to experiment with different widths and arrowhead shapes for lines in canvases. To change the line width or the shape of the arrowhead, drag any of the three boxes attached to the oversized arrow. The arrows on the right give examples at normal scale. The text at the bottom shows the configuration options as you'd enter them for a line."

pack $w.frame1.m

set v(a) 8

set v(b) 10

set v(c) 3

set v(width) 2

set v(motionProc) arrowMoveNull

set v(x1) 40

set v(x2) 350

set v(y) 150

set v(smallTips) {5 5 2}

set v(count) 0

if {[tk colormodel $c] == "color"} {

set v(bigLineStyle) "-fill SkyBlue1"

set v(boxStyle) "-fill {} -outline black -width 1"

set v(activeStyle) "-fill red -outline black -width 1"

} else {

set v(bigLineStyle) "-fill black -stipple @$tk_library/demos/bitmaps/grey.25"

set v(boxStyle) "-fill {} -outline black -width 1"

set v(activeStyle) "-fill black -outline black -width 1"

}

arrowSetup $c

$c bind box <Enter> "$c itemconfigure current $v(activeStyle)"

$c bind box <Leave> "$c itemconfigure current $v(boxStyle)"

$c bind box1 <1> {set demo_arrowInfo(motionProc) arrowMove1}

$c bind box2 <1> {set demo_arrowInfo(motionProc) arrowMove2}

$c bind box3 <1> {set demo_arrowInfo(motionProc) arrowMove3}

$c bind box <B1-Motion> "\$demo_arrowInfo(motionProc) $c %x %y"

bind $c <Any-ButtonRelease-1> "arrowSetup $c"

}

# The procedure below completely regenerates all the text and graphics

# in the canvas window. It's called when the canvas is initially created,

# and also whenever any of the parameters of the arrow head are changed

# interactively. The argument is the name of the canvas widget to be

# regenerated, and also the name of a global variable containing the

# parameters for the display.

proc arrowSetup c {

upvar #0 demo_arrowInfo v

$c delete all

# Create the arrow and outline.

eval "$c create line $v(x1) $v(y) $v(x2) $v(y) -width [expr 10*$v(width)] \

-arrowshape {[expr 10*$v(a)] [expr 10*$v(b)] [expr 10*$v(c)]} \

-arrow last $v(bigLineStyle)"

set xtip [expr $v(x2)-10*$v(b)]

set deltaY [expr 10*$v(c)+5*$v(width)]

$c create line $v(x2) $v(y) $xtip [expr $v(y)+$deltaY] \

[expr $v(x2)-10*$v(a)] $v(y) $xtip [expr $v(y)-$deltaY] \

$v(x2) $v(y) -width 2 -capstyle round -joinstyle round

# Create the boxes for reshaping the line and arrowhead.

eval "$c create rect [expr $v(x2)-10*$v(a)-5] [expr $v(y)-5] \

[expr $v(x2)-10*$v(a)+5] [expr $v(y)+5] $v(boxStyle) \

-tags {box1 box}"

eval "$c create rect [expr $xtip-5] [expr $v(y)-$deltaY-5] \

[expr $xtip+5] [expr $v(y)-$deltaY+5] $v(boxStyle) \

-tags {box2 box}"

eval "$c create rect [expr $v(x1)-5] [expr $v(y)-5*$v(width)-5] \

[expr $v(x1)+5] [expr $v(y)-5*$v(width)+5] $v(boxStyle) \

-tags {box3 box}"

# Create three arrows in actual size with the same parameters

$c create line [expr $v(x2)+50] 0 [expr $v(x2)+50] 1000 \

100

-width 2

101

set tmp [expr $v(x2)+100]

102

$c create line $tmp [expr $v(y)-125] $tmp [expr $v(y)-75] \

103

-width $v(width) \

104

-arrow both -arrowshape "$v(a) $v(b) $v(c)"

105

$c create line [expr $tmp-25] $v(y) [expr $tmp+25] $v(y) \

106

-width $v(width) \

107

-arrow both -arrowshape "$v(a) $v(b) $v(c)"

108

$c create line [expr $tmp-25] [expr $v(y)+75] [expr $tmp+25] \

109

[expr $v(y)+125] -width $v(width) \

110

-arrow both -arrowshape "$v(a) $v(b) $v(c)"

111

112

# Create a bunch of other arrows and text items showing the

113

# current dimensions.

114

115

set tmp [expr $v(x2)+10]

116

$c create line $tmp [expr $v(y)-5*$v(width)] \

117

$tmp [expr $v(y)-$deltaY] \

118

-arrow both -arrowshape $v(smallTips)

119

$c create text [expr $v(x2)+15] [expr $v(y)-$deltaY+5*$v(c)] \

120

-text $v(c) -anchor w

121

set tmp [expr $v(x1)-10]

122

$c create line $tmp [expr $v(y)-5*$v(width)] \

123

$tmp [expr $v(y)+5*$v(width)] \

124

-arrow both -arrowshape $v(smallTips)

125

$c create text [expr $v(x1)-15] $v(y) -text $v(width) -anchor e

126

set tmp [expr $v(y)+5*$v(width)+10*$v(c)+10]

127

$c create line [expr $v(x2)-10*$v(a)] $tmp $v(x2) $tmp \

128

-arrow both -arrowshape $v(smallTips)

129

$c create text [expr $v(x2)-5*$v(a)] [expr $tmp+5] \

130

-text $v(a) -anchor n

131

set tmp [expr $tmp+25]

132

$c create line [expr $v(x2)-10*$v(b)] $tmp $v(x2) $tmp \

133

-arrow both -arrowshape $v(smallTips)

134

$c create text [expr $v(x2)-5*$v(b)] [expr $tmp+5] \

135

-text $v(b) -anchor n

136

137

$c create text $v(x1) 310 -text "-width $v(width)" \

138

-anchor w -font -Adobe-Helvetica-Medium-R-Normal-*-180-*

139

$c create text $v(x1) 330 -text "-arrowshape {$v(a) $v(b) $v(c)}" \

140

-anchor w -font -Adobe-Helvetica-Medium-R-Normal-*-180-*

141

142

incr v(count)

143

}

144

145

# The procedures below are called in response to mouse motion for one

146

# of the three items used to change the line width and arrowhead shape.

147

# Each procedure updates one or more of the controlling parameters

148

# for the line and arrowhead, and recreates the display if that is

149

# needed. The arguments are the name of the canvas widget, and the

150

# x and y positions of the mouse within the widget.

151

152

proc arrowMove1 {c x y} {

153

upvar #0 demo_arrowInfo v

154

set newA [expr ($v(x2)+5-[$c canvasx $x])/10]

155

if {$newA < 1} {

156

set newA 1

157

}

158

if {$newA > 25} {

159

set newA 25

160

}

161

if {$newA != $v(a)} {

162

$c move box1 [expr 10*($v(a)-$newA)] 0

163

set v(a) $newA

164

}

165

}

166

167

proc arrowMove2 {c x y} {

168

upvar #0 demo_arrowInfo v

169

set newB [expr ($v(x2)+5-[$c canvasx $x])/10]

170

if {$newB < 1} {

171

set newB 1

172

}

173

if {$newB > 25} {

174

set newB 25

175

}

176

set newC [expr ($v(y)+5-[$c canvasy $y]-5*$v(width))/10]

177

if {$newC < 1} {

178

set newC 1

179

}

180

if {$newC > 20} {

181

set newC 20

182

}

183

if {($newB != $v(b)) || ($newC != $v(c))} {

184

$c move box2 [expr 10*($v(b)-$newB)] [expr 10*($v(c)-$newC)]

185

set v(b) $newB

186

set v(c) $newC

187

}

188

}

189

190

proc arrowMove3 {c x y} {

191

upvar #0 demo_arrowInfo v

192

set newWidth [expr ($v(y)+5-[$c canvasy $y])/5]

193

if {$newWidth < 1} {

194

set newWidth 1

195

}

196

if {$newWidth > 20} {

197

set newWidth 20

198

}

199

if {$newWidth != $v(width)} {

200

$c move box3 0 [expr 5*($v(width)-$newWidth)]

201

set v(width) $newWidth

202

}

203

}

Older »