Changeset 997

Timestamp:

Sep 7, 2010 12:58:41 PM (10 years ago)

Author:

toby

Message:

fix awful bug introduced with prev. code rearangement that should not have been checked in; add ability to read archived files from command line; Add routines to read and write soft constrain records

Location:

trunk

Files:

• expgui (modified) (2 diffs)
• readexp.tcl (modified) (1 diff)

trunk/expgui

@@ -53 +53 @@
 if {$argv != ""} {
     if {[string match *noshell* [string tolower $argv]]} {
-        #puts noshell
+        # I doubt that noshell mode is used by anyone
         set expgui(shell) 0
-        SetEXPfile [lindex $argv 1]
+        set expgui(expfile)  [lindex $argv 1]
     } else {
-        SetEXPfile [lindex $argv 0]
-    }
-    if {[string match -nocase {.o[0-9a-f][0-9a-f]} \
-             [file extension $expgui(expfile)]]} {
-        # this is an archived file -- need to handle this later
-        tk_dialog .expFileErrorMsg "No archived files yet" \
-            "At present you must use open (expnam) to open archived files" warning 0 "Continue"
-        set expgui(expfile) {}
-    } 
+        set expgui(expfile)  [lindex $argv 0]
+    }
 }
 
@@ -299 +292 @@
 }
 #---------------------------------------------------------------------------
+if {$expgui(expfile) != ""} {
+    if {[string match -nocase {.o[0-9a-f][0-9a-f]} \
+             [file extension $expgui(expfile)]]} {
+        if {[file exists $expgui(expfile)]} {
+            # this is an archived file -- archive the current .EXP file
+            set expnam [file rootname $expgui(expfile)]
+            # get the last archived version
+            set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
+            if {$lastf == ""} {
+                set num 01
+            } else {
+                regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
+                scan $num %x num
+                if {$num >= 255} {
+                    set num FF
+                } else {
+                    set num [string toupper [format %.2x [incr num]]]
+                }
+            }
+            catch {
+                set newfile $expnam.O$num
+                file rename -force $expnam.EXP $newfile
+                set fp [open $expnam.LST a+]
+                puts $fp "\n----------------------------------------------"
+                puts $fp "     Regressing to archive file [file tail $expgui(expfile)]"
+                puts $fp "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
+                puts $fp "----------------------------------------------\n"
+                close $fp
+            }
+            file copy -force $expgui(expfile) $expnam.EXP
+            set expgui(expfile) $expnam.EXP
+        } else {
+            MyMessageBox -parent . -title "File not found" \
+                -message "Warning -- Archive file $expgui(expfile) was not found." \
+                -icon warning -type OK -default ok
+            set expgui(expfile) {}
+        }
+    } else {
+        SetEXPfile $expgui(expfile)
+    }
+}
 if {$expgui(expfile) == ""} {
     # place the parent window because the getExpFileName window will be centered above it.

trunk/readexp.tcl

@@ -2831 +2831 @@
 }
 
+proc GetSoftConst {} {
+    set HST {}
+    # look for RSN record
+    #set n 0
+    for {set i 0} {$i < $::expmap(nhst)} {incr i} {
+        set ihist [expr {$i + 1}]
+        if {[expr {$i % 12}] == 0} {
+            incr n
+            set line [readexp " EXPR  HTYP$n"]
+            if {$line == ""} {
+                set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file"
+                tk_dialog .badexp "Error in readexp" $msg error 0 Exit 
+            }
+            set j 0
+        } else {
+            incr j
+        }
+        if {[string range $line [expr 2+5*$j] [expr 5*($j+1)]] == "RSN "} {
+            set HST $ihist
+        }
+    }
+    if {$HST == ""} {return "" ""}
+    if {$HST <=9} {
+        set key "HST  $HST"
+    } else {
+        set key "HST $HST"
+    }
+    set factr [string trim [string range [readexp "$key FACTR"] 0 14]]
+    set ncons [string trim [string range [readexp "$key NBNDS"] 0 4]]
+    set conslist {}
+    for {set i 1} {$i <= $ncons} {incr i} {
+        set fi [string toupper [format %.4x $i]]
+        lappend conslist [string trim [readexp "${key}BD$fi"]]  
+    }
+    return [list $factr $conslist]
+}
+
+proc SetSoftCons {factr conslist} {
+    set HST {}
+    # look for RSN record
+    set n 0
+    for {set i 0} {$i < $::expmap(nhst)} {incr i} {
+        set ihist [expr {$i + 1}]
+        if {[expr {$i % 12}] == 0} {
+            incr n
+            set line [readexp " EXPR  HTYP$n"]
+            if {$line == ""} {
+                set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file"
+                tk_dialog .badexp "Error in readexp" $msg error 0 Exit 
+            }
+            set j 0
+        } else {
+            incr j
+        }
+        if {[string range $line [expr 2+5*$j] [expr 5*($j+1)]] == "RSN "} {
+            set HST $ihist
+        }
+    }
+    if {$HST == ""} {
+        # no RSN found need to add the soft constr. histogram
+        # increment number of histograms
+        set hst [string trim [string range [readexp { EXPR  NHST }] 0 4]]
+        incr hst
+        set HST $hst
+        if ![validint hst 5] {return 0}
+        setexp  { EXPR  NHST } $hst 1 5
+        # add to EXPR HTYPx rec, creating if needed 
+        set n [expr { 1+ (($HST - 1) / 12) }]
+        set key " EXPR  HTYP$n"
+        if {[array names ::exparray $key] == ""} {
+            makeexprec $key
+        }
+        setexp $key "RSN" [expr 3 + 5*(($HST-1) % 12)] 5
+        # create other HST  xx recs
+        if {$HST <=9} {
+            set key "HST  $HST"
+        } else {
+            set key "HST $HST"
+        }
+        makeexprec "$key  HNAM"
+        setexp "$key  HNAM" "Bond distance restraints" 3 24
+        makeexprec "$key FACTR"
+        makeexprec "$key NBNDS"
+    }
+    # update histogram 
+    if {$HST <=9} {
+        set key "HST  $HST"
+    } else {
+        set key "HST $HST"
+    }
+    # update FACTR
+    if ![validreal factr 15 6] {return 0}
+    setexp "$key FACTR" $factr 1 15
+    set num [llength $conslist]
+    if ![validint num 5] {return 0}
+    setexp "$key NBNDS" $num 1 5
+    # delete all old records
+    foreach i [array names ::exparray "${key}BD*"] {unset ::exparray($i)}
+    set i 0
+    foreach cons $conslist {
+        incr i
+        set fi [string toupper [format %.4x $i]]
+        makeexprec "${key}BD$fi"
+        set pos 1
+        foreach num $cons len {3 5 5 3 3 3 3 3 -6 -6} {
+            if {$len > 0} {
+                validint num $len
+                setexp "${key}BD$fi" $num $pos $len
+            } else {
+                set len [expr abs($len)]
+                validreal num $len 3
+                setexp "${key}BD$fi" $num $pos $len
+            }
+            incr pos $len
+        }
+    }
+}
 #======================================================================
 # conversion routines