Changeset 73


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

# on 1999/03/19 17:07:59, toby did:
major reworking -- implement tcldump, and new display options, hkl labels

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/liveplot

    • Property rcs:date changed from 1999/02/16 18:05:57 to 1999/03/19 17:07:59
    • Property rcs:lines changed from +10 -9 to +178 -23
    • Property rcs:rev changed from 1.4 to 1.5
    r53 r73  
    11#!/usr/local/bin/wish
    22set Revision {$Revision$ $Date$}
     3
    34bind all <Control-KeyPress-c> {destroy .}
    45# process command line arguments
     
    2425if {$tcl_platform(platform) == "windows"} {
    2526    set graph(printout) 1
     27    set expgui(tcldump) tcldump.exe
    2628} else {
    2729    set graph(printout) 0
     30    set expgui(tcldump) tcldump
    2831}
    2932
     
    3134set graph(outname) out.ps
    3235set graph(outcmd) lpr
     36set xunits {}
     37set yunits {}
     38set graph(xunits) 0
     39set graph(yunits) 0
     40set expgui(debug) 0
     41catch {if $env(DEBUG) {set expgui(debug) 1}}
     42#set expgui(debug) 1
    3343
    3444if [catch {package require BLT} errmsg] {
     
    105115        set link [file readlink $expgui(script)]
    106116        if { [file  pathtype  $link] == "absolute" } {
    107 h           set expgui(script) $link
     117            set expgui(script) $link
    108118        } {
    109119            set expgui(script) [file dirname $expgui(script)]/$link
     
    122132set expgui(gsasexe) [file join $expgui(gsasdir) exe]
    123133
    124 
    125 proc readdata {box} {
     134proc readdata {box} {
     135    global expgui
     136    if [catch {
     137        #puts [time {
     138            if {$expgui(tcldump) == ""} {
     139                readdata_hst $box
     140            } else {
     141                readdata_tcl $box
     142            }
     143        #}]
     144    } errmsg] {
     145        if $expgui(debug) {error $errmsg}
     146        $box config -title "Read error: $errmsg"
     147        catch {console show}
     148        puts "error message: $errmsg"
     149        update
     150    }
     151}
     152   
     153proc readdata_hst {box} {
    126154    global expgui expnam reflns
    127155    global lasthst
    128     global hst peakinfo units
     156    global hst peakinfo xunits
    129157    $box config -title "(Histogram update in progress)"
    130158    update
    131159    # parse the output of a file
    132     if [catch {
    133160        set lasthst $hst
    134161###########################################################################
     
    155182        set calclist {}
    156183        set bcklist {}
    157         set units {}
     184        set xunits {}
    158185        # define a list of reflection positions for each phase
    159186        for {set i 1} {$i < 10} {incr i} {
    160187            set reflns($i) {}
    161             #   set flag$i 0
    162188        }
    163189        set i 0
     
    188214                }
    189215            } else {
    190                 regexp {Time|Theta|keV} $line units
     216                regexp {Time|Theta|keV} $line xunits
    191217            }
    192218        }
    193         if {$units == "Theta"} {set units "2-Theta"}
     219        if {$xunits == "Theta"} {set xunits "2-Theta"}
    194220        close $input
    195221        catch {file delete histdump$hst.inp}
     
    209235        }
    210236        plotdata $box
    211     } errmsg] {
    212         $box config -title "Read error: $errmsg"
    213         catch {console show}
    214         puts "error message: $errmsg"
    215         update
    216     }   
     237}
     238
     239proc readdata_tcl {box} {
     240    global expgui expnam reflns
     241    global lasthst graph
     242    global hst peakinfo xunits yunits
     243    $box config -title "(Histogram update in progress)"
     244    update
     245    # parse the output of a file
     246    set lasthst $hst
     247    # use tcldump
     248    set input [open histdump$hst.inp w]
     249    puts $input "$hst"
     250    # x units -- native
     251    puts $input "$graph(xunits)"
     252    # y units  -- native
     253    puts $input "$graph(yunits)"
     254    # format (if implemented someday)
     255    puts $input "0"
     256    close $input
     257    # initalize arrays
     258    set X {}
     259    set OBS {}
     260    set CALC {}
     261    set BKG {}
     262    set refpos {}
     263    global refhkllist refphaselist
     264    set refhkllist {}
     265    set refphaselist {}
     266    for {set i 1} {$i < 10} {incr i} {
     267        set reflns($i) {}
     268    }
     269    eval [exec $expgui(tcldump) $expnam < histdump$hst.inp]
     270    catch {file delete histdump$hst.inp}
     271    if {$X == ""} {
     272        $box config -title "(Error reading Histogram $hst)"
     273        foreach elem [$box element show] {
     274           $box element config $elem -hide 1
     275        }
     276        return
     277    }
     278    foreach elem [$box element names] {
     279        $box element config $elem -hide 0
     280    }
     281    xvec set $X
     282    obsvec set $OBS
     283    calcvec set $CALC
     284    bckvec set $BKG
     285    refposvec set $refpos
     286    diffvec set [obsvec - calcvec]
     287    global obsvec calcvec diffvec
     288    set maxdiff  [set diffvec(max)]
     289    set ymin1 [expr [set calcvec(min)] - 1.1*$maxdiff]
     290    set ymin2 [expr [set obsvec(min)] - 1.1*$maxdiff]
     291    if {$ymin1 < $ymin2} {
     292        diffvec set [diffvec + $ymin1]
     293    } {
     294        diffvec set [diffvec + $ymin2]
     295    }
     296    plotdata $box
     297}
     298
     299proc lblhkl {plot x} {
     300    global cellparm command blt_version refhkllist refphaselist peakinfo
     301    # look for peaks within pixelregion pixels
     302    set pixelregion 5
     303    set xmin [$plot xaxis invtransform [expr $x - $pixelregion]]
     304    set xmax [$plot xaxis invtransform [expr $x + $pixelregion]]
     305    set peaknums [refposvec search $xmin $xmax]
     306    set peaklist {}
     307    set xcen 0
     308    # select by displayed phases
     309    set lbls 0
     310#    puts ""
     311    foreach peak $peaknums {
     312#       puts "hkl [lindex $refhkllist $peak] phase [lindex $refphaselist $peak]"
     313        if [set peakinfo(flag[lindex $refphaselist $peak])] {
     314            set xcen [expr $xcen + [refposvec range $peak $peak]]
     315            lappend peaklist [lindex $refhkllist $peak]
     316            incr lbls
     317        }
     318    }
     319    if {$peaklist == ""} return
     320    set xcen [expr $xcen / $lbls]
     321    # avoid bug in BLT 2.3 where Inf does not work for text markers
     322    if {$blt_version == 2.3} {
     323        set ycen [lindex [$plot yaxis limits] 1]
     324    } else  {
     325        set ycen Inf
     326    }
     327    set mark [$plot marker create text -coords "$xcen $ycen" \
     328            -rotate 90 -text $peaklist -anchor n -bg ""]
     329    after 10000 "$plot marker delete $mark"
    217330}
    218331
    219332proc plotdata {box} {
    220     global expnam hst peakinfo units cycle reflns modtime
     333    global expnam hst peakinfo xunits yunits cycle reflns modtime
    221334    global lasthst graph
    222335
     
    237350    diffvec notify now
    238351    $box config -title "$expnam cycle $cycle Hist $hst"
    239     $box xaxis config -title $units
     352    $box xaxis config -title $xunits
     353    $box yaxis config -title $yunits
    240354    setlegend $box $graph(legend)
    241355    # now deal with peaks
     
    474588}
    475589
     590if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] {
     591    set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)]
     592#    puts "got tcldump"
     593} else {
     594    set expgui(tcldump) {}
     595#    puts "no tcldump"
     596}
     597
    476598# vectors
    477599vector xvec
     
    485607vector diffvec
    486608diffvec notify never
     609vector refposvec
     610refposvec notify never
    487611# create the graph
    488612set box [graph .g]
     
    490614$box element create obs -color black -symbol scross -linewidth 0
    491615$box element create calc -color red  -symbol none 
    492 #$box element create bckg -color green  -symbol none 
    493616$box element create diff -color blue  -symbol none 
    494617$box element config obs -xdata xvec -ydata obsvec
    495618$box element config calc -xdata xvec -ydata calcvec
    496 #$box element config bckg -xdata xvec -ydata bckvec
    497619$box element config diff -xdata xvec -ydata diffvec
     620if {$expgui(tcldump) != ""} {
     621    $box element create bckg -color green  -symbol none 
     622    $box element config bckg -xdata xvec -ydata bckvec
     623    bind $box <Shift-Button-1> "lblhkl %W %x"
     624}
    498625$box yaxis config -title {}
    499626setlegend $box $graph(legend)
     
    512639.a.file.menu add cascade -label "Histogram" -menu .a.file.menu.hist
    513640menu .a.file.menu.hist
    514 foreach num {1 2 3 4 5 6 7 8 9} {
    515     .a.file.menu.hist add radiobutton -label $num -value $num -variable hst \
    516             -command {plotdata $box}
     641for {set num 1} {$num < 99} {incr num 10} {
     642    .a.file.menu.hist add cascade -label "$num-[expr $num+9]" \
     643            -menu .a.file.menu.hist.$num
     644    menu .a.file.menu.hist.$num
     645    for {set num1 $num} {$num1 < 10+$num} {incr num1} {
     646        .a.file.menu.hist.$num add radiobutton -label $num1 -value $num1 \
     647                -variable hst \
     648                -command {set cycle [getcycle];readdata .g}
     649    }
    517650}
    518651.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
     
    537670            -command "minioptionsbox $num"
    538671}
     672if {$expgui(tcldump) != ""} {
     673    .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
     674    menu .a.options.menu.xunits
     675    .a.options.menu.xunits add radiobutton -label "As collected" \
     676            -variable graph(xunits) -value 0 \
     677            -command {set cycle [getcycle];readdata .g}
     678    .a.options.menu.xunits add radiobutton -label "d-space" \
     679            -variable graph(xunits) -value 1 \
     680            -command {set cycle [getcycle];readdata .g}
     681    .a.options.menu.xunits add radiobutton -label "Q" \
     682            -variable graph(xunits) -value 2 \
     683            -command {set cycle [getcycle];readdata .g}
     684    .a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
     685    menu .a.options.menu.yunits
     686    .a.options.menu.yunits add radiobutton -label "As collected" \
     687            -variable graph(yunits) -value 0 \
     688            -command {set cycle [getcycle];readdata .g}
     689    .a.options.menu.yunits add radiobutton -label "Normalized" \
     690            -variable graph(yunits) -value 1 \
     691            -command {set cycle [getcycle];readdata .g}
     692}
     693   
    539694.a.options.menu add checkbutton -label "Include legend" \
    540695        -variable graph(legend) \
Note: See TracChangeset for help on using the changeset viewer.