1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
#!@xtk01_LOCATION@ -f
# -*-tcl-*-
# Geoffrey Furnish
# 11 April 1994
#
# @> A script for using Tk to control xtk01
###############################################################################
wm title . "x01c -- Tk version"
plstdwin .
# If you just want a bare plframe, set this to 0.
set use_plxframe 1
if { $use_plxframe == 1 } then {
set plwin .plw.plwin
} else {
set plwin .plwin
}
###############################################################################
# Set up the menubar and message widgets.
frame .menu -relief raised -borderwidth 3
button .menu.one -text "One" -command "myplot 1"
pack append .menu .menu.one {left expand fill}
button .menu.two -text "Two" -command "myplot 2"
pack append .menu .menu.two {left expand fill}
button .menu.three -text "Three" -command "myplot 3"
pack append .menu .menu.three {left expand fill}
button .menu.four -text "Four" -command "myplot 4"
pack append .menu .menu.four {left expand fill}
button .menu.exit -text "Exit" -command "quit 0"
pack append .menu .menu.exit {right expand fill}
message .msg \
-font -Adobe-helvetica-medium-r-normal--*-240* -aspect 200 \
-width 500 -borderwidth 1 \
-text "tk01: Control x01c from Tk"
pack append . \
.menu {top fillx} \
.msg {top padx 5 pady 5 fill}
tk_menuBar .menu .menu.one .menu.two .menu.three .menu.four .menu.exit
###############################################################################
if { $use_plxframe == 1 } then {
plxframe .plw
pack append . .plw {left expand fill}
} else {
plframe .plwin
pack append . .plwin {left expand fill}
}
bind $plwin L locate_on
bind $plwin <Escape> locate_off
bind $plwin <Control-Button-1> rband_on
bind $plwin <Control-ButtonRelease-1> rband_off
proc rband_on {} {
global plwin
$plwin configure -rubberband 1
}
proc rband_off {} {
global plwin
$plwin configure -rubberband 0
}
###############################################################################
# Definitions of procedures used in this script.
# Punch eject and hold onto your seat !!!
proc quit a {
exit
}
# Utility routine.
proc dpos w {
wm geometry $w +300+300
}
###############################################################################
# Here is a binding which allows you to obtain the world coordinates of a
# point or points through invoking a "Locate" mode. You could instead just
# turn it on somewhere in the script and leave it on if you prefer modeless
# behavior, although you can sometimes get into trouble if you move the
# crosshairs while a graphic draw is being performed (X is not forced to
# handle these events serially -- the crosshairs may be updated before the
# graphic draw is complete, and if the graphic draw then obscures the
# crosshairs it will leave traces of the crosshairs on the plot when you
# next move them). Note especially that in the body of this example
# "get_coords" proc, you can do anything you can do from Tcl. In
# particular, you need not put the data out to stdout (which is pretty
# boring). Instead, you can use this to feed the world coords to some more
# complicated Tcl proc of your choosing. Use the regexp parser to pull out
# the world x and y coordinates, etc. Have fun!
proc locate_on {} {
global plwin
$plwin configure -xhairs 1
bind $plwin <Shift-1> { get_coords %x %y }
}
proc locate_off {} {
global plwin
$plwin configure -xhairs 0
bind $plwin <Shift-1> {}
}
proc get_coords {x y} {
global plwin
puts "world coordinates: [$plwin report wc $x $y]"
}
###############################################################################
|
