Context Navigation

source: branches/sandbox/distrest.tcl @ 1013

Last change on this file since 1013 was 1013, checked in by chlake, 13 years ago
save exp file changes before DISAGL
File size: 27.9 KB

Line
1	######################################################################
2	# code for distance restraints (soft constraints)
3	######################################################################
4	#list of global variables and procedures
5
6	#::sr_lookuplist1
7	#::sr_lookuplist2
8	#::sr_top
9	#::sr_checkall
10	#::sr_entryvar(choicenum)
11	#::sr_entryvar(softatom1)
12	#::sr_entryvar(softatom2)
13	#::sr_entryvar(softphase)
14	#::sr_dminvalue
15	#::sr_dmaxvalue
16	#::sr_restraintdist
17	#::sr_restraintesd
18	#::sr_rvalue
19	#::sr_resd
20	#::srcb4.rbutton3
21	#::sr_crestraint
22	#::sr_phaselist
23	#::sr_bond_list
24
25	#SR_Read_Distances
26	#SR_Make_ScrollTable
27	#SR_Resize_Scroll_Table
28	#SR_Display
29	#SR_Set_Rval
30	#SR_Validate_Num
31	#SR_Load_Restraints
32	#SR_Write_Restraints
33	#SR_Update_Restraints
34	#SR_Delete_Restraints
35	#SR_Set_All_Check_Buttons
36	#SR_Build
37
38	proc DisplayDistanceRestraints {args} {
39	global expcons
40	eval destroy [winfo children $expcons(distmaster)]
41
42	set leftfr $expcons(distmaster).f1
43	set rightfr $expcons(distmaster).f2
44	set phasebox $leftfr.f1
45	set editorbox $leftfr.f2
46	set atomfilter $leftfr.f3
47
48	grid [frame $leftfr -bd 2 -relief groove] -column 0 -row 0 \
49	-sticky nsew
50	grid [frame $rightfr -bd 2 -relief groove] -column 1 -row 0 \
51	-sticky nsew
52	grid [frame $phasebox -bd 2 -relief groove] -column 0 -row 0 \
53	-sticky new -columnspan 2
54
55
56	grid [frame $editorbox -bd 2 -relief groove] -column 0 -row 2 \
57	-sticky sew -columnspan 2
58
59
60	grid rowconfigure $expcons(distmaster) 0 -weight 1
61	grid columnconfigure $expcons(distmaster) 1 -weight 1
62
63
64	# Pick Phase to be Evaluated **********************************************
65	label $phasebox.phlabel -text Phase
66	# set ::sr_phaselist $::expmap(phaselist)
67
68	eval tk_optionMenu $phasebox.phase ::sr_entryvar(softphase) $::expmap(phaselist)
69	# eval tk_optionMenu $phasebox.phase ::sr_entryvar(softphase) $::sr_phaselist
70	# trace variable ::sr_entryvar(softphase) w DisplayDistanceRestraints
71	# bind $phasebox.phase <ButtonRelease> {DisplayDistanceRestraints}
72
73	grid $phasebox.phlabel -column 0 -row 0
74	grid $phasebox.phase -column 1 -row 0
75	#**************************************************************************
76
77	#Restraint Weight Control Box
78	grid [label $leftfr.lweight -text "Restraint Weight"] -column 0 -row 1 -sticky sw -pady 10
79	grid [entry $leftfr.weight -width 8 -textvariable entryvar(distrestweight)] -column 1 -row 1 -sticky sw \
80	-padx 5 -pady 10
81	set ::entrycmd(distrestweight) "SoftConst weight"
82	set ::entrycmd(trace) 0
83	set ::entryvar(distrestweight) [SoftConst weight]
84	set ::entrycmd(trace) 1
85
86
87	#Run Disagl Commands *****************************************************
88	#button $leftfr.disagl -text "Refresh Disagl"
89	#grid $leftfr.disagl -column 1 -row 1
90	#**************************************************************************
91
92
93
94	#Activate Restraint Editor
95	grid [button $editorbox.edit -text "Activate Distance \n Restraint Editor" -command SR_TEST] -column 0 -row 3 \
96	-sticky sw -columnspan 2
97	$editorbox.edit config -bg LightGreen -bd 6
98
99
100	foreach {top main side lbl} [MakeScrollTable $rightfr] {}
101
102	set atom1_state 1
103	set atom2_state 1
104
105	button $top.alabel1 -text "Atom 1" -width 7 -anchor center \
106	-command "SR_Sort atom1 $main $top.alabel1 $top.alabel2 {}"
107
108	button $top.alabel2 -text "Atom 2" -width 7 -anchor center \
109	-command "SR_Sort atom2 $main $top.alabel1 $top.alabel2 {}"
110
111	label $top.rlabel1 -text "Restraint" -width 9 -anchor center
112	label $top.rlabel2 -text "esd" -width 9 -anchor center
113
114	grid $top.alabel1 -column 1 -row 2 -padx 3
115	grid $top.alabel2 -column 2 -row 2 -padx 3
116	grid $top.rlabel1 -column 4 -row 2
117	grid $top.rlabel2 -column 5 -row 2
118
119
120	#remove traces to reset ::sr_entryvar(softatom1) and ::sr_entryvar(softatom2)
121	foreach item [trace vinfo ::sr_entryvar(softatom1)] {
122	eval trace vdelete ::sr_entryvar(softatom1) $item
123	}
124	foreach item [trace vinfo ::sr_entryvar(softatom2)] {
125	eval trace vdelete ::sr_entryvar(softatom2) $item
126	}
127	set ::sr_entryvar(softatom1) "all"
128	set ::sr_entryvar(softatom2) "all"
129	#restart traces
130	trace variable ::sr_entryvar(softatom1) w SR_Display
131	trace variable ::sr_entryvar(softatom2) w SR_Display
132
133
134	SR_Rest_Only
135	SR_Show_RestraintsOnly $main $rightfr
136	foreach item [trace vinfo ::sr_entryvar(softphase)] {
137	eval trace vdelete ::sr_entryvar(softphase) $item
138	}
139
140	trace add variable ::sr_entryvar(softphase) write "SR_Show_RestraintsOnly $main $rightfr"
141	}
142	proc SR_Show_RestraintsOnly {main rightfr args} {
143
144	SR_Fill_Display $main
145	ResizeScrollTable $rightfr
146	}
147
148	#*********************************************************************************************
149	#Read Disangle File and Create Bond List (sr_bond_list)**************************************************************************
150	#*********************************************************************************************
151	proc SR_Read_Distances {filename} {
152	# initialiaze
153	catch {unset ::sr_lookuplist1}
154	catch {unset ::sr_lookuplist2}
155	# catch {unset ::sr_restraintdist}
156	# catch {unset ::sr_restraintesd}
157	set ::sr_bond_list ""
158	set ::sr_key_list ""
159
160	#::sr_bond_list 0 - Phase Number
161	# 1, 2 - Atom 1 number, Atom 2 number
162	# 3, 4 - symmetry information
163	# 5, 6, 7 - cell translations
164	# 8 - bond distance
165	# 9, 10 - atom types
166	# 11, 12 - atom labels
167	# 13 - bond id key
168
169
170	# switch to run disagl here someday
171	if {[file exists $filename]} {
172	#puts "$filename from [pwd] is opened"
173	set fh [open $filename r]
174	# puts $fh
175	} else {
176	puts "$filename not found in directory [pwd]"
177	}
178	# read in the file
179	set bond_totals -1
180	while {[gets $fh line] >= 0} {
181	if {[lindex $line 2] == 0} {
182	incr bond_totals
183	set bond_dist_array($bond_totals) $line
184	#puts "$bond_dist_array($bond_totals)"
185	}
186	}
187	#puts "there are [phaseinfo 1 natoms] atoms in the file"
188	#puts "$bond_totals bond distances have been read from the file"
189	close $fh
190
191	#create initial parameter for implimentation of soft restraints
192	catch (unset initsoftpar)
193	set x 0
194
195	#set ::sr_bond_list ""
196	while {$x < $bond_totals} {
197
198	#phase number (0)
199	set initsoftpar($x) [lindex $bond_dist_array($x) 1]
200
201	#atom number 1 (1)
202	lappend initsoftpar($x) [lindex $bond_dist_array($x) 5]
203
204	#atom number 2 (2)
205	lappend initsoftpar($x) [lindex $bond_dist_array($x) 6]
206
207	#extract symmetry information (3, 4)
208	set temp [lindex $bond_dist_array($x) 7]
209	lappend initsoftpar($x) [expr abs($temp) % 100 * abs($temp) / $temp]
210	lappend initsoftpar($x) [expr abs($temp)/100]
211
212	#extract unit cell translations (5, 6, 7)
213	lappend initsoftpar($x) [expr [string index [lindex $bond_dist_array($x) 8] 0] - 5]
214	lappend initsoftpar($x) [expr [string index [lindex $bond_dist_array($x) 8] 1] - 5]
215	lappend initsoftpar($x) [expr [string index [lindex $bond_dist_array($x) 8] 2] - 5]
216
217	#create bond ID code
218	set t2 [string map {" " ""} [set t1 $initsoftpar($x)]]
219
220	# set z [info exists ::sr_restraintdist($t2)]
221	# if {$z == 0} {
222	# set ::sr_restraintdist($t2) ""
223	# set ::sr_restraintesd($t2) ""
224	# }
225
226	#extract bond distance
227	lappend initsoftpar($x) [lindex $bond_dist_array($x) 3]
228
229	#extract atom type and labels
230	set num1 [lindex $bond_dist_array($x) 5]
231	set num2 [lindex $bond_dist_array($x) 6]
232	set type1 [atominfo [lindex $bond_dist_array($x) 1] [lindex $bond_dist_array($x) 5] type]
233	set type1 [lindex [split $type1 {+-}] 0]
234	set type2 [atominfo [lindex $bond_dist_array($x) 1] [lindex $bond_dist_array($x) 6] type]
235	set type2 [lindex [split $type2 {+-}] 0]
236	lappend initsoftpar($x) $type1
237	lappend initsoftpar($x) $type2
238
239	lappend initsoftpar($x) [atominfo [lindex $bond_dist_array($x) 1] [lindex $bond_dist_array($x) 5] label]
240	lappend initsoftpar($x) [atominfo [lindex $bond_dist_array($x) 1] [lindex $bond_dist_array($x) 6] label]
241
242	#puts "$initsoftpar($x)"
243	#set atom types into array
244	set i [lindex $bond_dist_array($x) 1]
245
246
247	lappend ::sr_lookuplist1${i}($type1) $x
248	lappend ::sr_lookuplist2${i}($type2) $x
249
250	#add bond code to list element and key list
251	lappend initsoftpar($x) $t2
252	lappend ::sr_key_list $t2
253
254	#create master list of bonds
255	lappend ::sr_bond_list $initsoftpar($x)
256
257	incr x
258	}
259	}
260
261	#**************************************************************************************
262	# Procedure to sort soft restraints ---------------------------------------------
263	#**************************************************************************************
264	proc SR_Sort {whichbutton main alabel1 alabel2 dlabel1} {
265	# reset all button labels
266	$alabel1 config -text "Atom 1"
267	$alabel2 config -text "Atom 2"
268	if {$dlabel1 != ""} {$dlabel1 config -text "Distance"}
269
270	if {$whichbutton == "atom1"} {
271	if {$::sr_atom1_button == 1} {
272	set sr_prsort [lsort -integer -decreasing -index 1 $::sr_bond_list]
273
274	$alabel1 config -text "Atom 1 \u2193" -width 7
275	} else {
276	set sr_prsort [lsort -integer -increasing -index 1 $::sr_bond_list]
277	$alabel1 config -text "Atom 1 \u2191" -width 7
278	}
279	set x [expr $::sr_atom1_button * -1]
280	set ::sr_atom1_button $x
281	#puts $::sr_atom1_button
282	} elseif {$whichbutton == "atom2"} {
283	if {$::sr_atom2_button == 1} {
284	set sr_prsort [lsort -integer -decreasing -index 2 $::sr_bond_list]
285	$alabel2 config -text "Atom 2 \u2193" -width 7
286	} else {
287	set sr_prsort [lsort -integer -increasing -index 2 $::sr_bond_list]
288	$alabel2 config -text "Atom 2 \u2191" -width 7
289	}
290	set x [expr $::sr_atom2_button * -1]
291	set ::sr_atom2_button $x
292	} else {
293	if {$::sr_distance_button == 1} {
294	#puts "distance"
295	set sr_prsort [lsort -increasing -index 8 $::sr_bond_list]
296	$dlabel1 config -text "Distance \u2193" -width 9
297	} else {
298	set sr_prsort [lsort -decreasing -index 8 $::sr_bond_list]
299	$dlabel1 config -text "Distance \u2191" -width 9
300	}
301	set x [expr $::sr_distance_button * -1]
302	set ::sr_distance_button $x
303	}
304	set ::sr_bond_list $sr_prsort
305	SR_Fill_Display $main
306	}
307	#*********************************************************************************
308	#Procedure to set up soft display ************************************************
309	# used for editing window
310	#*********************************************************************************
311
312	proc SR_Display {args} {
313	#global rprint
314	destroy .mainrestraintbox.sr_rvaluebox
315	set sr_rb .mainrestraintbox.sr_rvaluebox
316	frame $sr_rb
317	pack $sr_rb -side top -fill both -expand 1
318
319	foreach {::sr_top main side lbl} [MakeScrollTable $sr_rb] {}
320	set ::contraintmainbox $main
321
322	button $::sr_top.alabel1 -text "Atom 1 " -width 7 \
323	-command "SR_Sort atom1 $main $::sr_top.alabel1 $::sr_top.alabel2 $::sr_top.dlabel1"
324	button $::sr_top.alabel2 -text "Atom 2 " -width 7 \
325	-command "SR_Sort atom2 $main $::sr_top.alabel1 $::sr_top.alabel2 $::sr_top.dlabel1"
326	button $::sr_top.dlabel1 -text "Distance " -width 9 \
327	-command "SR_Sort distance $main $::sr_top.alabel1 $::sr_top.alabel2 $::sr_top.dlabel1"
328
329	grid $::sr_top.alabel1 -column 1 -row 2
330	grid $::sr_top.alabel2 -column 2 -row 2
331	grid $::sr_top.dlabel1 -column 3 -row 2
332
333	label $::sr_top.rlabel1 -text "Restraint"
334	label $::sr_top.rlabel2 -text "esd"
335	grid $::sr_top.rlabel1 -column 4 -row 2 -padx 20
336	grid $::sr_top.rlabel2 -column 5 -row 2 -padx 20
337
338
339	button $::sr_top.rcon1 -text "Check All" -width 10 -command {
340	set ::sr_checkall 1
341	SR_Set_All_Check_Buttons
342	grid forget $::sr_top.rcon1
343	grid $::sr_top.rcon2 -column 6 -row 2 -padx 5
344	}
345
346	button $::sr_top.rcon2 -text "Clear All" -width 10 -command {
347	set ::sr_checkall 0
348	SR_Set_All_Check_Buttons
349	grid forget $::sr_top.rcon2
350	grid $::sr_top.rcon1 -column 6 -row 2 -padx 5
351	}
352
353	grid $::sr_top.rcon1 -column 6 -row 2 -padx 5
354
355	#SR_Sort atom1 $main
356	SR_Fill_Display $main
357	bind $sr_rb <Configure> "ResizeScrollTable $sr_rb"
358	# see if reset of grab fixes tk bug with tk_optionMenu
359	grab release .mainrestraintbox
360	}
361
362	#*****************************************************************************************
363	#Procedure to fill in sorted Restraint and esd data **************************************
364	# used for both editing windows and restrain-only display in main EXPGUI window
365	#*****************************************************************************************
366	proc SR_Fill_Display {main args} {
367	eval destroy [winfo children $main]
368	set choice $::sr_entryvar(choicenum)
369	set atomreq1 $::sr_entryvar(softatom1)
370	set atomreq2 $::sr_entryvar(softatom2)
371	set phasereq $::sr_entryvar(softphase)
372	set mode [string match "edit" $::sr_display_mode]
373
374	set len [llength $::sr_bond_list]
375	set rownum 0
376	if {[string trim $::sr_dminvalue] == ""} {set ::sr_dminvalue 0}
377	if {[string trim $::sr_dmaxvalue] == ""} {set ::sr_dmaxvalue 1000}
378	for {set i 0} {$i <= $len} {incr i} {
379	set rprint [lindex $::sr_bond_list $i]
380	set atomid1 [lindex $rprint 9]
381	set atomid2 [lindex $rprint 10]
382	if {$::sr_entryvar(softphase) == [lindex $rprint 0]} {
383	if {([lindex $rprint 8] >= $::sr_dminvalue \|\| [lindex $rprint 8] == "?.???") && ([lindex $rprint 8] <= $::sr_dmaxvalue \|\| [lindex $rprint 8] == "?.???")} {
384	if {$atomreq1 == "" \|\| $atomreq1 == "all" \|\| $atomreq1 == $atomid1} {
385	if {$atomreq2 == "" \|\| $atomreq2 == "all" \|\| $atomreq2 == $atomid2} {
386	if {$choice == 0 \|\| ($choice == 1 && [string trim $::sr_restraintdist([lindex $rprint 13])] != "") \
387	\|\| ($choice == 2 && [string trim $::sr_restraintdist([lindex $rprint 13])] == "") } {
388	label $main.ratom1$i -text [lindex $rprint 11] -justify center -anchor center
389	label $main.ratom2$i -text [lindex $rprint 12] -justify center -anchor center
390	if {$mode} {
391	label $main.rdistance$i -text [lindex $rprint 8] -justify center -anchor center
392	entry $main.restraint$i -width 8 -textvariable ::sr_restraintdist([lindex $rprint 13]) -takefocus 1
393	bind $main.restraint$i <KeyRelease> {SR_Validate_Soft %W distance}
394	entry $main.restesd$i -width 8 -textvariable ::sr_restraintesd([lindex $rprint 13]) -takefocus 1
395	bind $main.restesd$i <KeyRelease> {SR_Validate_Soft %W esd}
396	checkbutton $main.sr_crestraint$i -variable ::sr_crestraint([lindex $rprint 13])
397	} else {
398	label $main.restraint$i -width 8 -textvariable ::sr_restraintdist([lindex $rprint 13]) -takefocus 1 -justify center -anchor center
399	label $main.restesd$i -width 8 -textvariable ::sr_restraintesd([lindex $rprint 13]) -takefocus 1 -justify center -anchor center
400	}
401	incr rownum
402	grid $main.ratom1$i -column 1 -row $rownum
403	grid $main.ratom2$i -column 2 -row $rownum
404	if {$mode} {
405	grid $main.rdistance$i -column 3 -row $rownum
406	grid $main.sr_crestraint$i -column 6 -row $rownum
407	$main.ratom1$i conf -width 8
408	$main.ratom2$i conf -width 8
409	$main.rdistance$i conf -width 8
410	bind $main.restraint$i <ButtonPress> {SR_Set_Rval %W}
411	}
412	grid $main.restraint$i -column 4 -row $rownum
413	grid $main.restesd$i -column 5 -row $rownum
414	}
415	}
416	}
417	}
418	}
419	}
420	}
421	#****************************************************************************
422	#Procedure for updating sr_rvalue and sr_resd Boxes *******************************
423	#****************************************************************************
424	proc SR_Set_Rval {window} {
425	set ::sr_rvalue [$window get]
426	set ::sr_resd [[regsub ".f.restraint" $window ".f.restesd"] get]
427	}
428
429	#****************************************************************************
430	#Error Checking Procedures for Entry Boxes **********************************
431	#****************************************************************************
432
433	proc SR_Validate_Num {val1} {
434	# is it a valid number?
435	if {[string trim $val1] != ""} {
436	expr $val1
437	if {$val1 < 0} {error}
438	}
439	}
440
441	proc SR_Validate_Soft {win type} {
442	set val [$win get]
443	if {[catch {
444	SR_Validate_Num $val
445	}]} {
446	# error on validation
447	$win config -fg red
448	$::srcb3.rbutton3 config -bg red -text "Invalid Restraints"
449	set ::sr_error 1
450	} else {
451	# valid value
452	$win config -fg black
453	$::srcb3.rbutton3 config -bg LightGreen -text "Save Restraints to EXP File"
454	set ::sr_error 0
455	}
456	}
457
458	#**************************************************************************************
459	#Procedure to load current restraints, flag presetraints and build restraint only list
460	#**************************************************************************************
461	proc SR_Load_Restraints {args} {
462
463	catch {unset ::sr_restraintdist}
464	catch {unset ::sr_restraintesd}
465	set temp_res [SoftConst restraintlist]
466	set lenr [llength $temp_res]
467
468	#for {set i 0} {$i < $lenr} {incr i} {
469	# set temp_res1 [lindex $temp_res $i]
470	#}
471	foreach temp_res1 $temp_res {
472	set t1 "[lindex $temp_res1 0] [lindex $temp_res1 1] [lindex $temp_res1 2] \
473	[lindex $temp_res1 3] [lindex $temp_res1 4] [lindex $temp_res1 5] \
474	[lindex $temp_res1 6] [lindex $temp_res1 7]"
475	set t2 [string map {" " ""} $t1]
476
477	set test [lsearch -exact $::sr_key_list $t2]
478
479	if {$test == -1} {
480	set new_restraint ""
481	set type1 [atominfo [lindex $temp_res1 0] [lindex $temp_res1 1] type]
482	set type1 [lindex [split $type1 {+-}] 0]
483	set type2 [atominfo [lindex $temp_res1 0] [lindex $temp_res1 2] type]
484	set type2 [lindex [split $type2 {+-}] 0]
485
486	lappend new_restraint [lindex $temp_res1 0] [lindex $temp_res1 1] \
487	[lindex $temp_res1 2] [lindex $temp_res1 3] [lindex $temp_res1 4] \
488	[lindex $temp_res1 5] [lindex $temp_res1 6] [lindex $temp_res1 7] \
489	"?.???" $type1 $type2 \
490	[atominfo [lindex $temp_res1 0] [lindex $temp_res1 1] label] [atominfo [lindex $temp_res1 0] [lindex $temp_res1 2] label] \
491	$t2
492	set x [llength $::sr_bond_list]
493	lappend ::sr_lookuplist1($type1) $x
494	lappend ::sr_lookuplist2($type2) $x
495	lappend ::sr_bond_list $new_restraint
496	}
497	set ::sr_restraintdist($t2) [lindex $temp_res1 8]
498	set ::sr_restraintesd($t2) [lindex $temp_res1 9]
499	}
500	}
501
502
503	#*************************************************************************
504	#write soft restraints to file *******************************************
505	#*************************************************************************
506	proc SR_Write_Restraints { } {
507	if {$::sr_error == 0} {
508	set sr_write ""
509	set new_list ""
510	# set len [llength $::sr_bond_list]
511	set ::sr_key_list ""
512	foreach temp $::sr_bond_list {
513	puts $temp
514	# for {set i 0} {$i <= [expr $len-1]} {incr i} {}
515	# set temp [lindex $::sr_bond_list $i]
516
517	catch {
518	if {[string trim $::sr_restraintdist([lindex $temp 13])] != ""} {
519	set softrest "[lindex $temp 0] [lindex $temp 1] \
520	[lindex $temp 2] [lindex $temp 3] [lindex $temp 4] \
521	[lindex $temp 5] [lindex $temp 6] [lindex $temp 7]\
522	$::sr_restraintdist([lindex $temp 13])\
523	$::sr_restraintesd([lindex $temp 13])"
524	lappend sr_write $softrest
525	puts $softrest
526	lappend new_list $temp
527	}
528	}
529	}
530	#
531	#puts $sr_write
532	# put the entire restraint list back into the .EXP file
533	SoftConst restraintlist set $sr_write
534	set ::sr_bond_list $new_list
535	# indicate a change to the .EXP file
536	incr ::expgui(changed)
537	# close the window and return access to main window
538	destroy .mainrestraintbox
539	set ::sr_display_mode noedit
540	afterputontop
541	SR_Rest_Only
542	DisplayDistanceRestraints
543	} else {
544	bell
545	#puts "invalid restaint / esd. Save aborted"
546	}
547	}
548
549	#*********************************************************************************
550	#Procedure to update restraints *************************************************
551	#*********************************************************************************
552	proc SR_Update_Restraints {args} {
553	foreach i [array names ::sr_crestraint] {
554	if {$::sr_crestraint($i) == 1} {
555	#puts "::sr_restraintdist($i) $::sr_rvalue"
556	set ::sr_restraintdist($i) $::sr_rvalue
557	set ::sr_restraintesd($i) $::sr_resd
558	}
559	}
560	}
561
562	#*******************************************************************************
563	#Procedure to delete restraints ************************************************
564	#*******************************************************************************
565
566	proc SR_Delete_Restraints {args} {
567	foreach i [array names ::sr_crestraint] {
568	if {$::sr_crestraint($i) == 1} {
569	set ::sr_restraintdist($i) ""
570	set ::sr_restraintesd($i) ""
571	}
572	}
573	}
574
575	#*********************************************************************************
576	#set flag for restraint update ***************************************************
577	#*********************************************************************************
578	proc SR_Set_All_Check_Buttons { } {
579	# loop over all widgets in main frame
580	foreach w [winfo children $::contraintmainbox] {
581	# pick out checkboxes which have crest
582	if {[string first crest $w] != -1} {
583	$w deselect
584	if {$::sr_checkall} {
585	$w invoke
586	}
587	}
588	}
589	}
590
591	#*********************************************************************************
592	#Main Program Begin***************************************************************
593	#*********************************************************************************
594	proc SR_Main_Editor {args} {
595
596	catch {destroy .mainrestraintbox}
597	set mrb .mainrestraintbox
598	toplevel $mrb
599	#pack $mrb -side top
600	wm title $mrb "Soft Restraint Control Panel for Phase $::sr_entryvar(softphase)"
601	#wm geometry $mrb 415x500+10+10
602	#wm geometry $mrb {}
603	set srcb1 $mrb.srconbox1
604	set srcb2 $mrb.srconbox2
605	set ::srcb3 $mrb.srconbox3
606	frame $srcb1 -bd 2 -relief groove -pady 5
607	frame $srcb2 -bd 2 -relief groove -pady 5
608	frame $::srcb3 -bd 2 -relief groove -pady 5
609	pack $srcb1 -side top -anchor w -fill x
610	pack $srcb2 -side top -anchor w -fill x
611	pack $::srcb3 -side bottom -anchor w -fill x
612
613	label $srcb1.atomlabel1 -text "Atom 1 Filter"
614	label $srcb1.atomlabel2 -text "Atom 2 Filter"
615	label $srcb1.dminlabel -text "Dmin"
616	label $srcb1.dmaxlabel -text "Dmax"
617	label $srcb2.restlabel -text "Restraint Value" -width 16 -anchor w
618	label $srcb2.restlabelesd -text "esd"
619
620	eval tk_optionMenu $srcb1.atom1 ::sr_entryvar(softatom1) "[lsort [array names ::sr_lookuplist1${::sr_entryvar(softphase)}]] all"
621	eval tk_optionMenu $srcb1.atom2 ::sr_entryvar(softatom2) "[lsort [array names ::sr_lookuplist2${::sr_entryvar(softphase)}]] all"
622
623
624	entry $srcb1.sr_dminvalue -width 8 -textvariable ::sr_dminvalue -takefocus 1
625	entry $srcb1.sr_dmaxvalue -width 8 -textvariable ::sr_dmaxvalue -takefocus 1
626	entry $srcb2.sr_rvalue -width 8 -textvariable ::sr_rvalue -takefocus 1
627	entry $srcb2.sr_resd -width 8 -textvariable ::sr_resd -takefocus 1
628
629	bind $srcb1.sr_dminvalue <KeyRelease> {SR_Validate_Soft %W dmin}
630	bind $srcb1.sr_dmaxvalue <KeyRelease> {SR_Validate_Soft %W dmax}
631	bind $srcb2.sr_rvalue <KeyRelease> {SR_Validate_Soft %W sr_rvalue}
632	bind $srcb2.sr_resd <KeyRelease> {SR_Validate_Soft %W sr_resd}
633
634	button $srcb1.recalc -text "Filter" -bd 6 -command {SR_Display}
635	button $srcb2.rbutton1 -text "check update" -command {SR_Update_Restraints}
636	button $srcb2.rbutton2 -text "check delete" -command {SR_Delete_Restraints}
637	button $::srcb3.rbutton3 -text "Save Restraints to EXP File" -bd 6 -bg LightGreen -command {SR_Write_Restraints}
638	button $::srcb3.rbutton4 -text "Cancel" -command {destroy .mainrestraintbox
639	afterputontop
640	SR_Rest_Only
641	DisplayDistanceRestraints}
642	wm protocol .mainrestraintbox WM_DELETE_WINDOW {destroy .mainrestraintbox
643	afterputontop
644	SR_Rest_Only
645	DisplayDistanceRestraints}
646
647	grid $srcb1.atomlabel1 -column 1 -row 0
648	grid $srcb1.atom1 -column 2 -row 0
649	$srcb1.atom1 conf -width 2
650	grid $srcb1.atomlabel2 -column 1 -row 1
651	grid $srcb1.atom2 -column 2 -row 1
652	$srcb1.atom2 conf -width 2
653	grid $srcb1.recalc -column 4 -row 2 -padx 5
654	$srcb1.recalc conf -width 7
655
656	grid $srcb1.dminlabel -column 3 -row 0
657	grid $srcb1.sr_dminvalue -column 4 -row 0
658	grid $srcb1.dmaxlabel -column 3 -row 1
659	grid $srcb1.sr_dmaxvalue -column 4 -row 1
660
661
662	set choice {"Show All Bonds" "Restrained Bonds" "Unrestrained Bonds"}
663
664	set m1 [eval tk_optionMenu $srcb1.rcon3 sr_entryvar(choice) $choice]
665	# set up a variable to track menu choices by number. Do this by adding a command
666	# to each item in the option menu
667	foreach i {0 1 2} {
668	$m1 entryconfig $i -command "set ::sr_entryvar(choicenum) $i"
669	}
670	grid $srcb1.rcon3 -column 1 -row 2 -padx 5
671	$srcb1.rcon3 config -width 23
672	grid configure $srcb1.rcon3 -columnspan 2
673
674	grid $srcb2.restlabel -column 0 -row 3 -sticky w
675	grid $srcb2.sr_rvalue -column 1 -row 3
676	grid $srcb2.restlabelesd -column 2 -row 3
677	grid $srcb2.sr_resd -column 3 -row 3
678	grid $srcb2.rbutton1 -column 4 -row 3 -padx 5
679	grid $srcb2.rbutton2 -column 5 -row 3 -padx 5
680
681	grid $::srcb3.rbutton3 -column 0 -row 0
682	grid $::srcb3.rbutton4 -column 0 -row 1 -pady 5
683
684	# remove traces
685	foreach item [trace vinfo ::sr_entryvar(softatom1)] {
686	eval trace vdelete ::sr_entryvar(softatom1) $item
687	}
688	foreach item [trace vinfo ::sr_entryvar(softatom2)] {
689	eval trace vdelete ::sr_entryvar(softatom2) $item
690	}
691	foreach item [trace vinfo ::sr_entryvar(choicenum)] {
692	eval trace vdelete ::sr_entryvar(choicenum) $item
693	}
694	# reset filter vars
695	set ::sr_entryvar(choice) "Show All Bonds"
696	set ::sr_entryvar(choicenum) 0
697	set ::sr_entryvar(softatom1) "all"
698	set ::sr_entryvar(softatom2) "all"
699	# search out distances
700	SR_Display
701	# set traces for future changes to filter vars
702	trace variable ::sr_entryvar(softatom1) w SR_Display
703	trace variable ::sr_entryvar(choicenum) w SR_Display
704	trace variable ::sr_entryvar(softatom2) w SR_Display
705	# make editor window modal (lock it on top)
706	putontop $mrb
707	}
708	#************************************************************************
709	#Procedure to Initialize variables ***************************************
710	#*************************************************************************
711	proc SR_Initialize {} {
712	set ::sr_atom1_button 1
713	set ::sr_atom2_button 1
714	set ::sr_distance_button 1
715	set ::sr_entryvar(choicenum) 0
716	# set ::sr_entryvar(softphase) "1"
717	# set ::sr_phaselist $::expmap(phaselist)
718	set ::sr_entryvar(softatom1) "all"
719	set ::sr_entryvar(softatom2) "all"
720	set ::sr_phaselist $::expmap(phaselist)
721	set ::sr_error 0
722	set ::sr_bond_list ""
723	set ::sr_dminvalue 0
724	set ::sr_dmaxvalue 1000
725	set ::sr_display_mode noedit
726	set ::sr_key_list ""
727	#SR_Rest_Only
728	}
729
730	# load restraints w/o distances
731	proc SR_Rest_Only {} {
732	set ::sr_display_mode noedit
733	catch {unset ::sr_lookuplist1}
734	catch {unset ::sr_lookuplist2}
735	set ::sr_bond_list ""
736	set ::sr_key_list ""
737	SR_Load_Restraints
738	}
739
740	# load distances, restraints and make editing box
741	proc SR_TEST {} {
742	# Run DISAGL
743	global expgui
744	pleasewait "searching interatomic distances"
745	# save EXP file if changed
746	savearchiveexp
747	set root [file root $expgui(expfile)]
748	catch {file delete -force $root.disagl}
749	set ::sr_display_mode edit
750	close [open disagl.inp w]
751	catch {exec [file join $expgui(gsasexe) disagl] \
752	[file tail $root] < disagl.inp > disagl.out}
753	catch {file delete -force disagl.inp disagl.out}
754	if {! [file exists $root.disagl]} {
755	MyMessageBox -parent . -title "DISAGL Problem" \
756	-message "Unable to run DISAGL. Do you have problems writing files in [pwd]?" \
757	-icon error
758	donewait
759	return
760	}
761	# load DISAGL distances
762	SR_Read_Distances $root.disagl
763	SR_Load_Restraints
764	SR_Main_Editor
765	donewait
766	}
767
768	#expload TEST3.EXP
769	#mapexp
770	SR_Initialize
771	#SR_Read_Distances test2.disagl
772	#SR_Load_Restraints
773	#SR_Main_Editor
774	#SR_Load_Restraints
775
776

Note: See TracBrowser for help on using the repository browser.

Download in other formats: