Changeset 43


Ignore:
Timestamp:
Dec 4, 2009 4:59:25 PM (14 years ago)
Author:
toby
Message:

# on 1999/01/21 22:22:09, toby did:
now 1 arg (get gsasexe from location/.gsas_config)
use readexp.tcl
remove /tmp/ in makepostscriptout
move some global vars to array elements
use catch on compute loop for undefined widths
SaveOptions?
use localconfig & .gsas_config

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/widplt

    • Property rcs:date changed from 1998/11/23 20:06:43 to 1999/01/21 22:22:09
    • Property rcs:lines changed from +8 -8 to +174 -193
    • Property rcs:rev changed from 1.2 to 1.3
    r8 r43  
    22set Revision {$Revision$ $Date$}
    33bind all <Control-KeyPress-c> {destroy .}
    4 # hope for the best
    5 set gsasexe {/usr/local/gsas}
    6 if {[lindex $argv 0] != ""} {set gsasexe [lindex $argv 0]}
    7 set expnam [file root [lindex $argv 1]]
    8 #if {$expnam == ""} {puts "error -- no experiment name"; destroy .}
     4set expnam [lindex $argv 0]
     5if {$expnam != ""} {
     6    if {[string toupper [file extension $expnam]] != ".EXP"} {
     7        append expnam ".EXP"
     8    }
     9}
    910if [catch {package require BLT} errmsg] {
    1011    tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \
    … …  
    4748}
    4849
    49 if {$expnam != ""} {waitmsg "Loading $expnam.EXP, Please wait"}
    50 
    51 # read an EXP file into an array
    52 proc expload {file} {
    53     global exparray gsasexe
    54     if [catch {
    55         set fil [open $file r]
    56     }] {return 1}
    57     set len [gets $fil line]
    58     # is this a direct access file?
    59     if {$len > 160} {
    60         close $fil
    61         # use convdtos because tcl can't handle null characters
    62         if ![file executable $gsasexe/convdtos] {
    63         tk_dialog .err \
    64                 "Warning" "Warning -- Unable to read direct access EXP file, convdtos not found." \
    65             error 0 Continue
    66           return
    67         }
    68         set fil [open "| $gsasexe/convdtos < $file" r]
    69         set len [gets $fil line]
    70     }
    71     while {$len > 0} {
    72         set key [string range $line 0 11]
    73         set exparray($key) [string range $line 12 end]
    74         set len [gets $fil line]
    75     }
    76     close $fil
    77     return 0
    78 }
    79 
    80 proc readexp {key} {
    81     global exparray
    82     # truncate long keys & pad short ones
    83     set key [string range "$key          " 0 11]
    84     if [catch {set val $exparray($key)}] return
    85     return $val
    86 }
     50if {$expnam != ""} {waitmsg "Loading $expnam, Please wait"}
    8751
    8852# get profile information out from a EXP file
    89 proc getprofiles {} {
     53proc getprofiles {expnam} {
    9054    global datalist wave XY UVWP lblarr ttrange
    91     set nhist [string trim [readexp { EXPR  NHST }]]
    92     set n 0
    93     # get the histogram types
    94     for {set i 0} {$i < $nhist} {incr i} {
    95         if {[expr $i % 12] == 0} {
    96             incr n
    97             set line [readexp " EXPR  HTYP$n"]
    98         }
    99         set ihist [expr $i + 1]
    100         set htype($ihist) [lindex $line $i]
    101     }
    102     for {set i 0} {$i < $nhist} {incr i} {
    103         set ihist [expr $i + 1]
    104         set line [lrange $line 1 end]
    105 
    106         # process powder data only
    107         if {[string range $htype($ihist) 0 0] != "P"} continue
    108         # for now skip TOF data as well
    109         if {[string range $htype($ihist) 2 2] != "C"} continue
    110         set line [readexp "HST  $ihist NPHAS"]
    111 
    112         # loop over phases
    113         set iph 0
    114         foreach flag $line {
    115             incr iph
    116             if !$flag continue
    117             # wavelength
    118             set line [readexp "HST  $ihist ICONS"]
    119             set lambda1 [lindex $line 0]
    120             # data range
    121             set drange [readexp "HST  $ihist TRNGE"]
    122             set key [format %s%1d%2d%s HAP $iph $ihist PRCF]
    123             set line [readexp $key]
    124             set ptype [lindex $line 0]
    125             set pterms  [lindex $line 1]
    126             set it 0
    127             set line {}
    128             while {$it < ($pterms+3)/4} {
    129                 set key [format %s%1d%2d%s%2d HAP $iph $ihist PRCF $it]
    130                 append line [readexp $key]
    131                 incr it
     55
     56    if [expload $expnam] {
     57        tk_dialog .err "EXP Error" "Error -- Unable to read $expnam" \
     58                error 0 OK
     59        return
     60    }
     61    mapexp
     62
     63    global expmap
     64    foreach hist $expmap(powderlist) {
     65        # wavelength
     66        set lambda1 [histinfo $hist lam1]
     67        # data range
     68        set drange [readexp "HST  $hist TRNGE"]
     69        foreach phase $expmap(phaselist_$hist) {
     70            set ptype [hapinfo $hist $phase proftype]
     71            set pterms  [hapinfo $hist $phase profterms]
     72            set key "H${hist}P${phase}"
     73            # make sure the key is not present already
     74            if {[lsearch $datalist $key] == -1} {
     75                lappend datalist $key
    13276            }
    133             set key "H${ihist}P$iph"
    134             lappend datalist $key
    135             set lblarr($key) "Histogram $ihist Phase $iph"
     77            set lblarr($key) "Histogram $hist Phase $phase"
    13678            set wave($key) $lambda1
    13779            set ttrange($key) $drange
    13880            if {$ptype == 1} {
    139                 set UVWP($key) "[lrange $line 0 2] 0"
     81                set UVWP($key) "[hapinfo $hist $phase pterm1] [hapinfo $hist $phase pterm2] [hapinfo $hist $phase pterm3] 0"
    14082                set XY($key) {0 0}
    14183            } elseif {$ptype == 2} {
    142                 set UVWP($key) "[lrange $line 0 2] [lindex $line 8]"
    143                 set XY($key) [lrange $line 3 4]
    144             } elseif {$ptype == 3} {
    145                 set UVWP($key) "[lrange $line 0 3]"
    146                 set XY($key) [lrange $line 4 5]
     84                set UVWP($key) "[hapinfo $hist $phase pterm1] [hapinfo $hist $phase pterm2] [hapinfo $hist $phase pterm3] [hapinfo $hist $phase pterm9]"
     85                set XY($key) "[hapinfo $hist $phase pterm4] [hapinfo $hist $phase pterm5]"
     86            } elseif {$ptype == 3 || $ptype == 4} {
     87                set UVWP($key) "[hapinfo $hist $phase pterm1] [hapinfo $hist $phase pterm2] [hapinfo $hist $phase pterm3] [hapinfo $hist $phase pterm4]"
     88                set XY($key) "[hapinfo $hist $phase pterm5] [hapinfo $hist $phase pterm6]"
    14789            }
    14890        }
    … …  
    15395    global graph box
    15496    if !$graph(printout) {
    155         set out [open "| $graph(outcmd) >& /tmp/liveplot.msg" w]
     97        set out [open "| $graph(outcmd) >& widplt.msg" w]
    15698        catch {
    15799            puts $out [$box postscript output -landscape 1 \
    … …  
    160102        } msg
    161103        catch {
    162             set out [open /tmp/liveplot.msg r]
     104            set out [open widplt.msg r]
    163105            if {$msg != ""} {append msg "\n"}
    164106            append msg [read $out]
    165107            close $out
    166             file delete /tmp/liveplot.msg
     108            file delete widplt.msg
    167109        }
    168110        if {$msg != ""} {
    … …  
    199141
    200142proc seteqwave {top} {
    201     global equivwave
     143    global graph
    202144    set box .wave
    203145    catch {destroy $box}
    … …  
    207149    pack [frame $box.1] -side top
    208150    pack [label $box.1.a -text "Equivalent wavelength:"] -side top
    209     pack [entry $box.1.b -textvariable equivwave] -side top
     151    pack [entry $box.1.b -textvariable graph(equivwave)] -side top
    210152    pack [frame $box.2] -side top
    211     pack [button $box.2.c -text Clear -command "set equivwave {}; destroy $box"]
     153    pack [button $box.2.c -text Clear -command "set graph(equivwave) {}; destroy $box"]
    212154    pack [button $box.2.u -text Use -command "destroy $box"]
    213155    tkwait window $box
    … …  
    493435}
    494436
    495 proc plotdata {graph} {
    496     global UVWP XY wave lblarr datalist display plotunits ttrange equivwave
    497     if {$plotunits == "d"} {
    498         $graph xaxis configure -title "d (A)"
    499     } elseif {$plotunits == "q"} {
    500         $graph xaxis configure -title "Q (A-1)"
    501     } elseif {$equivwave == ""} {
    502         $graph xaxis configure -title "2Theta"
     437proc plotdata {top} {
     438    global UVWP XY wave lblarr datalist display \
     439            graph ttrange
     440    if {$graph(plotunits) == "d"} {
     441        $top xaxis configure -title "d (A)"
     442    } elseif {$graph(plotunits) == "q"} {
     443        $top xaxis configure -title "Q (A-1)"
     444    } elseif {$graph(equivwave) == ""} {
     445        $top xaxis configure -title "2Theta"
    503446    } else {
    504         $graph xaxis configure -title "2Theta @ $equivwave"
    505     }
    506     $graph yaxis configure -min 0
    507     $graph xaxis configure -min 0
     447        $top xaxis configure -title "2Theta @ $graph(equivwave)"
     448    }
     449    $top yaxis configure -min 0
     450    $top xaxis configure -min 0
    508451    # delete all graphs
    509     eval $graph element delete [$graph element names]
     452    eval $top element delete [$top element names]
    510453    set num -1
    511454    foreach item $datalist {
    … …  
    525468                    {set tt [expr $tt + 4]} {
    526469                set lfwhm 0
    527                 if {$plotunits == "d"} {
    528                     lappend ttlist [tt2d $wave($item) $tt ]
    529                     set gfwhm [deltad $wave($item) $tt \
    530                             [eval FWHM $tt $UVWP($item)]]
    531                     lappend fwhmlist $gfwhm
    532                     if $lflag {
    533                         set lfwhm [deltad $wave($item) $tt \
    534                                 [eval LFWHM $tt $XY($item)]]
    535                         lappend lfwhmlist $lfwhm
    536                     }
    537                 } elseif {$plotunits == "q"} {
    538                     lappend ttlist [tt2Q $wave($item) $tt ]
    539                     set gfwhm [deltaQ $wave($item) $tt \
    540                             [eval FWHM $tt $UVWP($item)]]
    541                     lappend fwhmlist $gfwhm
    542                     if $lflag {
    543                         set lfwhm [deltaQ $wave($item) $tt \
    544                             [eval LFWHM $tt $XY($item)]]
    545                         lappend lfwhmlist $lfwhm
    546                     }
    547                 } elseif {$equivwave == ""} {
    548                     lappend ttlist $tt
    549                     set gfwhm [eval FWHM $tt $UVWP($item)]
    550                     lappend fwhmlist $gfwhm
    551                     if $lflag {
    552                         set lfwhm [eval LFWHM $tt $XY($item)]
    553                         lappend lfwhmlist $lfwhm
    554                     }
    555                 } else {
    556                     set tteq [ttequiv $wave($item) $tt $equivwave]
    557                     if {$tteq != ""} {
    558                         lappend ttlist $tteq
    559                         set gfwhm [delta2teq $wave($item) $tt \
    560                                 [eval FWHM $tt $UVWP($item)] $equivwave]
     470                catch {
     471                    if {$graph(plotunits) == "d"} {
     472                        lappend ttlist [tt2d $wave($item) $tt ]
     473                        set gfwhm [deltad $wave($item) $tt \
     474                                [eval FWHM $tt $UVWP($item)]]
    561475                        lappend fwhmlist $gfwhm
    562476                        if $lflag {
    563                             set lfwhm [delta2teq $wave($item) $tt \
    564                                     [eval LFWHM $tt $XY($item)] $equivwave]
     477                            set lfwhm [deltad $wave($item) $tt \
     478                                    [eval LFWHM $tt $XY($item)]]
    565479                            lappend lfwhmlist $lfwhm
    566480                        }
     481                    } elseif {$graph(plotunits) == "q"} {
     482                        lappend ttlist [tt2Q $wave($item) $tt ]
     483                        set gfwhm [deltaQ $wave($item) $tt \
     484                                [eval FWHM $tt $UVWP($item)]]
     485                        lappend fwhmlist $gfwhm
     486                        if $lflag {
     487                            set lfwhm [deltaQ $wave($item) $tt \
     488                                    [eval LFWHM $tt $XY($item)]]
     489                            lappend lfwhmlist $lfwhm
     490                        }
     491                    } elseif {$graph(equivwave) == ""} {
     492                        lappend ttlist $tt
     493                        set gfwhm [eval FWHM $tt $UVWP($item)]
     494                        lappend fwhmlist $gfwhm
     495                        if $lflag {
     496                            set lfwhm [eval LFWHM $tt $XY($item)]
     497                            lappend lfwhmlist $lfwhm
     498                        }
     499                    } else {
     500                        set tteq [ttequiv $wave($item) $tt $graph(equivwave)]
     501                        if {$tteq != ""} {
     502                            lappend ttlist $tteq
     503                            set gfwhm [delta2teq $wave($item) $tt \
     504                                    [eval FWHM $tt $UVWP($item)] $graph(equivwave)]
     505                            lappend fwhmlist $gfwhm
     506                            if $lflag {
     507                                set lfwhm [delta2teq $wave($item) $tt \
     508                                        [eval LFWHM $tt $XY($item)] $graph(equivwave)]
     509                                lappend lfwhmlist $lfwhm
     510                            }
     511                        }
    567512                    }
     513                    # assume FWHM add as square roots
     514                    lappend tfwhmlist \
     515                            [expr sqrt($gfwhm*$gfwhm + $lfwhm*$lfwhm)]
    568516                }
    569                 # assume FWHM add as square roots
    570                 lappend tfwhmlist \
    571                         [expr sqrt($gfwhm*$gfwhm + $lfwhm*$lfwhm)]
    572517            }
    573518            if $lflag {
    574519                catch {
    575                     $graph element create ${item}G -label "$lblarr($item) G"
     520                    $top element create ${item}G -label "$lblarr($item) G"
    576521                }
    577                 $graph element config ${item}G \
     522                $top element config ${item}G \
    578523                    -xdata $ttlist -ydata $fwhmlist -linewidth 3 \
    579524                    -color [nextcolor num]
    580525                catch {
    581                     $graph element create ${item}L -label "$lblarr($item) L"
     526                    $top element create ${item}L -label "$lblarr($item) L"
    582527                }
    583                 $graph element config ${item}L \
     528                $top element config ${item}L \
    584529                        -xdata $ttlist -ydata $lfwhmlist -linewidth 3 \
    585530                        -color [nextcolor num]
    586531            }
    587532            catch {
    588                 $graph element create $item -label $lblarr($item)
     533                $top element create $item -label $lblarr($item)
    589534            }
    590             $graph element config $item \
     535            $top element config $item \
    591536                    -xdata $ttlist -ydata $tfwhmlist -linewidth 3 \
    592537                    -color [nextcolor num]
    593538        }
    594539    }
     540}
     541
     542# save some of the global options in ~/.gsas_config
     543proc SaveOptions {} {
     544    global graph
     545    set fp [open [file join ~ .gsas_config] a]
     546    puts $fp "set graph(legend) $graph(legend)"
     547    puts $fp "set graph(printout) $graph(printout)"
     548    puts $fp "set graph(outname) $graph(outname)"
     549    puts $fp "set graph(outcmd) $graph(outcmd)"
     550    puts $fp "set graph(plotunits) $graph(plotunits)"
     551    puts $fp "set graph(equivwave) $graph(equivwave)"
     552    close $fp
    595553}
    596554#-------------------------------------------------------------------------
    … …  
    693651trace variable newmenu(opt) w loadopt
    694652
    695 set legend 0
    696 set equivwave {}
    697 set plotunits tt
     653set graph(legend) 0
     654set graph(equivwave) {}
     655set graph(plotunits) tt
    698656if {$tcl_platform(platform) == "windows"} {
    699657    set graph(printout) 1
    … …  
    705663set datalist {}
    706664
     665#----------------------------------------------------------------
     666# where are we?
     667set expgui(script) [info script]
     668# translate links -- go six levels deep
     669foreach i {1 2 3 4 5 6} {
     670    if {[file type $expgui(script)] == "link"} {
     671        set link [file readlink $expgui(script)]
     672        if { [file  pathtype  $link] == "absolute" } {
     673h           set expgui(script) $link
     674        } {
     675            set expgui(script) [file dirname $expgui(script)]/$link
     676        }
     677    } else {
     678        break
     679    }
     680}
     681# fixup relative paths
     682if {[file pathtype $expgui(script)] == "relative"} {
     683    set expgui(script) [file join [pwd] $expgui(script)]
     684}
     685set expgui(scriptdir) [file dirname $expgui(script) ]
     686
     687# fetch EXP file processing routines
     688source [file join $expgui(scriptdir) readexp.tcl]
     689
     690# override options with locally defined values
     691if [file exists [file join $expgui(scriptdir) localconfig]] {
     692    source [file join $expgui(scriptdir) localconfig]
     693}
     694if [file exists [file join ~ .gsas_config]] {
     695    source [file join ~ .gsas_config]
     696}
     697#----------------------------------------------------------------
     698
    707699if {$expnam != ""} {
    708     if [expload $expnam.EXP] {
    709         tk_dialog .err "EXP Error" "Error -- Unable to read $expnam.EXP" \
    710                 error 0 Quit
    711         destroy .
    712     }
    713700    # OK now go get the profile info
    714     getprofiles
    715 }
    716 
    717 # get the location of the script but translate up to n levels of links
    718 set scriptname [info script]
    719 set i -1
    720 while {[file type $scriptname] == "link"} {
    721     if {[incr i] >= 20} {
    722         puts "More than $i links for [info script], giving up"
    723         destroy .
    724     }
    725     if {[file pathtype [set link [file readlink $scriptname]]] == "absolute"} {
    726         set scriptname $link
    727     } {
    728         set scriptname [file dirname $scriptname]/$link
    729     }
    730 }
    731 set scriptdir [file dirname $scriptname]
    732 
    733 foreach file [glob -nocomplain [file join $scriptdir widplt_*]] {
     701    getprofiles $expnam
     702}
     703
     704#----------------------------------------------------------------
     705foreach file [glob -nocomplain [file join $expgui(scriptdir) widplt_*]] {
    734706    source $file
    735707}
    … …  
    742714$box config -title {}
    743715$box yaxis config -title {FWHM}
    744 setlegend $box $legend
     716setlegend $box $graph(legend)
    745717#frame .a -bd 8 -relief groove
    746718frame .a -bd 2 -relief groove
    … …  
    752724#.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
    753725if {$expnam != ""} {
    754     .a.file.menu add command -label "Reload from EXP" -command getprofiles
     726    .a.file.menu add command -label "Reload from EXP" \
     727            -command "getprofiles $expnam; plotdata $box"
    755728}
    756729.a.file.menu add command -label "Add New Curve" -command newmenu
    … …  
    761734        -side left   
    762735menu .a.options.menu
    763 .a.options.menu add radiobutton -label "2Theta" -value tt -variable plotunits \
     736.a.options.menu add radiobutton -label "2Theta" -value tt \
     737        -variable graph(plotunits) \
    764738        -command "plotdata $box"
    765 .a.options.menu add command -label "Set Equiv. Wavelength" -command "seteqwave $box"
    766 .a.options.menu add radiobutton -label "d-space" -value d -variable plotunits \
     739.a.options.menu add command -label "Set Equiv. Wavelength" \
     740        -command "seteqwave $box"
     741.a.options.menu add radiobutton -label "d-space" -value d \
     742        -variable graph(plotunits) \
    767743        -command "plotdata $box"
    768 .a.options.menu add radiobutton -label "Q" -value q -variable plotunits \
     744.a.options.menu add radiobutton -label "Q" -value q \
     745        -variable graph(plotunits) \
    769746        -command "plotdata $box"
    770 .a.options.menu add checkbutton -label "Include legend" -variable legend \
    771         -command {setlegend $box $legend}
    772 .a.options.menu add command -label "Set PS output" -command setpostscriptout
     747.a.options.menu add checkbutton -label "Include legend" \
     748        -variable graph(legend) \
     749        -command {setlegend $box $graph(legend)}
     750.a.options.menu add command -label "Set PS output" \
     751        -command setpostscriptout
     752.a.options.menu add command -label "Save Options" -underline 1 \
     753        -command "SaveOptions"
    773754
    774755pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
    … …  
    778759foreach item $datalist {
    779760    .a.plot.menu add checkbutton -label $lblarr($item) \
    780             -command {plotdata $box} -variable display($item)
     761            -command "plotdata $box" -variable display($item)
    781762}
    782763
Note: See TracChangeset for help on using the changeset viewer.