#!/usr/local/bin/wish # $Id: liveplot 87 2009-12-04 23:00:11Z toby $ set Revision {$Revision: 87 $ $Date: 2009-12-04 23:00:11 +0000 (Fri, 04 Dec 2009) $} bind all {destroy .} # process command line arguments set exitstat 0 set expnam [lindex $argv 0] if {$expnam == ""} {puts "error -- no experiment name"; set exitstat 1} if $exitstat { puts "usage: $argv0 expnam \[hist #\] \[legend\]" destroy . } if {[lindex $argv 1] == ""} { set hst 1 } else { set hst [lindex $argv 1] } if {[lindex $argv 2] == ""} { set graph(legend) 1 } else { set graph(legend) [lindex $argv 2] } set graph(backsub) 0 if {$tcl_platform(platform) == "windows"} { set graph(printout) 1 set expgui(tcldump) tcldump.exe } else { set graph(printout) 0 set expgui(tcldump) tcldump } # default values set graph(outname) out.ps set graph(outcmd) lpr set xunits {} set yunits {} set graph(xunits) 0 set graph(yunits) 0 set expgui(debug) 0 catch {if $env(DEBUG) {set expgui(debug) 1}} #set expgui(debug) 1 set expgui(lblfontsize) 15 set expgui(fadetime) 10 set expgui(hklbox) 1 set expgui(autotick) 0 set expgui(pixelregion) 5 set peakinfo(obssym) scross set peakinfo(obssize) 1.0 # create a set of markers for each phase for {set i 1} {$i < 10} {incr i} { set peakinfo(flag$i) 0 set peakinfo(max$i) Inf set peakinfo(min$i) -Inf set peakinfo(dashes$i) 1 } if [catch {package require BLT} errmsg] { tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \ error 0 Quit destroy . } # handle Tcl/Tk v8+ where BLT is in a namespace # use the command so that it is loaded catch {blt::graph} catch { namespace import blt::graph namespace import blt::vector } # old versions of blt don't report a version number if [catch {set blt_version}] {set blt_version 0} # option for coloring markers: note that GH keeps changing how to do this! # also element -mapped => -show if {$blt_version < 2.3 || $blt_version >= 8.0} { # version 8.0 is ~same as 2.3 set graph(MarkerColorOpt) -fg # mapped is needed in 8.0, both are OK in 2.3 set graph(ElementShowOption) "-mapped 1" set graph(ElementHideOption) "-mapped 0" } elseif {$blt_version >= 2.4} { set graph(MarkerColorOpt) -outline set graph(ElementShowOption) "-hide 0" set graph(ElementHideOption) "-hide 1" } else { set graph(MarkerColorOpt) -color set graph(ElementShowOption) "-mapped 1" set graph(ElementHideOption) "-mapped 0" } proc waitmsg {message} { set w .wait # kill any window/frame with this name catch {destroy $w} pack [frame $w] frame $w.bot -relief raised -bd 1 pack $w.bot -side bottom -fill both frame $w.top -relief raised -bd 1 pack $w.top -side top -fill both -expand 1 label $w.msg -justify left -text $message -wrap 3i catch {$w.msg configure -font \ -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-* } pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m label $w.bitmap -bitmap info pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m update } proc donewait {} { catch {destroy .wait} update } waitmsg "Loading histogram, Please wait" #-------------------------------------------------------------- # define constants array set peakinfo { color1 magenta color2 cyan color3 yellow color4 sienna color5 orange color6 DarkViolet color7 HotPink color8 salmon color9 LimeGreen } set cycle -1 set modtime 0 #---------------------------------------------------------------- # where are we? set expgui(script) [info script] # translate links -- go six levels deep foreach i {1 2 3 4 5 6} { if {[file type $expgui(script)] == "link"} { set link [file readlink $expgui(script)] if { [file pathtype $link] == "absolute" } { set expgui(script) $link } { set expgui(script) [file dirname $expgui(script)]/$link } } else { break } } # fixup relative paths if {[file pathtype $expgui(script)] == "relative"} { set expgui(script) [file join [pwd] $expgui(script)] } set expgui(scriptdir) [file dirname $expgui(script) ] set expgui(gsasdir) [file dirname $expgui(scriptdir)] set expgui(gsasexe) [file join $expgui(gsasdir) exe] # called by a trace on expgui(lblfontsize) proc setfontsize {a b c} { global expgui graph catch { font config lblfont -size [expr -$expgui(lblfontsize)] # this forces a redraw of the plot by changing the title to itself .g configure -title [.g cget -title] } } # define a font used for labels if {$tcl_version >= 8.0} { font create lblfont -family Helvetica -size [expr -$expgui(lblfontsize)] trace variable expgui(lblfontsize) w setfontsize } proc readdata {box} { global expgui if [catch { set loadtime [time { if {$expgui(tcldump) == ""} { readdata_hst $box } else { readdata_tcl $box } }] if $expgui(debug) { tk_dialog .time "Timing info" \ "Histogram loading took $loadtime" "" 0 OK } } errmsg] { if $expgui(debug) { catch {console show} error $errmsg } $box config -title "Read error" tk_dialog .err "Read Error" "Read Error -- $errmsg" \ error 0 OK update } } proc readdata_hst {box} { global expgui expnam reflns global lasthst global hst peakinfo xunits $box config -title "(Histogram update in progress)" update # parse the output of a file set lasthst $hst ########################################################################### # set input [open histdump.inp w] # puts $input "$hst" # close $input # set input [open "| $expgui(gsasexe)/hstdump $expnam < histdump.inp" w+] ########################################################################### # use histdump for right now set input [open histdump$hst.inp w] puts $input "$expnam" puts $input "L" puts $input "$hst" puts $input "0" close $input # use hstdmp without an experiment name so that output # is not sent to the .LST file set input [open "| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r] # initalize arrays set num -1 set xlist {} set obslist {} set calclist {} set bcklist {} set xunits {} # define a list of reflection positions for each phase for {set i 1} {$i < 10} {incr i} { set reflns($i) {} } set i 0 while {[gets $input line] >= 0} { incr i # run update every 50th line if {$i > 50} {set i 0; update} if [scan $line %d num] { if {$num > 0} { set Ispec 0 set X -999 scan [string range $line 8 end] %e%e%e%e%e%e \ X Iobs Icalc Ispec fixB fitB #puts $line # eliminate excluded points if {$Ispec > 0.0 && $X >= 0} { lappend xlist $X lappend obslist $Iobs lappend calclist $Icalc lappend bcklist [expr $fixB + $fitB] } # add peaks to peak lists # puts "[string range $line 6 6]" # is this 6 or 7; 6 on win & 7 on SGI if [regexp {[1-9]} [string range $line 6 7] ph] { lappend reflns($ph) $X } } } else { regexp {Time|Theta|keV} $line xunits } } if {$xunits == "Theta"} {set xunits "2-Theta"} close $input catch {file delete histdump$hst.inp} xvec set $xlist obsvec set $obslist calcvec set $calclist bckvec set $bcklist diffvec set [obsvec - calcvec] global obsvec calcvec diffvec set maxdiff [set diffvec(max)] set cmin [set calcvec(min)] set omin [set obsvec(min)] set cmax [set calcvec(max)] set omax [set obsvec(max)] set expgui(min) [expr $omin < $cmin ? $omin : $cmin] set expgui(max) [expr $omax > $cmax ? $omax : $cmax] set ymin1 [expr $cmin - 1.1*$maxdiff] set ymin2 [expr $omin - 1.1*$maxdiff] if {$ymin1 < $ymin2} { diffvec set [diffvec + $ymin1] } { diffvec set [diffvec + $ymin2] } plotdata $box } proc readdata_tcl {box} { global expgui expnam reflns global lasthst graph global hst peakinfo xunits yunits $box config -title "(Histogram update in progress)" update # parse the output of a file set lasthst $hst # use tcldump set input [open histdump$hst.inp w] puts $input "$hst" # x units -- native puts $input "$graph(xunits)" # y units -- native puts $input "$graph(yunits)" # format (if implemented someday) puts $input "0" close $input # initalize arrays set X {} set OBS {} set CALC {} set BKG {} global refhkllist refphaselist refpos set refpos {} set refhkllist {} set refphaselist {} for {set i 1} {$i < 10} {incr i} { set reflns($i) {} } eval [exec $expgui(tcldump) $expnam < histdump$hst.inp] catch {file delete histdump$hst.inp} if {$X == ""} { $box config -title "(Error reading Histogram $hst)" foreach elem [$box element show] { eval $box element config $elem $graph(ElementHideOption) } return } foreach elem [$box element names] { eval $box element config $elem $graph(ElementShowOption) } xvec set $X obsvec set $OBS calcvec set $CALC bckvec set $BKG refposvec set $refpos diffvec set [obsvec - calcvec] if $graph(backsub) { obsvec set [obsvec - bckvec] calcvec set [calcvec - bckvec] } global obsvec calcvec diffvec set maxdiff [set diffvec(max)] set cmin [set calcvec(min)] set omin [set obsvec(min)] set cmax [set calcvec(max)] set omax [set obsvec(max)] set expgui(min) [expr $omin < $cmin ? $omin : $cmin] set expgui(max) [expr $omax > $cmax ? $omax : $cmax] set ymin1 [expr $cmin - 1.1*$maxdiff] set ymin2 [expr $omin - 1.1*$maxdiff] if {$ymin1 < $ymin2} { diffvec set [diffvec + $ymin1] } { diffvec set [diffvec + $ymin2] } plotdata $box } proc lblhkl {plot x} { global blt_version expgui tcl_platform tcl_version global refhkllist refphaselist peakinfo refpos # look for peaks within pixelregion pixels set xmin [$plot xaxis invtransform [expr $x - $expgui(pixelregion)]] set xmax [$plot xaxis invtransform [expr $x + $expgui(pixelregion)]] set peaknums [refposvec search $xmin $xmax] set peaklist {} set xcen 0 # select by displayed phases set lbls 0 if {$expgui(hklbox)} { catch { toplevel .hkl text .hkl.txt -width 30 -height 10 -wrap none \ -yscrollcommand ".hkl.yscroll set" scrollbar .hkl.yscroll -command ".hkl.txt yview" grid .hkl.txt -column 0 -row 1 -sticky nsew grid .hkl.yscroll -column 1 -row 1 -sticky ns grid columnconfigure .hkl 0 -weight 1 grid rowconfigure .hkl 1 -weight 1 wm title .hkl "Liveplot HKL Labels" wm iconname .hkl HKL .hkl.txt insert end "Phase\thkl\tPosition" } } foreach peak $peaknums { if {$expgui(hklbox)} { catch { .hkl.txt insert end "\n[lindex $refphaselist $peak]" .hkl.txt insert end "\t[lindex $refhkllist $peak]" .hkl.txt insert end "\t[lindex $refpos $peak]" .hkl.txt see end } } if [set peakinfo(flag[lindex $refphaselist $peak])] { set xcen [expr $xcen + [refposvec range $peak $peak]] lappend peaklist [lindex $refhkllist $peak] incr lbls } } if {$peaklist == ""} return set xcen [expr $xcen / $lbls] # avoid bug in BLT 2.3 where Inf does not work for text markers if {$blt_version == 2.3} { set ycen [lindex [$plot yaxis limits] 1] } else { set ycen Inf } if {$tcl_platform(platform) == "windows"} { # at least right now, text can't be rotated in windows regsub -all { } $peaklist "\n" peaklist set mark [$plot marker create text -coords "$xcen $ycen" \ -text $peaklist -anchor n -bg "" -name hkl$xcen] } else { set mark [$plot marker create text -coords "$xcen $ycen" \ -rotate 90 -text $peaklist -anchor n -bg "" -name hkl$xcen] } if {$tcl_version >= 8.0} { $plot marker config hkl$xcen -font lblfont } if {$expgui(fadetime) > 0} { catch { after [expr $expgui(fadetime) * 1000 ] \ "catch \{ $plot marker delete $mark \}" } } } proc delallhkllbl {plot} { catch { eval $plot marker delete [$plot marker names hkl*] } } proc plotdata {box} { global expnam hst peakinfo xunits yunits cycle reflns modtime global lasthst graph expgui # is there a new histogram to load? if {$hst != $lasthst} { xvec set {} xvec notify now set cycle -1 set modtime 0 $box config -title "Please wait: loading histogram $hst" update return } xvec notify now obsvec notify now calcvec notify now bckvec notify now diffvec notify now $box config -title "$expnam cycle $cycle Hist $hst" $box xaxis config -title $xunits $box yaxis config -title $yunits setlegend $box $graph(legend) # reconfigure the obs data $box element configure obs \ -symbol $peakinfo(obssym) \ -pixels [expr 0.125 * $peakinfo(obssize)]i # now deal with peaks for {set i 1} {$i < 10} {incr i} { if {$expgui(autotick)} { set div [expr ( $expgui(max) - $expgui(min) )/40.] set ymin [expr $expgui(min) - ($i+1) * $div] set ymax [expr $expgui(min) - $i * $div] } else { set ymin $peakinfo(min$i) set ymax $peakinfo(max$i) } set j 0 if [set peakinfo(flag$i)] { foreach X $reflns($i) { incr j catch { $box marker create line -name peaks${i}_$j } $box marker config peaks${i}_$j -under 1 \ -coords "$X $ymin $X $ymax" catch { $box marker config peaks${i}_$j \ $graph(MarkerColorOpt) [list $peakinfo(color$i)] if $peakinfo(dashes$i) { $box marker config peaks${i}_$j -dashes "5 5" } } } # $box element config phase$i -mapped 1 catch {$box element create phase$i} catch { $box element config phase$i -color $peakinfo(color$i) } } else { eval $box marker delete [$box marker names peaks${i}_*] eval $box element delete [$box element names phase$i] } } # force an update of the plot as BLT may not $box config -title [$box cget -title] update } proc setlegend {box legend} { global blt_version if {$blt_version >= 2.3 && $blt_version < 8.0} { if $legend { $box legend config -hide no } else { $box legend config -hide yes } } else { if $legend { $box legend config -mapped yes } else { $box legend config -mapped no } } } proc minioptionsbox {num} { global blt_version tcl_platform peakinfo expgui set bx .opt$num catch {destroy $bx} toplevel $bx wm iconname $bx "Phase $num options" wm title $bx "Phase $num options" set i $num pack [label $bx.0 -text "Phase $i reflns" ] -side top pack [checkbutton $bx.1 -text "Show reflections" \ -variable peakinfo(flag$i)] -side top # remove option that does not work if {$blt_version != 8.0 || $tcl_platform(platform) != "windows"} { pack [checkbutton $bx.2 -text "Use dashed line" \ -variable peakinfo(dashes$i)] -side top } if !$expgui(autotick) { pack [frame $bx.p$i -bd 2 -relief groove] -side top # pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \ # -variable peakinfo(flag$i)] -side left -anchor w pack [label $bx.p$i.1 -text " Y min:"] -side left pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \ -side left pack [label $bx.p$i.3 -text " Y max:"] -side left pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \ -side left } pack [frame $bx.c$i -bd 2 -relief groove] -side top pack [label $bx.c$i.5 -text " color:"] -side left pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \ -side left pack [button $bx.c$i.2 -bg $peakinfo(color$i) -state disabled] -side left pack [button $bx.c$i.1 -text "Color\nmenu" \ -command "setcolor $i"] -side left pack [frame $bx.b] -side top #pack [button $bx.b.1 -command {plotdata $box} -text "Update Plot"] \ # -side left pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right } proc setcolor {num} { global peakinfo set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"] if {$color == ""} return set peakinfo(color$num) $color } proc makepostscriptout {} { global graph box if !$graph(printout) { set out [open "| $graph(outcmd) >& liveplot.msg" w] catch { puts $out [$box postscript output -landscape 1 \ -decorations no -height 7.i -width 9.5i] close $out } msg catch { set out [open liveplot.msg r] if {$msg != ""} {append msg "\n"} append msg [read $out] close $out catch {file delete liveplot.msg} } if {$msg != ""} { tk_dialog .msg "file created" \ "Postscript file processed with command \ $graph(outcmd). Result: $msg" "" 0 OK } else { tk_dialog .msg "file created" \ "Postscript file processed with command \ $graph(outcmd)" "" 0 OK } } else { $box postscript output $graph(outname) -landscape 1 \ -decorations no -height 7.i -width 9.5i tk_dialog .msg "file created" \ "Postscript file $graph(outname) created" "" 0 OK } } proc setprintopt {page} { global graph if $graph(printout) { $page.4.1 config -fg black $page.4.2 config -fg black -state normal $page.6.1 config -fg #888 $page.6.2 config -fg #888 -state disabled } else { $page.4.1 config -fg #888 $page.4.2 config -fg #888 -state disabled $page.6.1 config -fg black $page.6.2 config -fg black -state normal } } proc setpostscriptout {} { global graph tcl_platform set box .out catch {destroy $box} toplevel $box focus $box pack [frame $box.4] -side top -anchor w -fill x pack [checkbutton $box.4.a -text "Write PostScript files" \ -variable graph(printout) -offvalue 0 -onvalue 1 \ -command "setprintopt $box"] -side left -anchor w pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w pack [frame $box.6] -side top -anchor w -fill x pack [checkbutton $box.6.a -text "Print PostScript files" \ -variable graph(printout) -offvalue 1 -onvalue 0 \ -command "setprintopt $box" ] -side left -anchor w pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w pack [button $box.a -text "Close" -command "destroy $box"] -side top if {$tcl_platform(platform) == "windows"} { set graph(printout) 1 $box.4.a config -state disabled $box.6.a config -fg #888 -state disabled } setprintopt $box } proc setlblopts {} { global expgui tcl_platform tcl_version set box .out catch {destroy $box} toplevel $box focus $box pack [frame $box.c] -side top -anchor w pack [label $box.c.l -text "HKL label\nerase time:"] -side left pack [entry $box.c.e -textvariable expgui(fadetime) -width 8] \ -side left pack [label $box.c.l1 -text seconds] -side left pack [frame $box.d] -side top -anchor w pack [label $box.d.l -text "HKL label size:"] -side left pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \ -side left pack [label $box.d.l1 -text pixels] -side left # old versions if tcl/tk don't support the font command if {$tcl_version < 8.0} { $box.d.l config -fg #888 $box.d.e config -fg #888 -state disabled $box.d.l1 config -fg #888 } pack [frame $box.f] -side top -anchor w pack [label $box.f.l -text "HKL search region:"] -side left pack [entry $box.f.e -textvariable expgui(pixelregion) -width 3] \ -side left pack [label $box.f.l1 -text pixels] -side left pack [frame $box.e] -side top -anchor w pack [checkbutton $box.e.b -text "Separate window for HKL labels"\ -variable expgui(hklbox)] -side left pack [button $box.a -text "Close" -command "destroy $box"] -side top } proc setsymopts {} { global expgui peakinfo set box .out catch {destroy $box} toplevel $box focus $box pack [frame $box.d] -side left -anchor n pack [label $box.d.t -text "Symbol type"] -side top set expgui(obssym) $peakinfo(obssym) set expgui(obssize) $peakinfo(obssize) foreach symbol {square circle diamond plus cross \ splus scross} \ symbol_name {square circle diamond plus cross \ thin-plus thin-cross} { pack [radiobutton $box.d.$symbol \ -text $symbol_name -variable expgui(obssym) \ -value $symbol] -side top -anchor w } pack [frame $box.e] -side left -anchor n -fill y pack [label $box.e.l -text "Symbol Size"] -side top pack [scale $box.e.s -variable expgui(obssize) \ -from .1 -to 3 -resolution 0.05] -side top pack [frame $box.a] -side bottom pack [button $box.a.1 -text "Apply" -command { \ if {$peakinfo(obssym) != $expgui(obssym)} {set peakinfo(obssym) $expgui(obssym)}; \ if {$peakinfo(obssize) != $expgui(obssize)} {set peakinfo(obssize) $expgui(obssize)} \ } ] -side left pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left } # save some of the global options in ~/.gsas_config proc SaveOptions {} { global graph expgui peakinfo set fp [open [file join ~ .gsas_config] a] puts $fp "set graph(legend) $graph(legend)" puts $fp "set graph(printout) $graph(printout)" puts $fp "set graph(outname) $graph(outname)" puts $fp "set graph(outcmd) $graph(outcmd)" puts $fp "set expgui(lblfontsize) $expgui(lblfontsize)" puts $fp "set expgui(fadetime) $expgui(fadetime)" puts $fp "set expgui(hklbox) $expgui(hklbox)" puts $fp "set peakinfo(obssym) $peakinfo(obssym)" puts $fp "set peakinfo(obssize) $peakinfo(obssize)" puts $fp "set expgui(pixelregion) $expgui(pixelregion)" puts $fp "set expgui(autotick) $expgui(autotick)" close $fp } proc aboutliveplot {} { global Revision tk_dialog .warn About " GSAS\n\ A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\ LIVEPLOT\nB. Toby, NIST\nNot subject to copyright\n\n\ $Revision\n\ " {} 0 OK } proc getcycle {} { global expnam set cycle -1 catch { set fp [open $expnam.EXP r] set text [read $fp] close $fp regexp {GNLS RUN.*Total cycles run *([0-9]*) } $text x cycle } return $cycle } proc updateifnew {} { global cycle modtime expnam if {[file mtime $expnam.EXP] != $modtime} { set modtime [file mtime $expnam.EXP] set newcycle [getcycle] if {$newcycle != $cycle} { set cycle $newcycle # delay one second # after 1000 readdata .g } } # check every second after 1000 updateifnew } proc plotdataupdate {array element action} { global box peakinfo reflns graph # parse the element regexp {([a-z]*)([0-9]*)} $element junk var num if {$var == "color"} { if {$peakinfo($element) == ""} return if [catch { .opt$num.c$num.2 config -bg $peakinfo($element) } ] return set i $num set j 0 if [set peakinfo(flag$i)] { catch { $box element config phase$i -color $peakinfo(color$i) } foreach X $reflns($i) { incr j catch { $box marker config peaks${i}_$j \ $graph(MarkerColorOpt) [list $peakinfo(color$i)] } } } return } waitmsg {Updating} plotdata $box donewait } # override options with locally defined values if [file exists [file join $expgui(scriptdir) localconfig]] { source [file join $expgui(scriptdir) localconfig] } if [file exists [file join ~ .gsas_config]] { source [file join ~ .gsas_config] } if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] { set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)] # puts "got tcldump" } else { set expgui(tcldump) {} # puts "no tcldump" } # vectors vector xvec xvec notify never vector obsvec obsvec notify never vector calcvec calcvec notify never vector bckvec bckvec notify never vector diffvec diffvec notify never vector refposvec refposvec notify never # create the graph set box [graph .g] Blt_ZoomStack $box $box element create obs -color black -linewidth 0 \ -symbol $peakinfo(obssym) \ -pixels [expr 0.125 * $peakinfo(obssize)]i $box element create calc -color red -symbol none $box element create diff -color blue -symbol none $box element config obs -xdata xvec -ydata obsvec $box element config calc -xdata xvec -ydata calcvec $box element config diff -xdata xvec -ydata diffvec if {$expgui(tcldump) != ""} { $box element create bckg -color green -symbol none $box element config bckg -xdata xvec -ydata bckvec bind $box "lblhkl %W %x" # bind $box "lblallhkl %W" bind $box "delallhkllbl %W" } $box yaxis config -title {} setlegend $box $graph(legend) updateifnew frame .a -bd 3 -relief groove pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left menu .a.file.menu .a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick menu .a.file.menu.tick foreach num {1 2 3 4 5 6 7 8 9} { .a.file.menu.tick add checkbutton -label "Phase $num" \ -variable peakinfo(flag$num) \ -command {plotdata $box} } .a.file.menu add cascade -label "Histogram" -menu .a.file.menu.hist menu .a.file.menu.hist for {set num 1} {$num < 99} {incr num 10} { .a.file.menu.hist add cascade -label "$num-[expr $num+9]" \ -menu .a.file.menu.hist.$num menu .a.file.menu.hist.$num for {set num1 $num} {$num1 < 10+$num} {incr num1} { .a.file.menu.hist.$num add radiobutton -label $num1 -value $num1 \ -variable hst \ -command {set cycle [getcycle];readdata .g} } } .a.file.menu add command -label "Update Plot" \ -command {set cycle [getcycle];readdata .g} .a.file.menu add command -label "Make PostScript" -command makepostscriptout .a.file.menu add command -label Quit -command "destroy ." pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \ -side left menu .a.options.menu .a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick menu .a.options.menu.tick .a.options.menu.tick add radiobutton -label "Manual Placement" \ -value 0 -variable expgui(autotick) -command "plotdata $box" .a.options.menu.tick add radiobutton -label "Auto locate" \ -value 1 -variable expgui(autotick) -command "plotdata $box" .a.options.menu.tick add separator foreach num {1 2 3 4 5 6 7 8 9} { .a.options.menu.tick add command -label "Phase $num" \ -command "minioptionsbox $num" } .a.options.menu add command -label "Obs symbol" -command setsymopts if {$expgui(tcldump) != ""} { .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits menu .a.options.menu.xunits .a.options.menu.xunits add radiobutton -label "As collected" \ -variable graph(xunits) -value 0 \ -command {set cycle [getcycle];readdata .g} .a.options.menu.xunits add radiobutton -label "d-space" \ -variable graph(xunits) -value 1 \ -command {set cycle [getcycle];readdata .g} .a.options.menu.xunits add radiobutton -label "Q" \ -variable graph(xunits) -value 2 \ -command {set cycle [getcycle];readdata .g} .a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits menu .a.options.menu.yunits .a.options.menu.yunits add radiobutton -label "As collected" \ -variable graph(yunits) -value 0 \ -command {set cycle [getcycle];readdata .g} .a.options.menu.yunits add radiobutton -label "Normalized" \ -variable graph(yunits) -value 1 \ -command {set cycle [getcycle];readdata .g} .a.options.menu add command -label "HKL labeling" -command setlblopts .a.options.menu add checkbutton -label "Subtract background" \ -variable graph(backsub) \ -command {set cycle [getcycle];readdata .g} } .a.options.menu add checkbutton -label "Include legend" \ -variable graph(legend) \ -command {setlegend $box $graph(legend)} .a.options.menu add command -label "Set PS output" -command setpostscriptout .a.options.menu add command -label "Save Options" -underline 1 \ -command "SaveOptions" pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right menu .a.help.menu -tearoff 0 .a.help.menu add command -command aboutliveplot -label About pack .a -side top -fill both pack $box -fill both -expand yes # add the extra options set fl [file join $expgui(scriptdir) icddcmd.tcl] if [file exists $fl] {source $fl} set fl [file join $expgui(scriptdir) cellgen.tcl] if [file exists $fl] {source $fl} donewait trace variable peakinfo w plotdataupdate