Changeset 73

Timestamp:

Dec 4, 2009 4:59:57 PM (14 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:

• trunk/liveplot (modified) (14 diffs, 3 props)

trunk/liveplot

@@ -1 +1 @@
 #!/usr/local/bin/wish
 set Revision {$Revision$ $Date$}
+
 bind all <Control-KeyPress-c> {destroy .}
 # process command line arguments
@@ -24 +25 @@
 if {$tcl_platform(platform) == "windows"} {
     set graph(printout) 1
+    set expgui(tcldump) tcldump.exe
 } else {
     set graph(printout) 0
+    set expgui(tcldump) tcldump
 }
 
@@ -31 +34 @@
 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
 
 if [catch {package require BLT} errmsg] {
@@ -105 +115 @@
         set link [file readlink $expgui(script)]
         if { [file  pathtype  $link] == "absolute" } {
-h           set expgui(script) $link
+            set expgui(script) $link
         } {
             set expgui(script) [file dirname $expgui(script)]/$link
@@ -122 +132 @@
 set expgui(gsasexe) [file join $expgui(gsasdir) exe]
 
-
-proc readdata {box} {
+proc readdata {box} { 
+    global expgui
+    if [catch {
+        #puts [time {
+            if {$expgui(tcldump) == ""} {
+                readdata_hst $box
+            } else {
+                readdata_tcl $box
+            }
+        #}]
+    } errmsg] {
+        if $expgui(debug) {error $errmsg}
+        $box config -title "Read error: $errmsg"
+        catch {console show}
+        puts "error message: $errmsg"
+        update
+    }
+}
+   
+proc readdata_hst {box} {
     global expgui expnam reflns
     global lasthst
-    global hst peakinfo units
+    global hst peakinfo xunits
     $box config -title "(Histogram update in progress)"
     update
     # parse the output of a file
-    if [catch {
         set lasthst $hst
 ###########################################################################
@@ -155 +182 @@
         set calclist {}
         set bcklist {}
-        set units {}
+        set xunits {}
         # define a list of reflection positions for each phase
         for {set i 1} {$i < 10} {incr i} {
             set reflns($i) {}
-            #   set flag$i 0
         }
         set i 0
@@ -188 +214 @@
                 } 
             } else {
-                regexp {Time|Theta|keV} $line units
+                regexp {Time|Theta|keV} $line xunits
             }
         }
-        if {$units == "Theta"} {set units "2-Theta"}
+        if {$xunits == "Theta"} {set xunits "2-Theta"}
         close $input
         catch {file delete histdump$hst.inp}
@@ -209 +235 @@
         }
         plotdata $box
-    } errmsg] {
-        $box config -title "Read error: $errmsg"
-        catch {console show}
-        puts "error message: $errmsg"
-        update
-    }   
+}
+
+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 {}
+    set refpos {}
+    global refhkllist refphaselist
+    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] {
+           $box element config $elem -hide 1
+        }
+        return
+    }
+    foreach elem [$box element names] {
+        $box element config $elem -hide 0
+    }
+    xvec set $X
+    obsvec set $OBS
+    calcvec set $CALC
+    bckvec set $BKG
+    refposvec set $refpos
+    diffvec set [obsvec - calcvec]
+    global obsvec calcvec diffvec 
+    set maxdiff  [set diffvec(max)]
+    set ymin1 [expr [set calcvec(min)] - 1.1*$maxdiff]
+    set ymin2 [expr [set obsvec(min)] - 1.1*$maxdiff]
+    if {$ymin1 < $ymin2} {
+        diffvec set [diffvec + $ymin1]
+    } {
+        diffvec set [diffvec + $ymin2]
+    }
+    plotdata $box
+}
+
+proc lblhkl {plot x} {
+    global cellparm command blt_version refhkllist refphaselist peakinfo
+    # look for peaks within pixelregion pixels
+    set pixelregion 5
+    set xmin [$plot xaxis invtransform [expr $x - $pixelregion]]
+    set xmax [$plot xaxis invtransform [expr $x + $pixelregion]]
+    set peaknums [refposvec search $xmin $xmax]
+    set peaklist {}
+    set xcen 0
+    # select by displayed phases
+    set lbls 0
+#    puts ""
+    foreach peak $peaknums {
+#       puts "hkl [lindex $refhkllist $peak] phase [lindex $refphaselist $peak]"
+        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
+    }
+    set mark [$plot marker create text -coords "$xcen $ycen" \
+            -rotate 90 -text $peaklist -anchor n -bg ""]
+    after 10000 "$plot marker delete $mark"
 }
 
 proc plotdata {box} {
-    global expnam hst peakinfo units cycle reflns modtime
+    global expnam hst peakinfo xunits yunits cycle reflns modtime
     global lasthst graph
 
@@ -237 +350 @@
     diffvec notify now
     $box config -title "$expnam cycle $cycle Hist $hst"
-    $box xaxis config -title $units
+    $box xaxis config -title $xunits
+    $box yaxis config -title $yunits
     setlegend $box $graph(legend)
     # now deal with peaks
@@ -474 +588 @@
 }
 
+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
@@ -485 +607 @@
 vector diffvec 
 diffvec notify never
+vector refposvec
+refposvec notify never
 # create the graph
 set box [graph .g]
@@ -490 +614 @@
 $box element create obs -color black -symbol scross -linewidth 0
 $box element create calc -color red  -symbol none  
-#$box element create bckg -color green  -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 bckg -xdata xvec -ydata bckvec
 $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 <Shift-Button-1> "lblhkl %W %x"
+}
 $box yaxis config -title {} 
 setlegend $box $graph(legend)
@@ -512 +639 @@
 .a.file.menu add cascade -label "Histogram" -menu .a.file.menu.hist
 menu .a.file.menu.hist
-foreach num {1 2 3 4 5 6 7 8 9} {
-    .a.file.menu.hist add radiobutton -label $num -value $num -variable hst \
-            -command {plotdata $box}
+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 cascade -label Tickmarks -menu .a.file.menu.tick
@@ -537 +670 @@
             -command "minioptionsbox $num"
 }
+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 checkbutton -label "Include legend" \
         -variable graph(legend) \