Context Navigation

source: branches/sandbox/distrest.tcl @ 1021

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

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

Download in other formats: