Changeset 1025


Ignore:
Timestamp:
10/13/2010 02:27:15 PM (2 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.