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
|
#
# app_init.tk
#
proc app_init_tk {} {
global COLOR FONT TITLE EXT cursor_counter Control env Html
set cursor_counter 0
# set colors for windows
set COLOR(bg) #acf
set COLOR(abg) #57f
set COLOR(hbg) #9be
set COLOR(views) black
set COLOR(entry) white
set COLOR(info) blue
# set default external program calls
set EXT(browser) {exec netscape $Html(Url) &}
set EXT(convertgif) {exec convert "ppm:$Snap(Directory)/snaptempgif" "tiff:$Snap(Directory)/$Snap(Filename)"}
set EXT(converttiff) {exec convert "ppm:$Snap(Directory)/snaptemptiff" "tiff:$Snap(Directory)/$Snap(Filename)"}
set EXT(imgview) {exec xv $fpath &}
set EXT(psview) {exec gs $fpath &}
if {$Control(Large)} {
set FONT(button) -Adobe-Helvetica-Medium-R-Normal--*-120-*
set FONT(label) -Adobe-Helvetica-Medium-R-Normal--*-120-*
set FONT(biglabel) -Adobe-Helvetica-Medium-R-Normal--*-140-*
set FONT(boldlabel) -Adobe-Helvetica-Bold-R-Normal--*-120-*
} {
set FONT(button) -Adobe-Helvetica-Medium-R-Normal--*-100-*
set FONT(label) -Adobe-Helvetica-Medium-R-Normal--*-100-*
set FONT(biglabel) -Adobe-Helvetica-Medium-O-Normal--*-120-*
set FONT(boldlabel) -Adobe-Helvetica-Bold-R-Normal--*-100-*
}
# set title for windows
set TITLE "$Control(Title):"
# close the default toplevel window
wm withdraw .
# attach interrupt stuff
#bind all <Control-c> {tcl_interrupt}
# open the command window
# window(open) cmd
# Wait until after my_app_init is called!
}
#
# Routine for setting the wait message and
# making sure all windows are up to date.
#
proc wait_tk msg {
message_push $msg
update
}
#
# Routine for making the stopwatch cursor
#
proc begin_wait {args} {
global window cursor_counter
if {[llength $args] == 0} {
set msg "Computing..."
} {
set msg [lindex $args 0]
}
message_push $msg
if {$cursor_counter == 0} {
foreach w $window(names) {
.$w config -cursor watch
}
grab set .cmd.cmd.main_label
focus .cmd.cmd.main_label
#puts "input grabbed"
}
update
incr cursor_counter
}
#
# Routine for resetting the cursor to arrow
#
proc end_wait {args} {
global window cursor_counter
incr cursor_counter -1
if {$cursor_counter == 0} {
foreach w $window(names) {
.$w config -cursor left_ptr
}
grab release .cmd.cmd.main_label
focus
}
if {[llength $args] > 0} {
message_pop [lindex $args 0]
} else {
message_pop
}
update
}
#
# Interrupt procedure
#
proc tcl_interrupt {} {
set ans [build_Dialog dialog "Interrupt" "Interrupt current computation?" \
0 Interrupt "Exit DSTool" Cancel]
if {$ans == 1} {
exit
} elseif {$ans == 0} {
# INTERRUPT COMPUTATION
puts stderr "interrupting..."
interrupt
}
}
|
