Changeset 1025


Ignore:
Timestamp:
Oct 13, 2010 2:27:15 PM (10 years ago)
Author:
toby
Message:

see https://subversion.xor.aps.anl.gov/trac/EXPGUI/wiki/News20101013

Location:
trunk
Files:
7 edited
4 copied

Legend:

Unmodified
Added
Removed
  • trunk

  • trunk/addcmds.tcl

    r992 r1025  
    392392
    393393proc MakeAddHistBox {} {
    394     global expmap newhist
     394    global expmap newhist expgui
    395395
    396396    # --> should check here if room for another histogram, but only texture
     
    518518    # fix grab...
    519519    afterputontop
     520    # if no histogram is selected, select the last
     521    if {$expgui(curhist) == "" && $expmap(powderlist) != ""} {
     522        $expgui(histFrame).hs.lbox select set end
     523        set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
     524        DisplayHistogram
     525    }
    520526}
    521527
  • trunk/atomcons.tcl

    r930 r1025  
    1111    grid [NoteBook $expgui(consFrame).n -bd 2 -side bottom] -sticky news
    1212    source [file join $expgui(scriptdir) profcons.tcl]
     13    source [file join $expgui(scriptdir) distrest.tcl]
    1314}
    1415
     
    2021    catch {$expgui(consFrame).n delete macro}
    2122    catch {$expgui(consFrame).n delete profile}
     23    catch {$expgui(consFrame).n delete distrest}
    2224    set atom normal
    2325    set mm disabled
     
    3133    }
    3234    set expcons(atommaster) [\
    33             $expgui(consFrame).n insert end atomic -text Atomic \
     35            $expgui(consFrame).n insert end atomic -text "Atom Constraints" \
    3436            -state $atom \
    3537            -createcmd "MakeAtomsConstraintsPane" \
     
    4244    # profile constraints page
    4345    set expcons(profilemaster) [\
    44             $expgui(consFrame).n  insert end profile -text Profile \
     46            $expgui(consFrame).n  insert end profile -text "Profile Constraints" \
    4547            -createcmd "MakeProfileConstraintsPane" \
    4648            -raisecmd "DisplayProfileConstraints"]   
     49    set expcons(distmaster) [\
     50            $expgui(consFrame).n insert end distrest -text "Distance Restraints" \
     51            -state $atom \
     52            -createcmd "" \
     53            -raisecmd "DisplayDistanceRestraints"]
     54 
    4755    set page [$expgui(consFrame).n raise]
    4856    # open the atom constraints page if no page is open
  • trunk/expgui

    r997 r1025  
    155155# setting data range/excluded regions
    156156source [file join $expgui(scriptdir) exclinit.tcl]
     157# setup DISAGL viewer & editor
     158source [file join $expgui(scriptdir) disagledit.tcl]
     159source [file join $expgui(scriptdir) geo_viewer.tcl]
    157160#---------------------------------------------------------------------------
    158161# override options with locally defined values
     
    546549    set newexpfile [getExpFileName new]
    547550    if {$newexpfile == ""} return
    548     SetEXPfile $newexpfile
     551    SetEXPfile $newexpfile 1
    549552    if {$expgui(expfile) == ""} {
    550553        set expgui(expfile) $prevexp
     
    16991702        }
    17001703    }
    1701     # disable the unallowed pages in all mode
    1702     if {$expgui(globalmode) == 6} {
    1703         foreach pair $expgui(GlobalModeAllDisable) {
    1704             if {$expgui(pagenow) == [lindex $pair 0]} {
    1705                 RaisePage lsFrame
    1706             }
    1707             eval [lindex $pair 1] -state disabled
    1708         }
    1709     } else {
    1710         foreach pair $expgui(GlobalModeAllDisable) {
    1711             eval [lindex $pair 1] -state normal
    1712         }
    1713     }
     1704    StageTabUse
     1705    # # disable the unallowed pages in all mode
     1706    # if {$expgui(globalmode) == 6} {
     1707    #   foreach pair $expgui(GlobalModeAllDisable) {
     1708    #       if {$expgui(pagenow) == [lindex $pair 0]} {
     1709    #           RaisePage lsFrame
     1710    #       }
     1711    #       eval [lindex $pair 1] -state disabled
     1712    #   }
     1713    # } else {
     1714    #   foreach pair $expgui(GlobalModeAllDisable) {
     1715    #       eval [lindex $pair 1] -state normal
     1716    #   }
     1717    # }
    17141718    set histlist {}
    17151719    if  {$expgui(hsorttype) == "type"} {
     
    33483352            DisplayProfile \
    33493353            1  expgui5.html ""}
    3350     {consFrame    Constraints \
     3354    {consFrame    "Re/Constraints" \
    33513355            "source [file join $expgui(scriptdir) atomcons.tcl]; MakeConstraintsPane" \
    33523356            DisplayConstraintsPane \
     
    33833387    }
    33843388}
     3389# procedure to disable tabs when phases or histograms are not defined
     3390proc StageTabUse {args} {
     3391    global expgui
     3392    # reset everything
     3393    foreach item [lrange $::expgui(notebookpagelist) 0 end] {
     3394        set frm [lindex $item 0]
     3395        .n itemconfigure $frm -state normal
     3396    }
     3397    # disable the unallowed pages in all mode
     3398    if {$expgui(globalmode) == 6} {
     3399        foreach pair $expgui(GlobalModeAllDisable) {
     3400            if {$expgui(pagenow) == [lindex $pair 0]} {
     3401                RaisePage lsFrame
     3402            }
     3403            eval [lindex $pair 1] -state disabled
     3404        }
     3405    } else {
     3406        foreach pair $expgui(GlobalModeAllDisable) {
     3407            eval [lindex $pair 1] -state normal
     3408        }
     3409    }
     3410    # no phases are present, one must add a phase 1st
     3411    if {[llength $::expmap(phaselist)] == 0} {
     3412        foreach item [lrange $::expgui(notebookpagelist) 2 end] {
     3413            set frm [lindex $item 0]
     3414            .n itemconfigure $frm -state disabled
     3415        }
     3416        return
     3417    }
     3418    # do any of the phases have atoms?
     3419    set flag 1
     3420    foreach phase $::expmap(phaselist) {
     3421        if {[array names ::expmap atomlist_$phase] != ""} {
     3422            if {[llength $::expmap(atomlist_$phase)] > 0} {
     3423                set flag 0
     3424                break
     3425            }
     3426        }
     3427    }
     3428    # no atoms are present, one must add at least one before continuing
     3429    if $flag {
     3430        foreach item [lrange $::expgui(notebookpagelist) 2 end] {
     3431            set frm [lindex $item 0]
     3432            .n itemconfigure $frm -state disabled
     3433        }
     3434        return
     3435    }
     3436
     3437    # no data is present, one must add a histogram next
     3438    if {[llength $::expmap(nhst)] == 0} {
     3439        foreach item [lrange $::expgui(notebookpagelist) 4 end] {
     3440            set frm [lindex $item 0]
     3441            .n itemconfigure $frm -state disabled
     3442        }
     3443        return
     3444    }
     3445}
     3446# expgui(mapstat) is set by mapexp when it is called
     3447# mapexp will be called when the .EXP file is changed (addition of phases, atoms or histograms)
     3448trace variable expgui(mapstat) w StageTabUse
    33853449
    33863450# this is used to bring up the selected frame
     
    42044268        -command {set expgui(debug) 1}
    42054269}
    4206 # add update commands to buffer
    4207 if [CheckUpdateImplemented $expgui(gsasdir)] {
     4270# add update commands to menu
     4271if {[file exists [file join  $expgui(gsasdir) .svn]]} {
    42084272    $expgui(fm).file.menu add command -command CheckAndDoUpdate -label "Update GSAS/EXPGUI"
    4209 #    $expgui(fm).file.menu add cascade -menu $expgui(fm).file.menu.track \
    4210 #       -label "Select EXPGUI version"
    4211 #    menu $expgui(fm).file.menu.track
    4212 #    $expgui(fm).file.menu.track add radiobutton -command {SetSVNbranch trunk} -label Development -value trunk \
    4213 #       -variable expgui(SVNversion)
    4214 #    $expgui(fm).file.menu.track add radiobutton -command {SetSVNbranch stable} -label Standard -value stable \
    4215 #       -variable expgui(SVNversion)
    4216     # get info about the current version on the server. Someday we might want to compare this
    4217     # say every month and notify when there is a new version to update
    4218     set repos [GetSVNrepository [file normalize $expgui(gsasdir)]]
    4219     # send a "p" to accept the server fingerprint in case needed on 1st access
    4220     set svninp [file normalize "~/svntmp.txt"]
    4221     set fp [open $svninp "w"]
    4222     puts $fp "p"
    4223     close $fp
    4224     if [catch {set out [exec svn info $repos < $svninp]} err] {
    4225         puts "svn info error = $err"
    4226     }
    4227     catch {file delete $svninp}
    4228     set expgui(SVNversion) [lindex [split $repos '/'] end]
    4229     # cleanup batch file from a previous update
    4230     if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
    4231         catch {
    4232             file delete [file normalize ~/expgui_update.bat]
    4233         }
    4234     }
    42354273} else {
    4236     $expgui(fm).file.menu add command -label "Show update problem" -command {
    4237         if {! [file exists [file join $expgui(gsasdir) .svn]]} {
    4238             MyMessageBox -parent . -title "No .svn" \
    4239                 -message "Unable to update because the gsas/.svn directory is not present." \
    4240                 -icon warning
    4241         } else {
    4242             MyMessageBox -parent . -title "No .svn" \
    4243                 -message "Unable to update because the subversion (svn) program is not in the path." \
    4244                 -icon warning
    4245         }
    4246     }
     4274    $expgui(fm).file.menu add command  -state disabled -label "Self-updating not installed"
    42474275}
    42484276foreach c {h H} {bind . <Alt-$c> [list showhelp]}
  • trunk/gsascmds.tcl

    r996 r1025  
    15171517proc rundisagl {} {
    15181518    global expgui txtvw tcl_version tcl_platform
     1519    # call up new DISAGL parm edit box
     1520    if {[DA_Control_Panel 1]} {return}
     1521    # Save the current exp file if needed
     1522    savearchiveexp
    15191523    if {$expgui(disaglSeparateBox)} {
    15201524        set root [file root $expgui(expfile)]
     
    19531957# validate and store the EXP file name. Create a new .EXP file if it does not
    19541958# exist and set the wd to the location of the .EXP file.
    1955 proc SetEXPfile {expfile} {
     1959proc SetEXPfile {expfile "newOK 0"} {
    19561960    global expgui tcl_platform
    19571961    set expgui(expfile) {}
     
    20662070    }
    20672071
    2068     if {! [file exists $newexpfile]} {
     2072    if {(! $newOK) && (! [file exists $newexpfile])} {
    20692073        update
    20702074        set ans [
     
    23462350    $box.can create window 0 0 -anchor nw  -window [frame $box.can.f -bd 2]
    23472351    $box.side create window 0 0 -anchor nw  -window [frame $box.side.f -bd 2]
    2348 
    23492352    grid columnconfig $box 1 -weight 1
    23502353    grid rowconfig $box 1 -weight 1
     
    23792382        grid $box.yscroll -sticky ns -column 2 -row 1
    23802383    } else {
    2381         grid forget $box.yscroll 
     2384        grid forget $box.yscroll
    23822385    }
    23832386    if {[lindex $sizes 2] > [winfo width $box.can]} {
    23842387        grid $box.scroll -sticky ew -column 1 -row 2
    23852388    } else {
    2386         grid forget $box.scroll
    2387     }
    2388 }
     2389        grid forget $box.scroll
     2390    }
     2391}
     2392
     2393proc MouseWheelScrollTable {box} {
     2394     # causes mouse wheel to operate scroll for main canvas in ScrollTable
     2395     # mousewheel can be operated anywhere in parent window
     2396    bind [winfo toplevel $box] <MouseWheel> "$box.can yview scroll \[expr {-abs(%D)/%D}\] unit"
     2397}
     2398
    23892399
    23902400# this is used in cifselect -- not sure why anymore
     
    33983408# Subversion support routines
    33993409#------------------------------------------------------------------------------
    3400 # is there a subversion stub and can we find the svn program
    3401 proc CheckUpdateImplemented {scriptdir} {
    3402     #is there a svn directory in the source?
    3403     if {! [file exists [file join $scriptdir .svn]]} {return 0}
     3410
     3411proc GetSVNVersion {scriptdir} {
     3412    if {[CheckSVNinstalled]} {
     3413        set SVN [auto_execok svn]
     3414        if {! [catch {set res [eval exec $SVN info [list $scriptdir]]} err]} {
     3415            set infolist [split $res]
     3416            set pos [lsearch $infolist "Revision:"]
     3417            return "GSAS/EXPGUI SVN version [lindex $infolist [incr pos]]"
     3418        }
     3419    }
     3420    return "EXPGUI version: [lindex $::expgui(Revision) 1] ([lindex $::expgui(Revision) 4])"
     3421}
     3422
     3423# can we find the svn program?
     3424proc CheckSVNinstalled {} {
    34043425    # can we find svn in the path?
    34053426    if {[auto_execok svn] != ""} {return 1}
    3406     # add a locally supplied svn version, if not in the path already
    3407     set pathlist [list [file join $scriptdir svn bin]]
    3408     lappend pathlist "/sw/bin/"
    3409     lappend pathlist "/opt/local/bin/"
    3410     catch {lappend pathlist $::expgui(pathlist)}
    3411     foreach localsvn $pathlist {
    3412         if {[file exists $localsvn]} {
    3413             if {$::tcl_platform(platform) == "windows"} {
    3414                 set localsvn [file nativename $localsvn]
    3415                 set sep {;}
    3416             } else {
    3417                 set sep {:}
    3418             }
    3419             if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} {
    3420                 append ::env(PATH) $sep $localsvn
    3421                 auto_reset
    3422                 if {[auto_execok svn] != ""} {return 1}
    3423             }
    3424         }
    3425     }
     3427    # add a locally supplied svn version and add to path
     3428    if {$::tcl_platform(platform) == "windows"} {
     3429        set s [file attributes $::expgui(gsasdir) -shortname]
     3430    } else {
     3431        set s $::expgui(gsasdir)
     3432    }
     3433    # look for svn
     3434    set localsvn [file join $s svn bin]
     3435    if {[file exists $localsvn]} {
     3436        if {$::tcl_platform(platform) == "windows"} {
     3437            set localsvn [file nativename $localsvn]
     3438            set sep {;}
     3439        } else {
     3440            set sep {:}
     3441        }
     3442        if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} {
     3443            append ::env(PATH) $sep $localsvn
     3444            # note that auto_reset breaks the tkcon package in Windows -- not sure why
     3445            auto_reset
     3446        }
     3447    }
     3448    if {[auto_execok svn] != ""} {return 1}
    34263449    return 0
    34273450}
    34283451
    3429 proc GetSVNVersion {scriptdir} {
    3430     if {$::tcl_platform(platform) == "windows"} {
    3431         set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
    3432     } else {
    3433         set SVN [auto_execok svn]
    3434     }
    3435     if {$SVN != ""} {
    3436         if {! [catch {set res [exec $SVN info $scriptdir]} err]} {
    3437             set infolist [split $res]
    3438             set pos [lsearch $infolist "Revision:"]
    3439             return "EXPGUI SVN version [lindex $infolist [incr pos]]"
    3440         }
    3441     }
    3442     return "EXPGUI version: $::expgui(Revision)"
    3443 }
    3444 
    3445 proc GetSVNrepository {scriptdir} {
    3446     if {$::tcl_platform(platform) == "windows"} {
    3447         set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
    3448     } else {
    3449         set SVN [auto_execok svn]
    3450     }
    3451     if {$SVN != ""} {
    3452         if {! [catch {set res [exec $SVN info $scriptdir]} err]} {
    3453             set infolist [split $res]
    3454             set pos [lsearch $infolist "URL:"]
    3455             return [lindex $infolist [incr pos]]
    3456         }
    3457     }
    3458     return {}
    3459 }
    3460 
    3461 proc SetSVNbranch {branch} {
    3462     # reset the track label
    3463     set ::command(SVNversion) [lindex [split [GetSVNrepository $::expgui(scriptdir)] '/'] end]
    3464     if {$::tcl_platform(platform) == "windows"} {
    3465         set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
    3466     } else {
    3467         set SVN [auto_execok svn]
    3468     }
    3469     if {$SVN == ""} {
    3470         return 0
    3471     }
    3472     set curURL [GetSVNrepository $expgui(scriptdir)]
    3473     set curbranch [lindex [split $curURL '/'] end]
    3474     if {$curbranch == $branch} {return 0}
    3475     if {$branch == "trunk"} {
    3476         set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/trunk"
    3477         set lbl development
    3478     } elseif {$branch == "stable"} {
    3479         set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/tags/stable"
    3480         set lbl standard
    3481     } else {
    3482         MyMessageBox -parent . -title "Internal error" \
    3483         -message "No $branch track." -icon error
    3484         return 0
    3485     }
    3486     set msg {Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.}
    3487     if {[MyMessageBox -parent . -title "Ready to switch" \
    3488         -message "Ready to update to the $lbl track.\n\n$msg" \
    3489                  -type {Cancel "Update & Restart"} -default cancel -icon warning
    3490         ] == "cancel"} {return}
    3491     if {[confirmBeforeSave] == "Cancel"} return
    3492 
    3493     # do a quiet cleanup. Sometimes needed after install, and never hurts
    3494     if [catch {set res [exec $SVN cleanup $::expgui(scriptdir)]} err] {
    3495         MyMessageBox -parent . -title "Error in cleanup" \
    3496             -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
     3452proc CheckAndDoUpdate { } {
     3453    if {! [CheckSVNinstalled]} {
     3454        MyMessageBox -parent . -title "SVN not found" \
     3455            -message "Unable to upgrade: Could not locate a copy of the subversion program. It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \
    34973456            -icon error
    3498     }
    3499 
    3500     # switch the source
    3501     set cmd1 "$SVN switch $newURL $scriptdir"
    3502     if [catch {set res1 [exec $SVN switch $newURL $::expgui(scriptdir)]} err] {
    3503         MyMessageBox -parent . -title "Error updating" \
    3504             -message "Error performing update:\n$err" \
     3457        return
     3458    }
     3459    #is there a svn directory in the source?
     3460    if {! [file exists [file join $::expgui(gsasdir)  .svn]]} {
     3461        MyMessageBox -parent . -title "No .svn directory" \
     3462            -message "Unable to upgrade: It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \
    35053463            -icon error
    3506         return 0
    3507     }
    3508     set msg "Results from update:\n$cmd1\n$res1"
    3509     # update done, now need to "reboot"
    3510     MyMessageBox -parent . -title "Updating done" -icon info \
    3511         -message "Update Complete\nPress OK to restart EXPGUI\n\n$msg"
    3512     exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
    3513     exit
    3514 }
    3515 
    3516 proc CheckAndDoUpdate { } {
    3517     if {$::tcl_platform(platform) == "windows"} {
    3518         set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
    3519     } else {
    3520         set SVN [auto_execok svn]
    3521     }
    3522     if {$SVN == ""} {
    3523         tk_dialog .msg "Error: no svn" \
    3524             "Error: SVN not found. Should not happen." \
    3525             error 0 OK   
    35263464        return
    35273465    }
    3528     #set wish "[info nameofexecutable]"
    35293466    # check for updates
    3530     if [catch {
    3531         set res [exec $SVN status [file normalize $::expgui(gsasdir)] -u]
    3532     } err] {
     3467    set SVN [auto_execok svn]
     3468    if [catch {set res [eval exec $SVN status [list $::expgui(gsasdir)] -u]} err] {
    35333469        set ans [MyMessageBox -parent . -title "Error checking status" \
    35343470                     -message "Error checking for updates: $err\n\nTry to update manually?" \
     
    35393475        }
    35403476        return
    3541     } else {
     3477     } else {
    35423478        if {[string first "*" $res] == -1} {
    35433479            MyMessageBox -parent . -title "No updates" \
    3544                 -message "GSAS/EXPGUI appears up-to-date" \
     3480                -message "GSAS & EXPGUI appear up-to-date" \
    35453481                -icon info
    35463482            return
    35473483        }
    35483484    }
     3485
    35493486    if {[MyMessageBox -parent . -title "Ready to Update" \
    35503487             -message {
    3551 Updates to GSAS/EXPGUI found.
     3488Updates to GSAS/EXPGUI found on server.
    35523489                 
    35533490Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} \
     
    35593496    # special upgrade for windows, where the wish exec blocks upgrade of the exe directory
    35603497    if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
     3498        if {![file exists [file join $::expgui(gsasdir) update.bat]]} {
     3499            MyMessageBox -parent . -title "No update.bat" \
     3500                -message "File update.bat was not found. This should not happen. Will try to create it now."
     3501            set fp [open [file join $::expgui(gsasdir) update.bat] w]
     3502            puts $fp {@REM this script must be run from the GSAS installation directory
     3503@REM This is run to update the installation, the name of the EXP file is
     3504@REM expected as an argument
     3505@echo ****************************
     3506@echo Press return to start update
     3507@echo ****************************
     3508@pause
     3509.\svn\bin\svn cleanup .
     3510.\svn\bin\svn update .
     3511@if (%1)==() goto Install2
     3512@echo ****************************************************
     3513@echo Update has completed. Press return to restart EXPGUI
     3514@echo ****************************************************
     3515@pause
     3516%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui %1"
     3517exit
     3518:Install2
     3519@echo ****************************************************
     3520@echo Update has completed. EXPGUI starting w/o .EXP file
     3521@echo ****************************************************
     3522@pause
     3523%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui"
     3524exit
     3525            }
     3526            close $fp
     3527        }
    35613528        # split the directory and EXP file and get rid os spaces in the directory name
    35623529        set exp [file normalize $::expgui(expfile)]
     
    35693536
    35703537    # do a quiet cleanup. Sometimes needed after install, and never hurts
    3571     if [catch {set res [exec $SVN cleanup $::expgui(gsasdir)]} err] {
     3538    if [catch {set res [eval exec $SVN cleanup [list $::expgui(gsasdir)]]} err] {
    35723539        MyMessageBox -parent . -title "Error in cleanup" \
    35733540            -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
  • trunk/gsasmenu.tcl

    r930 r1025  
    8282        bijcalc
    8383        disagl
     84        disaglviewer
    8485        reflist
    8586        geometry
     
    197198    disagl      {rundisagl {
    198199        Distance/angle calculations}
     200    }
     201
     202    disaglviewer {Geo_Viewer {
     203        Show distances and angles in a nice format}
    199204    }
    200205
  • trunk/readexp.tcl

    r997 r1025  
    8080#
    8181proc mapexp {} {
    82     global expmap exparray
     82    global expgui expmap exparray
    8383    # clear out the old array
    8484    set expmap_Revision $expmap(Revision)
     
    187187        }
    188188    }
     189    set expgui(mapstat) 1
    189190}
    190191
     
    495496    }
    496497    return {}
     498}
     499
     500proc disagldat_get {phase} {
     501    set key "  DSGL CDAT$phase"
     502    if {[existsexp $key] == 0} {return "{none} {none}"}
     503    set line [readexp $key]
     504    set i1 2
     505    # read atom-atom distance parameter
     506    set dist {}
     507    set item [string range $line $i1 [expr {$i1+3}]]
     508    if {$item == "DMAX"} {
     509        set val [string range $line [expr {$i1+4}] [expr {$i1+11}]]
     510        set dist [string trim $val]
     511        incr i1 13
     512    } else {
     513        set dist "radii"
     514        incr i1 5
     515    }
     516    # read atom-atom-atom angle parameter
     517    set ang {}
     518    set item [string range $line $i1 [expr {$i1+3}]]
     519    if {$item == "DAGL"} {
     520        set val [string range $line [expr {$i1+4}] [expr {$i1+11}]]
     521        set ang [string trim $val]
     522        incr i1 13
     523    } else {
     524        set ang "radii"
     525        incr i1 5
     526    }
     527    # note there are two more parameters, NOFO/FORA & ONCR/DFLT, but they are not being processed yet
     528    return "$dist $ang"
    497529}
    498530
     
    519551#     ODFcoefXXX -- the ODF coefficient for for ODF term XXX (*)
    520552#     ODFRefcoef -- refinement flag for ODF terms (*)
     553#     DistCalc   -- returns "radii", "none" or a number (*)
     554#                   none: no distance or angle computation for the phase
     555#                   radii: computation will be done by sums of radii
     556#                          (see AtmTypInfo and DefAtmTypInfo)
     557#                   other: a distance specifing the maximum distance
     558#     AngCalc    -- returns "radii", "none" or a number (*)
     559#                   none: no distance or angle computation for the phase
     560#                   radii: computation will be done by sums of radii
     561#                          (see AtmTypInfo and DefAtmTypInfo)
     562#                   other: a distance specifing the maximum distance
    521563#  action: get (default) or set
    522564#  value: used only with set
     
    832874            }
    833875        }
    834 
     876        DistCalc-get {
     877            set val [disagldat_get $phase]
     878            return [lindex $val 0]
     879        }
     880        DistCalc-set {
     881            set key "  DSGL CDAT$phase"
     882            # for none delete the record & thats all folks
     883            if {$value == "none"} {
     884                catch {unset ::exparray($key)}
     885                return
     886            }
     887            if {[existsexp $key] == 0} {
     888                makeexprec $key
     889            }
     890            set line [readexp $key]
     891            if {[string trim $line] == ""} {
     892                # blank set to defaults
     893                set line [string replace $line 2 15 "DRAD ARAD NOFO"]
     894            }
     895            if {$value == "radii"} {
     896                if {[string range $line 2 5] == "DMAX"} {
     897                    set line [string replace $line 2 13 "DRAD"]
     898                } else {
     899                    set line [string replace $line 2 5 "DRAD"]
     900                }
     901            } else {
     902                if ![validreal value 8 2] {return 0}
     903                if {[string range $line 2 5] == "DMAX"} {
     904                    set line [string replace $line 6 13 $value]
     905                } else {
     906                    set line [string replace $line 2 5 "DMAX"]
     907                    set line [string replace $line 6 6 "$value "]
     908                }
     909            }
     910            setexp $key $line 0 68
     911        }
     912        AngCalc-get {
     913            set val [disagldat_get $phase]
     914            return [lindex $val 1]
     915        }
     916        AngCalc-set {
     917            set key "  DSGL CDAT$phase"
     918            # for none delete the record & thats all folks
     919            if {$value == "none"} {
     920                catch {unset ::exparray($key)}
     921                return
     922            }
     923            if {[existsexp $key] == 0} {
     924                makeexprec $key
     925            }
     926            set line [readexp $key]
     927            if {[string trim $line] == ""} {
     928                # blank set to defaults
     929                set line [string replace $line 2 15 "DRAD ARAD NOFO"]
     930            }
     931            if {[string range $line 2 5] == "DMAX"} {
     932                set i2 8
     933            } else {
     934                set i2 0
     935            }
     936            if {$value == "radii"} {
     937                if {[string range $line [expr {$i2+7}] [expr {$i2+10}]] == "DAGL"} {
     938                    set line [string replace $line [expr {$i2+7}] [expr {$i2+18}] "ARAD"]
     939                } else {
     940                    set line [string replace $line [expr {$i2+7}] [expr {$i2+10}] "ARAD"]
     941                }
     942            } else {
     943                if ![validreal value 8 2] {return 0}
     944                if {[string range $line [expr {$i2+7}] [expr {$i2+10}]] == "DAGL"} {
     945                    set line [string replace $line [expr {$i2+11}] [expr {$i2+18}] $value]
     946                } else {
     947                    set line [string replace $line [expr {$i2+7}] [expr {$i2+10}] "DAGL"]
     948                    set line [string replace $line [expr {$i2+11}] [expr {$i2+11}] "$value "]
     949                }
     950            }
     951            setexp $key $line 0 68
     952        }
    835953        default {
    836954            set msg "Unsupported phaseinfo access: parm=$parm action=$action"
    837             tk_dialog .badexp "Error in readexp" $msg error 0 Exit 
     955            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    838956        }
    839957    }
    840958    return 1
    841959}
     960
    842961
    843962
     
    26482767}
    26492768
     2769# get list of defined atom types
     2770proc AtmTypList {} {
     2771    set natypes [readexp " EXPR  NATYP"]
     2772    if {$natypes == ""} return
     2773    set j 0
     2774    set typelist {}
     2775    for {set i 1} {$i <= $natypes} {incr i} {
     2776        set key {this should never be matched}
     2777        while {![existsexp $key]} {
     2778            incr j
     2779            if {$j > 99} {
     2780                return $typelist
     2781            } elseif {$j <10} {
     2782                set key " EXPR ATYP $j"
     2783            } else {
     2784                set key " EXPR ATYP$j"
     2785            }
     2786        }
     2787        lappend typelist [string trim [string range $::exparray($key) 2 9]]
     2788    }
     2789    return $typelist
     2790}
     2791
     2792# read information about atom types
     2793#     distrad    atomic distance search radius (get/set)
     2794#     angrad     atomic angle search radius (get/set)
     2795proc AtmTypInfo {parm atmtype "action get" "value {}"} {
     2796    # first, search through the records to find the record matching the type
     2797    set natypes [readexp " EXPR  NATYP"]
     2798    if {$natypes == ""} return
     2799    set j 0
     2800    set typelist {}
     2801    for {set i 1} {$i <= $natypes} {incr i} {
     2802        set key {this should never be matched}
     2803        while {![existsexp $key]} {
     2804            incr j
     2805            if {$j > 99} {
     2806                return $typelist
     2807            } elseif {$j <10} {
     2808                set key " EXPR ATYP $j"
     2809            } else {
     2810                set key " EXPR ATYP$j"
     2811            }
     2812        }
     2813        if {[string toupper $atmtype] == \
     2814                [string toupper [string trim [string range $::exparray($key) 2 9]]]} break
     2815        set key {}
     2816    }
     2817    if {$key == ""} {
     2818        # atom type not found
     2819        return {}
     2820    }
     2821    switch -glob ${parm}-$action {
     2822        distrad-get {
     2823            return [string trim [string range [readexp $key] 15 24]]
     2824        }
     2825        distrad-set {
     2826            if ![validreal value 10 2] {return 0}
     2827            setexp $key $value 16 10
     2828        }
     2829        angrad-get {
     2830            return [string trim [string range [readexp $key] 25 34]]
     2831        }
     2832        angrad-set {
     2833            if ![validreal value 10 2] {return 0}
     2834            setexp $key $value 26 10
     2835        }
     2836        default {
     2837            set msg "Unsupported AtmTypInfo access: parm=$parm action=$action"
     2838            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
     2839        }
     2840    }
     2841}
     2842# read default information about atom types (records copied to the .EXP file
     2843# from the gsas/data/atomdata.dat file as AFAC ...
     2844#     distrad returns a list of atom types (one or two letters) and
     2845#                the corresponding distance
     2846# note that these values are read only (no set option)
     2847proc DefAtmTypInfo {parm} {
     2848    set keys [array names ::exparray " AFAC *_SIZ"]
     2849    set elmlist {}
     2850    if {[llength $keys] <= 0} {return ""}
     2851    foreach key $keys {
     2852        lappend elmlist [string trim [string range $key 6 7]]
     2853    }
     2854    switch -glob ${parm} {
     2855        distrad {
     2856            set out {}
     2857            foreach key $keys elm $elmlist {
     2858                set val [string range $::exparray($key) 0 9]
     2859                lappend out "$elm [string trim $val]"
     2860            }
     2861            return $out
     2862        }
     2863        angrad {
     2864            set out {}
     2865            foreach key $keys elm $elmlist {
     2866                set val [string range $::exparray($key) 10 19]
     2867                lappend out "$elm [string trim $val]"
     2868            }
     2869            return $out
     2870        }
     2871        default {
     2872            set msg "Unsupported DefAtmTypInfo access: parm=$parm"
     2873            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
     2874        }
     2875    }
     2876}
    26502877# write the .EXP file
    26512878proc expwrite {expfile} {
     
    28313058}
    28323059
    2833 proc 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 
    2870 proc SetSoftCons {factr conslist} {
     3060# read/edit soft (distance) restraint info
     3061#  parm:
     3062#    weight -- histogram weight (factr) *
     3063#    restraintlist -- list of restraints *
     3064#  action: get (default) or set
     3065#  value: used only with set
     3066#  * =>  read+write supported
     3067proc SoftConst {parm "action get" "value {}"} {
    28713068    set HST {}
    28723069    # look for RSN record
     
    28893086        }
    28903087    }
    2891     if {$HST == ""} {
     3088    if {$HST == ""} {return "1"}
     3089    if {$HST <=9} {
     3090        set key "HST  $HST"
     3091    } else {
     3092        set key "HST $HST"
     3093    }
     3094    if {$HST == "" && $action == "set"} {
    28923095        # no RSN found need to add the soft constr. histogram
    28933096        # increment number of histograms
     
    29153118        makeexprec "$key NBNDS"
    29163119    }
    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 }
     3120
     3121    switch -glob ${parm}-$action {
     3122        weight-get {
     3123            return [string trim [string range [readexp "$key FACTR"] 0 14]]
     3124        }
     3125        weight-set {
     3126            # update FACTR
     3127            if ![validreal value 15 6] {return 0}
     3128            setexp "$key FACTR" $value 1 15
     3129        }
     3130        restraintlist-get {
     3131            set ncons [string trim [string range [readexp "$key NBNDS"] 0 4]]
     3132            set conslist {}
     3133            for {set i 1} {$i <= $ncons} {incr i} {
     3134                set fi [string toupper [format %.4x $i]]
     3135                set line [readexp "${key}BD$fi"]
     3136                set const {}
     3137                foreach len {3 5 5 3 3 3 3 3 6 6} {
     3138                  set lenm1 [expr {$len - 1}]
     3139                  lappend const [string trim [string range $line 0 $lenm1]]
     3140                  set line [string range $line $len end]
     3141                }
     3142                lappend conslist $const
     3143            }
     3144            return $conslist
     3145        }
     3146        restraintlist-set {
     3147            set num [llength $value]
     3148            if ![validint num 5] {return 0}
     3149            setexp "$key NBNDS" $num 1 5
     3150            # delete all old records
     3151            foreach i [array names ::exparray "${key}BD*"] {unset ::exparray($i)}
     3152            set i 0
     3153            foreach cons $value {
     3154                incr i
     3155                set fi [string toupper [format %.4x $i]]
     3156                makeexprec "${key}BD$fi"
     3157                set pos 1
     3158                foreach num $cons len {3 5 5 3 3 3 3 3 -6 -6} {
     3159                    if {$len > 0} {
     3160                        validint num $len
     3161                        setexp "${key}BD$fi" $num $pos $len
     3162                    } else {
     3163                        set len [expr abs($len)]
     3164                        validreal num $len 3
     3165                        setexp "${key}BD$fi" $num $pos $len
     3166                    }
     3167                    incr pos $len
     3168                }
     3169            }
     3170        }
     3171        default {
     3172            set msg "Unsupported phaseinfo access: parm=$parm action=$action"
     3173            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
     3174        }
     3175    return 1
     3176    }
     3177}
     3178
    29503179#======================================================================
    29513180# conversion routines
Note: See TracChangeset for help on using the changeset viewer.