Changeset 76

Timestamp:

Dec 4, 2009 5:00:00 PM (14 years ago)

Author:

toby

Message:

# on 1999/04/06 21:13:49, toby did:
Add peak label dialog; delete label option
add obs symbol dialog
remove update plot on tick mark config
hkl listbox
add color example to peak configure
save more options

File:

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

trunk/liveplot

@@ -1 +1 @@
 #!/usr/local/bin/wish
+# $RCSfile: liveplot,v $
 set Revision {$Revision$ $Date$}
 
@@ -41 +42 @@
 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 peakinfo(obssym) scross
+set peakinfo(obssize) 1.0
 
 if [catch {package require BLT} errmsg] {
@@ -140 +146 @@
 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} { 
@@ -275 +296 @@
     set CALC {}
     set BKG {}
+    global refhkllist refphaselist refpos
     set refpos {}
-    global refhkllist refphaselist
     set refhkllist {}
     set refphaselist {}
@@ -313 +334 @@
 
 proc lblhkl {plot x} {
-    global cellparm command blt_version refhkllist refphaselist peakinfo
+    global blt_version expgui tcl_platform tcl_version
+    global refhkllist refphaselist peakinfo refpos
     # look for peaks within pixelregion pixels
     set pixelregion 5
@@ -323 +345 @@
     # select by displayed phases
     set lbls 0
-#    puts ""
+    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 {
-#       puts "hkl [lindex $refhkllist $peak] phase [lindex $refphaselist $peak]"
+        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]]
@@ -340 +383 @@
         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"
+    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*]
+    }
 }
 
@@ -368 +432 @@
     $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
-    set j 0
     for {set i 1} {$i < 10} {incr i} {
+        set j 0
         if [set peakinfo(flag$i)] {
             foreach X $reflns($i) {
@@ -420 +488 @@
 
 proc minioptionsbox {num} {
+    global blt_version tcl_platform peakinfo
     set bx .opt$num
     catch {destroy $bx}
@@ -427 +496 @@
 
     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 
+    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 
-        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.1 -text "Color menu" \
-                -command "setcolor $i"] -side left
-
+    }
+    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.1 -command {plotdata $box} -text "Update Plot"] \
+            #    -side left
     pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right
 }
@@ -461 +533 @@
     set peakinfo(color$num) $color
 }
+
 proc makepostscriptout {} {
     global graph box
@@ -537 +610 @@
 }
 
+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 8] \
+            -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.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 {set peakinfo(obssym) $expgui(obssym); \
+            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
+    global graph expgui
     set fp [open [file join ~ .gsas_config] a]
     puts $fp "set graph(legend) $graph(legend)"
@@ -545 +675 @@
     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)"
+
     close $fp
 }
@@ -583 +719 @@
     }
     # check every second
-#    after 10000 updateifnew 
     after 1000 updateifnew 
 }
@@ -627 +762 @@
 set box [graph .g]
 Blt_ZoomStack $box
-$box element create obs -color black -symbol scross -linewidth 0
+$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  
@@ -637 +774 @@
     $box element config bckg -xdata xvec -ydata bckvec
     bind $box <Shift-Button-1> "lblhkl %W %x"
+#    bind $box <Shift-Double-Button-1> "lblallhkl %W"
+    bind $box <Shift-Button-3> "delallhkllbl %W"
 }
 $box yaxis config -title {} 
@@ -685 +824 @@
             -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
@@ -705 +845 @@
             -variable graph(yunits) -value 1 \
             -command {set cycle [getcycle];readdata .g}
+    .a.options.menu add command -label "HKL labeling" -command setlblopts
 }
     
@@ -721 +862 @@
 pack $box -fill both -expand yes
 donewait
+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"} {
+        catch {
+            .opt$num.c$num.2 config -bg $peakinfo($element)
+        }
+        set i $num
+        set j 0
+        if [set peakinfo(flag$i)] {
+            catch {
+                $box element config phase$i -color $peakinfo(color$i) 
+            } errmsg
+            foreach X $reflns($i) {
+                incr j
+                catch {
+                    $box marker config peaks${i}_$j \
+                            $graph(MarkerColorOpt) $peakinfo(color$i)
+                }
+            }
+        }
+        return
+    }
+    waitmsg {Updating}
+    plotdata $box
+    donewait
+}
+trace variable peakinfo w plotdataupdate