source: trunk/jobsheet.tcl @ 1253

Last change on this file since 1253 was 1251, checked in by toby, 7 years ago

use svn ps svn:eol-style "native" * to change line ends

  • Property svn:eol-style set to native
File size: 5.7 KB
Line 
1package require Tk
2catch {
3    package require tkcon
4    tkcon show
5}
6set job(rows) 3
7set job(cols) 5
8set job(edit) 1
9set job(win) .a
10
11proc 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
60proc 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
71proc 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
89proc 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
99proc 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 3 -row 0
105    grid [label $job(frame).0_f -text "Starting .EXP file"] -column 4 -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            if {$c == -1} {
128                set suffix ${r}_e
129                set width 15
130            } elseif {$c == 0} {
131                set suffix ${r}_f
132                set width 15
133            } else {
134                set suffix ${r}_$c
135                set width 8
136            }
137            set col [expr {$c+4}]
138            if $job(edit) {
139                grid [entry $job(frame).$suffix -width $width \
140                          -textvariable job(val$suffix)] -column $col -row $r
141                bind $job(frame).$suffix <Control-c> "DupRow %W"
142                #puts "\n$suffix $job(val$suffix)"
143            } else {
144                set val ?
145                if {[regexp { *\$([A-Za-z0-9])+ *= *(.*)} \
146                         $job(val$suffix) junk a b]} {
147                    catch {set val [subst $b]}
148                    catch {set val [expr $val]}
149                    puts "$a = $val"
150                    set $a $val
151                } else {
152                    #catch {set val [expr $val]}
153                    #puts "val=$val"
154                    catch {set val [subst $job(val$suffix)]}
155                }
156                set len [string length $val]
157                if {$len < $width} {set len $width}
158                grid [label $job(frame).$suffix -width $len -relief raised \
159                          -text $val] -column $col -row $r
160            }
161        }
162    }
163    ResizeWin
164}
165
166proc ResizeWin {} {
167    global job
168    # resize & show the scroll bars for the canvas
169    update idletasks
170    set bx $job(win)
171    set bbox [grid bbox $bx.c.fr]
172    set w [lindex $bbox 2]
173    set h [lindex $bbox 3]
174    $bx.c config -scrollregion $bbox -width $w -height $h
175    update idletasks
176    # show the scrolls when needed
177    if {[lindex $bbox 3] > [winfo height $bx.c]} {
178        grid $bx.y -sticky ns -column 2 -row 1
179    } else {
180        grid forget $bx.y 
181    }
182    if {[lindex $bbox 2] > [winfo width $bx.c]} {
183        grid $bx.x -sticky ew -column 1 -row 2
184    } else {
185        grid forget $bx.x
186    }
187}
188
189makeTop
190makeWin
Note: See TracBrowser for help on using the repository browser.