1 | package require Tk |
---|
2 | catch { |
---|
3 | package require tkcon |
---|
4 | tkcon show |
---|
5 | } |
---|
6 | set job(rows) 3 |
---|
7 | set job(cols) 5 |
---|
8 | set job(edit) 1 |
---|
9 | set job(win) .a |
---|
10 | |
---|
11 | proc makeTop {} { |
---|
12 | global job |
---|
13 | catch {destroy $job(win)} |
---|
14 | toplevel $job(win) |
---|
15 | |
---|
16 | grid [canvas $job(win).c -scrollregion {0 0 500 500} -width 100 -height 100 \ |
---|
17 | -xscrollcommand "$job(win).x set" \ |
---|
18 | -yscrollcommand "$job(win).y set"] \ |
---|
19 | -column 1 -row 1 -sticky news |
---|
20 | bind $job(win).c <Configure> ResizeWin |
---|
21 | |
---|
22 | grid columnconfigure $job(win) 1 -weight 1 |
---|
23 | grid rowconfigure $job(win) 1 -weight 1 |
---|
24 | |
---|
25 | grid [scrollbar $job(win).x -orient horizontal \ |
---|
26 | -takefocus 0 -command "$job(win).c xview"] \ |
---|
27 | -column 1 -row 2 -sticky ew |
---|
28 | grid [scrollbar $job(win).y -takefocus 0 \ |
---|
29 | -command "$job(win).c yview"] -column 2 -row 1 -sticky ns |
---|
30 | |
---|
31 | frame [set job(frame) $job(win).c.fr] |
---|
32 | $job(win).c create window 0 0 -anchor nw -window $job(frame) |
---|
33 | grid [frame $job(win).f] -column 1 -row 3 -sticky w |
---|
34 | set col 0 |
---|
35 | grid [label $job(win).f.c1 -text "Columns:"] \ |
---|
36 | -column [incr col] -row 3 |
---|
37 | grid [entry $job(win).f.c2 -textvariable job(cols) -width 4 -takefocus 0] \ |
---|
38 | -column [incr col] -row 3 |
---|
39 | bind $job(win).f.c2 <Return> makeWin |
---|
40 | grid [scrollbar $job(win).f.c3 -command "NewsizeWin cols "] \ |
---|
41 | -column [incr col] -row 3 |
---|
42 | grid [label $job(win).f.r1 -text "Rows:"] \ |
---|
43 | -column [incr col] -row 3 |
---|
44 | grid [entry $job(win).f.r2 -textvariable job(rows) -width 4 -takefocus 0] \ |
---|
45 | -column [incr col] -row 3 |
---|
46 | bind $job(win).f.r2 <Return> makeWin |
---|
47 | grid [scrollbar $job(win).f.r3 -command "NewsizeWin rows "] \ |
---|
48 | -column [incr col] -row 3 |
---|
49 | grid [button $job(win).f.b1 -text "Resize" -command makeWin -takefocus 0] \ |
---|
50 | -column [incr col] -row 3 |
---|
51 | grid [button $job(win).f.b2 -text "Copy\nDown" -command CopyDown -takefocus 0] \ |
---|
52 | -column [incr col] -row 3 |
---|
53 | grid [frame $job(win).f.f] -column [incr col] -row 3 |
---|
54 | grid [radiobutton $job(win).f.f.a -text "Edit entries" -command makeWin -value 1 \ |
---|
55 | -variable job(edit) -takefocus 0] -column 1 -row 1 -sticky w |
---|
56 | grid [radiobutton $job(win).f.f.b -text "Show values" -command makeWin -value 0 \ |
---|
57 | -variable job(edit) -takefocus 0] -column 1 -row 2 -sticky w |
---|
58 | } |
---|
59 | |
---|
60 | proc NewsizeWin {var dir} { |
---|
61 | global job |
---|
62 | #puts job($var) |
---|
63 | if {$dir == -1} { |
---|
64 | incr job($var) |
---|
65 | } else { |
---|
66 | incr job($var) -1 |
---|
67 | } |
---|
68 | makeWin |
---|
69 | } |
---|
70 | |
---|
71 | proc CopyDown {} { |
---|
72 | global job |
---|
73 | set w [focus] |
---|
74 | set frame "" |
---|
75 | set b "" |
---|
76 | set c "" |
---|
77 | regexp {(.*fr)\.([0-9]+)_(.*)} $w junk frame b c |
---|
78 | if {$frame == "" || $b == "" || $c == ""} { |
---|
79 | bell |
---|
80 | return |
---|
81 | } |
---|
82 | set val [$w get] |
---|
83 | for {set r $b} {$r <= $job(rows)} {incr r} { |
---|
84 | $frame.${r}_$c delete 0 end |
---|
85 | $frame.${r}_$c insert 0 $val |
---|
86 | } |
---|
87 | } |
---|
88 | |
---|
89 | proc DupRow {w args} { |
---|
90 | global job |
---|
91 | set val [$w get] |
---|
92 | regexp {(.*)\.([0-9]+)_(.*)} $w junk frame b c |
---|
93 | for {set r $b} {$r <= $job(rows)} {incr r} { |
---|
94 | $frame.${r}_$c delete 0 end |
---|
95 | $frame.${r}_$c insert 0 $val |
---|
96 | } |
---|
97 | } |
---|
98 | |
---|
99 | proc makeWin {args} { |
---|
100 | global job |
---|
101 | eval destroy [winfo children $job(frame)] |
---|
102 | grid [label $job(frame).0_0 -text "\$j" -width 3] -column 0 -row 0 |
---|
103 | grid [label $job(frame).0_d -text "done" -width 3] -column 1 -row 0 |
---|
104 | grid [label $job(frame).0_e -text "GSAS .raw file"] -column 2 -row 0 |
---|
105 | grid [label $job(frame).0_f -text "Starting .EXP file"] -column 3 -row 0 |
---|
106 | for {set c 1} {$c <= $job(cols)} {incr c} { |
---|
107 | set col [expr {$c+4}] |
---|
108 | set i [expr {($c-1) % 26}] |
---|
109 | set char [string range "ABCDEFGHIJKLMNOPQRSTUVWXYZ" $i $i] |
---|
110 | grid [label $job(frame).0_$c -text $char -width 3] -column $col -row 0 |
---|
111 | } |
---|
112 | for {set r 1} {$r <= $job(rows)} {incr r} { |
---|
113 | set j $r |
---|
114 | grid [label $job(frame).${r}_0 -text $r -width 3] -column 0 -row $r |
---|
115 | grid [checkbutton $job(frame).${r}_d -variable job(done$r)] -column 1 -row $r |
---|
116 | #bind $job(frame).${r}_d <Control-c> "DupRow %W" |
---|
117 | bind $job(frame).${r}_d <3> "DupRow %W" |
---|
118 | grid [entry $job(frame).${r}_e -width 15 \ |
---|
119 | -textvariable job(raw$r)] -column 2 -row $r |
---|
120 | bind $job(frame).${r}_e <Control-c> "DupRow %W" |
---|
121 | bind $job(frame).${r}_e <3> "DupRow %W" |
---|
122 | grid [entry $job(frame).${r}_f -width 15 \ |
---|
123 | -textvariable job(exp$r)] -column 3 -row $r |
---|
124 | bind $job(frame).${r}_f <Control-c> "DupRow %W" |
---|
125 | bind $job(frame).${r}_f <3> "DupRow %W" |
---|
126 | for {set c 1} {$c <= $job(cols)} {incr c} { |
---|
127 | set col [expr {$c+4}] |
---|
128 | if $job(edit) { |
---|
129 | grid [entry $job(frame).${r}_$c -width 8 \ |
---|
130 | -textvariable job(val${r}_$c)] -column $col -row $r |
---|
131 | bind $job(frame).${r}_$c <Control-c> "DupRow %W" |
---|
132 | #puts "\n${r}_$c $job(val${r}_$c)" |
---|
133 | } else { |
---|
134 | set val ? |
---|
135 | if {[regexp { *\$([A-Za-z0-9])+ *= *(.*)} \ |
---|
136 | $job(val${r}_$c) junk a b]} { |
---|
137 | catch {set val [subst $b]} |
---|
138 | catch {set val [expr $val]} |
---|
139 | puts "$a = $val" |
---|
140 | set $a $val |
---|
141 | } else { |
---|
142 | #catch {set val [expr $val]} |
---|
143 | #puts "val=$val" |
---|
144 | catch {set val [subst $job(val${r}_$c)]} |
---|
145 | } |
---|
146 | set len [string length $val] |
---|
147 | if {$len < 8} {set len 8} |
---|
148 | grid [label $job(frame).${r}_$c -width $len -relief raised \ |
---|
149 | -text $val] -column $col -row $r |
---|
150 | } |
---|
151 | } |
---|
152 | } |
---|
153 | ResizeWin |
---|
154 | } |
---|
155 | |
---|
156 | proc ResizeWin {} { |
---|
157 | global job |
---|
158 | # resize & show the scroll bars for the canvas |
---|
159 | update idletasks |
---|
160 | set bx $job(win) |
---|
161 | set bbox [grid bbox $bx.c.fr] |
---|
162 | set w [lindex $bbox 2] |
---|
163 | set h [lindex $bbox 3] |
---|
164 | $bx.c config -scrollregion $bbox -width $w -height $h |
---|
165 | update idletasks |
---|
166 | # show the scrolls when needed |
---|
167 | if {[lindex $bbox 3] > [winfo height $bx.c]} { |
---|
168 | grid $bx.y -sticky ns -column 2 -row 1 |
---|
169 | } else { |
---|
170 | grid forget $bx.y |
---|
171 | } |
---|
172 | if {[lindex $bbox 2] > [winfo width $bx.c]} { |
---|
173 | grid $bx.x -sticky ew -column 1 -row 2 |
---|
174 | } else { |
---|
175 | grid forget $bx.x |
---|
176 | } |
---|
177 | } |
---|
178 | |
---|
179 | makeTop |
---|
180 | makeWin |
---|