Changeset 1189

Timestamp:

Feb 6, 2012 5:03:22 PM (9 years ago)

Author:

toby

Message:

fix bug in releasing fixed atoms; finish interface for fixed parms in readexp

Location:

branches/sandbox

Files:

• addcmds.tcl (modified) (3 diffs)
• expgui (modified) (1 diff)
• readexp.tcl (modified) (4 diffs)

branches/sandbox/addcmds.tcl

@@ -1962 +1962 @@
     if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
         grid [TitleFrame $w.10 -bd 6 -relief groove \
-                -text "Fix Atom$suffix Coordinates"] \
-                -row 9 -column 0 -columnspan 10 -sticky news
+                  -text "Fix Coordinates for Atom$suffix"] \
+            -row 9 -column 0 -columnspan 10 -sticky news
         set fix [$w.10 getframe]
-        Fix_Initialize $numberList
+        # set button labels
+        set ::fixbtn_lbl(X) [Fix_State $phase $numberList X]
+        set ::fixbtn_lbl(Y) [Fix_State $phase $numberList Y]
+        set ::fixbtn_lbl(Z) [Fix_State $phase $numberList Z]
 
         label $fix.xlab -text "  x  " -width 8
@@ -1975 +1978 @@
 
 
-        button $fix.x -text "$::fix_state_X" -width 8 \
-               -command "Fix_Atoms $phase [list $numberList] X $fix.x;
-               Fix_Write
-               DisplayAllAtoms $phase"
-
-        button $fix.y -text "$::fix_state_Y" -width 8 \
-                -command "Fix_Atoms $phase [list $numberList] Y $fix.y
-                Fix_Write
-                DisplayAllAtoms $phase"
-        button $fix.z -text "$::fix_state_Z" -width 8 \
-                -command "Fix_Atoms $phase [list $numberList] Z $fix.z
-                Fix_Write
-                DisplayAllAtoms $phase"
+        button $fix.x -textvariable fixbtn_lbl(X) -width 8 \
+            -command "Fix_Atoms $phase [list $numberList] X"
+        button $fix.y -textvariable fixbtn_lbl(Y) -width 8 \
+            -command "Fix_Atoms $phase [list $numberList] Y"
+        button $fix.z -textvariable fixbtn_lbl(Z) -width 8 \
+            -command "Fix_Atoms $phase [list $numberList] Z"
         grid $fix.x -row 3 -column 0
         grid $fix.y -row 3 -column 1
@@ -2012 +2008 @@
 }
 
-#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x
-
-proc Fix_Initialize {numberList} {
-     set phaselist $::expmap(phaselist)
-     catch {unset ::fix_param}
-     foreach i $phaselist {
-             set ::fix_list(X,$i) ""
-             set ::fix_list(Y,$i) ""
-             set ::fix_list(Z,$i) ""
-
-             set temp [atom_constraint_read $i]
-             foreach j $temp {
-                     set atomnum [string trim [string range $j 2 3]]
-                     set param [string trim [string range $j 4 6]]
-                     set ::fix_param($i,$atomnum,$param) 1
-                     if {$param == "X"} {lappend ::fix_list(X,$i) $atomnum}
-                     if {$param == "Y"} {lappend ::fix_list(Y,$i) $atomnum}
-                     if {$param == "Z"} {lappend ::fix_list(Z,$i) $atomnum}
-             }
-     }
-    set ::fix_state_X [Fix_State $i $numberList X]
-    set ::fix_state_Y [Fix_State $i $numberList Y]
-    set ::fix_state_Z [Fix_State $i $numberList Z]
-}
-
+# test the fixed status of variable for several atoms
 proc Fix_State {phase numberList coord} {
-     set status_fixed "-1"
-     set status_unfixed "-1"
-     #puts "$coord before: $status_fixed $status_unfixed"
-     foreach i $numberList {
-         set temp [info exists ::fix_param($phase,$i,$coord)]
-         #puts "::fix_param($phase,$i,$coord) is variable present?: $temp"
-         if {$temp != 0} {set status_fixed 1}
-         if {$temp == 0} {set status_unfixed 1}
-     }
-     #puts "$coord after $status_fixed $status_unfixed"
-     if {$status_fixed == 1 && $status_unfixed != 1} {return "fixed"}
-     if {$status_fixed == 1 && $status_unfixed == 1} {return "mixed"}
-     if {$status_fixed != 1 && $status_unfixed == 1} {return "unfixed"}
-}
-
-proc Fix_Write {} {
-      incr ::expgui(changed)
-      #puts "Prepare to write [array names ::fix_Param]"
-      foreach j [array names ::fix_param] {
-             regexp {[0-9]+} $j  temp_phase
-             regexp {,[0-9]+} $j ans
-             set temp_atom [string range $ans 1 end]
-             regexp {[a-zA-Z]+} $j temp_param
-             if {$temp_param == "U"} {regexp {[a-zA-Z]+[0-9]+} $j temp_param}
-             set temp_entry [format "%1s %+2s%-4s" $temp_phase $temp_atom $temp_param]
-             lappend fix_list($temp_phase) $temp_entry
-     }
-     set phaselist $::expmap(phaselist)
-     foreach i $phaselist {
-             catch {atom_constraint_write $i $fix_list($i)}
-             catch  {RecordMacroEntry "catch {atom_constraint_write $i $fix_list($i)}" 0}
-             #puts $fix_list($i)
-     }
-}
-
-proc Fix_Atoms {phase numberList coord but} {
-#     puts "before  ::fix_state_$coord [set ::fix_state_$coord]"
-     #puts " before operationi: $::fix_list($coord,$phase)"
-     switch [set ::fix_state_$coord] {
-     "unfixed" {$but config -text "fixed"
-               set ::fix_state_$coord "fixed"
-               }
-     "fixed"   {$but config -text "unfixed"
-               set ::fix_state_$coord "unfixed"
-               }
-     "mixed"   {$but config -text "unfixed"
-               set ::fix_state_$coord "unfixed"
-               }
-     }
-     if {[set ::fix_state_$coord] == "fixed"} {
-        #puts "fixing atom number $numberList"
-        foreach i $numberList {
-                lappend ::fix_list($coord,$phase) $i
-                set ::fix_list($coord,$phase) [lsort -uniq -integer $::fix_list($coord,$phase)]
-                set ::fix_param($phase,$i,$coord) 1
+    set status_fixed 0
+    set status_unfixed 0
+    #puts "$coord before: $status_fixed $status_unfixed"
+    foreach i $numberList {
+        set temp [atom_constraint_get $phase $i $coord]
+        if {$temp == 0} {
+            set status_unfixed 1
+        } else {
+            set status_fixed 1
         }
-     }
-     if {[set ::fix_state_$coord] == "unfixed"} {
-        #puts "unfixing atoms $numberList"
-        foreach i $numberList {
-           set temp [lsearch $::fix_list($coord,$phase) $i]
-           if {$temp != -1} {
-              set ::fix_list($coord,$phase) [lreplace $::fix_list($coord,$phase) $temp $temp]
-              catch {unset ::fix_param($phase,$i,$coord)}
-           }
+        if {$status_fixed == 1 && $status_unfixed == 1} {
+            return "fix\nsome"
         }
-     }
-     #puts "after operation: $::fix_list($coord,$phase)"
+    }
+    #puts "$coord after $status_fixed $status_unfixed"
+    if {$status_fixed == 0} {return "fix"}
+    return "release"
+}
+
+# fix or release the selected atoms
+proc Fix_Atoms {phase numberList coord} {
+    if {$::fixbtn_lbl($coord) == "release"} {
+        set ::fixbtn_lbl($coord) "fix"
+        set mode 0
+    } else {
+        set ::fixbtn_lbl($coord) "release"
+        set mode 1
+    }
+    atom_constraint_set $phase $numberList $coord $mode
+    incr ::expgui(changed)
+    RecordMacroEntry "atom_constraint_set $phase [list $numberList] $coord $mode" 0
+    RecordMacroEntry "incr expgui(changed)" 0
+    DisplayAllAtoms $phase
 }
 

branches/sandbox/expgui

@@ -1337 +1337 @@
     # is this fixed?
     set param [string toupper $var]
-    if {[array name ::fix_param "$phase,$atom,$param"] != ""} {
-        return [format "%9.5fF" [atominfo $phase $atom $var]]
+    if {[atom_constraint_get $phase $atom $param]} {
+        return [format "%9.5ff" [atominfo $phase $atom $var]]
     }
     # is this atom in a rigid body?

branches/sandbox/readexp.tcl

@@ -2243 +2243 @@
 }
 
-#  read fixed constraints
-
+#  read fixed constraints for a phase
 proc atom_constraint_read {phase} {
-    set fix_list ""
+    set fixlist ""
     foreach k {1 2 3 4 5 6 7 8 9} {
         set key [format "LEQV HOLD%1d%2d" $phase $k]
@@ -2252 +2251 @@
         foreach j {2 10 18 26 34 42 50 58} {
             set fix_param [string range $line $j [expr $j+7]]
-            if {[string trim $fix_param] == ""} {return $fix_list}
-            lappend fix_list $fix_param
-        }
-    }
+            if {[string trim $fix_param] == ""} {return $fixlist}
+            lappend fixlist $fix_param
+        }
+    }
+    return $fixlist
 }
 
@@ -2271 +2271 @@
 }
 
-proc atom_constraint_write {phase fix_list} {
+# returns 1 if the specified variable is fixed
+proc atom_constraint_get {phase atom type} {
+    if {[array names ::fix_param "$phase,$atom,$type"] == ""} {
+        return 0
+    }
+    return 1
+}
+
+proc atom_constraint_set {phase atomlist type mode} {
+    foreach atom $atomlist {
+        set key "$phase,$atom,$type"
+        if {$mode} {
+            set ::fix_param($key) 1
+        } else {
+            array unset ::fix_param $key
+        }
+    } 
+    set fixlist {}
+    foreach key [array names ::fix_param "$phase,*"] {
+        foreach {j atom parm} [split $key ","] {}
+        lappend fixlist \
+            [format "%1s %+2s%-4s" $phase $atom $parm]
+    }
     foreach key [array names ::exparray "LEQV HOLD$phase*"] {
         delexp $key
@@ -2278 +2300 @@
     set j 1
     set line ""
-    foreach fix $fix_list {
+    foreach fix $fixlist {
         incr k
         append line $fix