Changeset 997


Ignore:
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:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/expgui

    r996 r997  
    5353if {$argv != ""} {
    5454    if {[string match *noshell* [string tolower $argv]]} {
    55         #puts noshell
     55        # I doubt that noshell mode is used by anyone
    5656        set expgui(shell) 0
    57         SetEXPfile [lindex $argv 1]
     57        set expgui(expfile) [lindex $argv 1]
    5858    } else {
    59         SetEXPfile [lindex $argv 0]
    60     }
    61     if {[string match -nocase {.o[0-9a-f][0-9a-f]} \
    62              [file extension $expgui(expfile)]]} {
    63         # this is an archived file -- need to handle this later
    64         tk_dialog .expFileErrorMsg "No archived files yet" \
    65             "At present you must use open (expnam) to open archived files" warning 0 "Continue"
    66         set expgui(expfile) {}
    67     }
     59        set expgui(expfile)  [lindex $argv 0]
     60    }
    6861}
    6962
     
    299292}
    300293#---------------------------------------------------------------------------
     294if {$expgui(expfile) != ""} {
     295    if {[string match -nocase {.o[0-9a-f][0-9a-f]} \
     296             [file extension $expgui(expfile)]]} {
     297        if {[file exists $expgui(expfile)]} {
     298            # this is an archived file -- archive the current .EXP file
     299            set expnam [file rootname $expgui(expfile)]
     300            # get the last archived version
     301            set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
     302            if {$lastf == ""} {
     303                set num 01
     304            } else {
     305                regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
     306                scan $num %x num
     307                if {$num >= 255} {
     308                    set num FF
     309                } else {
     310                    set num [string toupper [format %.2x [incr num]]]
     311                }
     312            }
     313            catch {
     314                set newfile $expnam.O$num
     315                file rename -force $expnam.EXP $newfile
     316                set fp [open $expnam.LST a+]
     317                puts $fp "\n----------------------------------------------"
     318                puts $fp "     Regressing to archive file [file tail $expgui(expfile)]"
     319                puts $fp "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
     320                puts $fp "----------------------------------------------\n"
     321                close $fp
     322            }
     323            file copy -force $expgui(expfile) $expnam.EXP
     324            set expgui(expfile) $expnam.EXP
     325        } else {
     326            MyMessageBox -parent . -title "File not found" \
     327                -message "Warning -- Archive file $expgui(expfile) was not found." \
     328                -icon warning -type OK -default ok
     329            set expgui(expfile) {}
     330        }
     331    } else {
     332        SetEXPfile $expgui(expfile)
     333    }
     334}
    301335if {$expgui(expfile) == ""} {
    302336    # place the parent window because the getExpFileName window will be centered above it.
  • trunk/readexp.tcl

    r992 r997  
    28312831}
    28322832
     2833proc GetSoftConst {} {
     2834    set HST {}
     2835    # look for RSN record
     2836    #set n 0
     2837    for {set i 0} {$i < $::expmap(nhst)} {incr i} {
     2838        set ihist [expr {$i + 1}]
     2839        if {[expr {$i % 12}] == 0} {
     2840            incr n
     2841            set line [readexp " EXPR  HTYP$n"]
     2842            if {$line == ""} {
     2843                set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file"
     2844                tk_dialog .badexp "Error in readexp" $msg error 0 Exit
     2845            }
     2846            set j 0
     2847        } else {
     2848            incr j
     2849        }
     2850        if {[string range $line [expr 2+5*$j] [expr 5*($j+1)]] == "RSN "} {
     2851            set HST $ihist
     2852        }
     2853    }
     2854    if {$HST == ""} {return "" ""}
     2855    if {$HST <=9} {
     2856        set key "HST  $HST"
     2857    } else {
     2858        set key "HST $HST"
     2859    }
     2860    set factr [string trim [string range [readexp "$key FACTR"] 0 14]]
     2861    set ncons [string trim [string range [readexp "$key NBNDS"] 0 4]]
     2862    set conslist {}
     2863    for {set i 1} {$i <= $ncons} {incr i} {
     2864        set fi [string toupper [format %.4x $i]]
     2865        lappend conslist [string trim [readexp "${key}BD$fi"]] 
     2866    }
     2867    return [list $factr $conslist]
     2868}
     2869
     2870proc SetSoftCons {factr conslist} {
     2871    set HST {}
     2872    # look for RSN record
     2873    set n 0
     2874    for {set i 0} {$i < $::expmap(nhst)} {incr i} {
     2875        set ihist [expr {$i + 1}]
     2876        if {[expr {$i % 12}] == 0} {
     2877            incr n
     2878            set line [readexp " EXPR  HTYP$n"]
     2879            if {$line == ""} {
     2880                set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file"
     2881                tk_dialog .badexp "Error in readexp" $msg error 0 Exit
     2882            }
     2883            set j 0
     2884        } else {
     2885            incr j
     2886        }
     2887        if {[string range $line [expr 2+5*$j] [expr 5*($j+1)]] == "RSN "} {
     2888            set HST $ihist
     2889        }
     2890    }
     2891    if {$HST == ""} {
     2892        # no RSN found need to add the soft constr. histogram
     2893        # increment number of histograms
     2894        set hst [string trim [string range [readexp { EXPR  NHST }] 0 4]]
     2895        incr hst
     2896        set HST $hst
     2897        if ![validint hst 5] {return 0}
     2898        setexp  { EXPR  NHST } $hst 1 5
     2899        # add to EXPR HTYPx rec, creating if needed
     2900        set n [expr { 1+ (($HST - 1) / 12) }]
     2901        set key " EXPR  HTYP$n"
     2902        if {[array names ::exparray $key] == ""} {
     2903            makeexprec $key
     2904        }
     2905        setexp $key "RSN" [expr 3 + 5*(($HST-1) % 12)] 5
     2906        # create other HST  xx recs
     2907        if {$HST <=9} {
     2908            set key "HST  $HST"
     2909        } else {
     2910            set key "HST $HST"
     2911        }
     2912        makeexprec "$key  HNAM"
     2913        setexp "$key  HNAM" "Bond distance restraints" 3 24
     2914        makeexprec "$key FACTR"
     2915        makeexprec "$key NBNDS"
     2916    }
     2917    # update histogram
     2918    if {$HST <=9} {
     2919        set key "HST  $HST"
     2920    } else {
     2921        set key "HST $HST"
     2922    }
     2923    # update FACTR
     2924    if ![validreal factr 15 6] {return 0}
     2925    setexp "$key FACTR" $factr 1 15
     2926    set num [llength $conslist]
     2927    if ![validint num 5] {return 0}
     2928    setexp "$key NBNDS" $num 1 5
     2929    # delete all old records
     2930    foreach i [array names ::exparray "${key}BD*"] {unset ::exparray($i)}
     2931    set i 0
     2932    foreach cons $conslist {
     2933        incr i
     2934        set fi [string toupper [format %.4x $i]]
     2935        makeexprec "${key}BD$fi"
     2936        set pos 1
     2937        foreach num $cons len {3 5 5 3 3 3 3 3 -6 -6} {
     2938            if {$len > 0} {
     2939                validint num $len
     2940                setexp "${key}BD$fi" $num $pos $len
     2941            } else {
     2942                set len [expr abs($len)]
     2943                validreal num $len 3
     2944                setexp "${key}BD$fi" $num $pos $len
     2945            }
     2946            incr pos $len
     2947        }
     2948    }
     2949}
    28332950#======================================================================
    28342951# conversion routines
Note: See TracChangeset for help on using the changeset viewer.