Changeset 1166 for trunk/addcmds.tcl


Ignore:
Timestamp:
Aug 17, 2011 6:17:04 PM (9 years ago)
Author:
toby
Message:

bring sandbox changes over to main release

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/addcmds.tcl

    r1116 r1166  
    709709    # mode must be t-max or 2theta, at least for now
    710710    if {$newhist(LimitMode) != 1} return
    711     # is a instrument parameter file loaded? If not, try again later
    712     if {[string trim $newhist(instfile)] == ""} return
    713711    # get data bank number, test if valid
    714712    set num $newhist(banknum)
    715713    if {[catch {expr $num}]} {return}
    716714    if {$newhist(insttype) == "TOF"} {
     715        # is a instrument parameter file loaded? If not, try again later
     716        if {[string trim $newhist(instfile)] == ""} return
    717717        set newhist(2tLimit) [expr {$newhist(tmin$num) / 10.}]
    718718        # at Ashfia's request, override the bank header # with the
     
    740740        set inp [
    741741        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
    742             {"Inst files" .INS*} {"Inst files" .ins*} 
     742            {"Inst files" .INS*} {"Inst files" .ins*}
    743743            {"Inst files" .PRM}  {"Inst files" .prm}
    744744            {"All files" *}
     
    937937    puts $fp "H"
    938938    if {$tcl_platform(platform) == "windows"} {
    939         puts $fp [file attributes $rawfile -shortname]
    940         puts $fp [file attributes $instfile -shortname]
     939        if {[string length $rawfile] > 50} {
     940            puts $fp [file attributes $rawfile -shortname]
     941        } else {
     942            puts $fp $rawfile
     943        }
     944        if {[string length $instfile] > 50} {           
     945            puts $fp [file attributes $instfile -shortname]
     946        } else {
     947            puts $fp $instfile
     948        }
    941949    } else {
    942950        puts $fp $rawfile
     
    16371645        grid $top.scroll -sticky ns -column 4 -row 2
    16381646    } else {
    1639         grid forget $top.scroll 
     1647        grid forget $top.scroll
    16401648    }
    16411649    update
     
    19491957    }
    19501958
     1959    # allow fixing of atom coordinates
     1960    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
     1961        grid [TitleFrame $w.10 -bd 6 -relief groove \
     1962                -text "Fix Atom$suffix Coordinates"] \
     1963                -row 9 -column 0 -columnspan 10 -sticky news
     1964        set fix [$w.10 getframe]
     1965        Fix_Initialize $numberList
     1966
     1967        label $fix.xlab -text "  x  " -width 8
     1968        label $fix.ylab -text "  y  " -width 8
     1969        label $fix.zlab -text "  z  " -width 8
     1970        grid $fix.xlab -row 2 -column 0
     1971        grid $fix.ylab -row 2 -column 1
     1972        grid $fix.zlab -row 2 -column 2
     1973
     1974
     1975        button $fix.x -text "$::fix_state_X" -width 8 \
     1976               -command "Fix_Atoms $phase [list $numberList] X $fix.x;
     1977               Fix_Write
     1978               DisplayAllAtoms $phase"
     1979
     1980        button $fix.y -text "$::fix_state_Y" -width 8 \
     1981                -command "Fix_Atoms $phase [list $numberList] Y $fix.y
     1982                Fix_Write
     1983                DisplayAllAtoms $phase"
     1984        button $fix.z -text "$::fix_state_Z" -width 8 \
     1985                -command "Fix_Atoms $phase [list $numberList] Z $fix.z
     1986                Fix_Write
     1987                DisplayAllAtoms $phase"
     1988        grid $fix.x -row 3 -column 0
     1989        grid $fix.y -row 3 -column 1
     1990        grid $fix.z -row 3 -column 2
     1991    }
     1992    #xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
     1993
    19511994    grid rowconfigure $w 11 -minsize 5
    19521995    grid [frame $w.b] -row 12 -column 0 -columnspan 10 -sticky ew
     
    19662009    if {[llength $expgui(selectedatomlist)] != 0} editRecord
    19672010}
     2011
     2012#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x
     2013
     2014proc Fix_Initialize {numberList} {
     2015     set phaselist $::expmap(phaselist)
     2016     catch {unset ::fix_param}
     2017     foreach i $phaselist {
     2018             set ::fix_list(X,$i) ""
     2019             set ::fix_list(Y,$i) ""
     2020             set ::fix_list(Z,$i) ""
     2021
     2022             set temp [atom_constraint_read $i]
     2023             foreach j $temp {
     2024                     set atomnum [string trim [string range $j 2 3]]
     2025                     set param [string trim [string range $j 4 6]]
     2026                     set ::fix_param($i,$atomnum,$param) 1
     2027                     if {$param == "X"} {lappend ::fix_list(X,$i) $atomnum}
     2028                     if {$param == "Y"} {lappend ::fix_list(Y,$i) $atomnum}
     2029                     if {$param == "Z"} {lappend ::fix_list(Z,$i) $atomnum}
     2030             }
     2031     }
     2032    set ::fix_state_X [Fix_State $i $numberList X]
     2033    set ::fix_state_Y [Fix_State $i $numberList Y]
     2034    set ::fix_state_Z [Fix_State $i $numberList Z]
     2035}
     2036
     2037proc Fix_State {phase numberList coord} {
     2038     set status_fixed "-1"
     2039     set status_unfixed "-1"
     2040     #puts "$coord before: $status_fixed $status_unfixed"
     2041     foreach i $numberList {
     2042         set temp [info exists ::fix_param($phase,$i,$coord)]
     2043         #puts "::fix_param($phase,$i,$coord) is variable present?: $temp"
     2044         if {$temp != 0} {set status_fixed 1}
     2045         if {$temp == 0} {set status_unfixed 1}
     2046     }
     2047     #puts "$coord after $status_fixed $status_unfixed"
     2048     if {$status_fixed == 1 && $status_unfixed != 1} {return "fixed"}
     2049     if {$status_fixed == 1 && $status_unfixed == 1} {return "mixed"}
     2050     if {$status_fixed != 1 && $status_unfixed == 1} {return "unfixed"}
     2051}
     2052
     2053proc Fix_Write {} {
     2054      incr ::expgui(changed)
     2055      #puts "Prepare to write [array names ::fix_Param]"
     2056      foreach j [array names ::fix_param] {
     2057             regexp {[0-9]+} $j  temp_phase
     2058             regexp {,[0-9]+} $j ans
     2059             set temp_atom [string range $ans 1 end]
     2060             regexp {[a-zA-Z]+} $j temp_param
     2061             if {$temp_param == "U"} {regexp {[a-zA-Z]+[0-9]+} $j temp_param}
     2062             set temp_entry [format "%1s %+2s%-4s" $temp_phase $temp_atom $temp_param]
     2063             lappend fix_list($temp_phase) $temp_entry
     2064     }
     2065     set phaselist $::expmap(phaselist)
     2066     foreach i $phaselist {
     2067             catch {atom_constraint_write $i $fix_list($i)}
     2068             catch  {RecordMacroEntry "catch {atom_constraint_write $i $fix_list($i)}" 0}
     2069             #puts $fix_list($i)
     2070     }
     2071}
     2072
     2073proc Fix_Atoms {phase numberList coord but} {
     2074#     puts "before  ::fix_state_$coord [set ::fix_state_$coord]"
     2075     #puts " before operationi: $::fix_list($coord,$phase)"
     2076     switch [set ::fix_state_$coord] {
     2077     "unfixed" {$but config -text "fixed"
     2078               set ::fix_state_$coord "fixed"
     2079               }
     2080     "fixed"   {$but config -text "unfixed"
     2081               set ::fix_state_$coord "unfixed"
     2082               }
     2083     "mixed"   {$but config -text "unfixed"
     2084               set ::fix_state_$coord "unfixed"
     2085               }
     2086     }
     2087     if {[set ::fix_state_$coord] == "fixed"} {
     2088        #puts "fixing atom number $numberList"
     2089        foreach i $numberList {
     2090                lappend ::fix_list($coord,$phase) $i
     2091                set ::fix_list($coord,$phase) [lsort -uniq -integer $::fix_list($coord,$phase)]
     2092                set ::fix_param($phase,$i,$coord) 1
     2093        }
     2094     }
     2095     if {[set ::fix_state_$coord] == "unfixed"} {
     2096        #puts "unfixing atoms $numberList"
     2097        foreach i $numberList {
     2098           set temp [lsearch $::fix_list($coord,$phase) $i]
     2099           if {$temp != -1} {
     2100              set ::fix_list($coord,$phase) [lreplace $::fix_list($coord,$phase) $temp $temp]
     2101              catch {unset ::fix_param($phase,$i,$coord)}
     2102           }
     2103        }
     2104     }
     2105     #puts "after operation: $::fix_list($coord,$phase)"
     2106}
     2107
    19682108
    19692109# transform the coordinates
Note: See TracChangeset for help on using the changeset viewer.