Changeset 76


Ignore:
Timestamp:
Dec 4, 2009 5:00:00 PM (11 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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/liveplot

    • Property rcs:date changed from 1999/04/05 18:14:24 to 1999/04/06 21:13:49
    • Property rcs:lines changed from +22 -7 to +203 -33
    • Property rcs:rev changed from 1.6 to 1.7
    r75 r76  
    11#!/usr/local/bin/wish
     2# $RCSfile: liveplot,v $
    23set Revision {$Revision$ $Date$}
    34
     
    4142catch {if $env(DEBUG) {set expgui(debug) 1}}
    4243#set expgui(debug) 1
     44set expgui(lblfontsize) 15
     45set expgui(fadetime) 10
     46set expgui(hklbox) 1
     47set peakinfo(obssym) scross
     48set peakinfo(obssize) 1.0
    4349
    4450if [catch {package require BLT} errmsg] {
     
    140146set expgui(gsasdir) [file dirname $expgui(scriptdir)]
    141147set expgui(gsasexe) [file join $expgui(gsasdir) exe]
     148
     149# called by a trace on expgui(lblfontsize)
     150proc setfontsize {a b c} {
     151    global expgui graph
     152    catch {
     153        font config lblfont -size [expr -$expgui(lblfontsize)]
     154        # this forces a redraw of the plot by changing the title to itself
     155        .g configure -title [.g cget -title]
     156    }
     157}
     158# define a font used for labels
     159if {$tcl_version >= 8.0} {
     160    font create lblfont -family Helvetica -size [expr -$expgui(lblfontsize)]
     161    trace variable expgui(lblfontsize) w setfontsize
     162}
    142163
    143164proc readdata {box} {
     
    275296    set CALC {}
    276297    set BKG {}
     298    global refhkllist refphaselist refpos
    277299    set refpos {}
    278     global refhkllist refphaselist
    279300    set refhkllist {}
    280301    set refphaselist {}
     
    313334
    314335proc lblhkl {plot x} {
    315     global cellparm command blt_version refhkllist refphaselist peakinfo
     336    global blt_version expgui tcl_platform tcl_version
     337    global refhkllist refphaselist peakinfo refpos
    316338    # look for peaks within pixelregion pixels
    317339    set pixelregion 5
     
    323345    # select by displayed phases
    324346    set lbls 0
    325 #    puts ""
     347    if {$expgui(hklbox)} {
     348        catch {
     349            toplevel .hkl
     350            text .hkl.txt -width 30 -height 10 -wrap none \
     351                    -yscrollcommand ".hkl.yscroll set"
     352            scrollbar .hkl.yscroll -command ".hkl.txt yview"
     353            grid .hkl.txt -column 0 -row 1 -sticky nsew
     354            grid .hkl.yscroll -column 1 -row 1 -sticky ns
     355            grid columnconfigure .hkl 0 -weight 1
     356            grid rowconfigure .hkl 1 -weight 1
     357            wm title .hkl "Liveplot HKL Labels"
     358            wm iconname .hkl HKL
     359            .hkl.txt insert end "Phase\thkl\tPosition"
     360        }
     361    }
    326362    foreach peak $peaknums {
    327 #       puts "hkl [lindex $refhkllist $peak] phase [lindex $refphaselist $peak]"
     363        if {$expgui(hklbox)} {
     364            catch {
     365                .hkl.txt insert end "\n[lindex $refphaselist $peak]"
     366                .hkl.txt insert end "\t[lindex $refhkllist $peak]"
     367                .hkl.txt insert end "\t[lindex $refpos $peak]"
     368                .hkl.txt see end
     369            }
     370        }
    328371        if [set peakinfo(flag[lindex $refphaselist $peak])] {
    329372            set xcen [expr $xcen + [refposvec range $peak $peak]]
     
    340383        set ycen Inf
    341384    }
    342     set mark [$plot marker create text -coords "$xcen $ycen" \
    343             -rotate 90 -text $peaklist -anchor n -bg ""]
    344     after 10000 "$plot marker delete $mark"
     385    if {$tcl_platform(platform) == "windows"} {
     386        # at least right now, text can't be rotated in windows
     387        regsub -all { } $peaklist "\n" peaklist
     388        set mark [$plot marker create text -coords "$xcen $ycen" \
     389        -text $peaklist -anchor n -bg "" -name hkl$xcen]
     390    } else {
     391        set mark [$plot marker create text -coords "$xcen $ycen" \
     392        -rotate 90 -text $peaklist -anchor n -bg "" -name hkl$xcen]
     393    }
     394    if {$tcl_version >= 8.0} {
     395        $plot marker config hkl$xcen -font lblfont
     396    }
     397    if {$expgui(fadetime) > 0} {
     398        catch {
     399            after [expr $expgui(fadetime) * 1000 ] \
     400            "catch \{ $plot marker delete $mark \}"
     401        }
     402    }
     403}
     404
     405proc delallhkllbl {plot} {
     406    catch {
     407        eval $plot marker delete [$plot marker names hkl*]
     408    }
    345409}
    346410
     
    368432    $box yaxis config -title $yunits
    369433    setlegend $box $graph(legend)
     434    # reconfigure the obs data
     435    $box element configure obs \
     436            -symbol $peakinfo(obssym) \
     437            -pixels [expr 0.125 * $peakinfo(obssize)]i
    370438    # now deal with peaks
    371     set j 0
    372439    for {set i 1} {$i < 10} {incr i} {
     440        set j 0
    373441        if [set peakinfo(flag$i)] {
    374442            foreach X $reflns($i) {
     
    420488
    421489proc minioptionsbox {num} {
     490    global blt_version tcl_platform peakinfo
    422491    set bx .opt$num
    423492    catch {destroy $bx}
     
    427496
    428497    set i $num
    429         pack [label $bx.0 -text "Phase $i reflns" ] -side top
    430         pack [checkbutton $bx.1 -text "Show reflections" \
    431                 -variable peakinfo(flag$i)] -side top
     498    pack [label $bx.0 -text "Phase $i reflns" ] -side top
     499    pack [checkbutton $bx.1 -text "Show reflections" \
     500            -variable peakinfo(flag$i)] -side top
     501    # remove option that does not work
     502    if {$blt_version != 8.0 || $tcl_platform(platform) != "windows"} {
    432503        pack [checkbutton $bx.2 -text "Use dashed line" \
    433504                -variable peakinfo(dashes$i)] -side top
    434         pack [frame $bx.p$i -bd 2 -relief groove] -side top
    435 #       pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
    436 #               -variable peakinfo(flag$i)] -side left -anchor w
    437         pack [label $bx.p$i.1 -text "  Y min:"] -side left
    438         pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
    439                 -side left
    440         pack [label $bx.p$i.3 -text "  Y max:"] -side left
    441         pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
    442                 -side left
    443         pack [frame $bx.c$i -bd 2 -relief groove] -side top
    444 
    445         pack [label $bx.c$i.5 -text " color:"] -side left
    446         pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
    447                 -side left
    448         pack [button $bx.c$i.1 -text "Color menu" \
    449                 -command "setcolor $i"] -side left
    450 
     505    }
     506    pack [frame $bx.p$i -bd 2 -relief groove] -side top
     507    #   pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
     508            #           -variable peakinfo(flag$i)] -side left -anchor w
     509    pack [label $bx.p$i.1 -text "  Y min:"] -side left
     510    pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
     511            -side left
     512    pack [label $bx.p$i.3 -text "  Y max:"] -side left
     513    pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
     514            -side left
     515    pack [frame $bx.c$i -bd 2 -relief groove] -side top
     516   
     517    pack [label $bx.c$i.5 -text " color:"] -side left
     518    pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
     519            -side left
     520    pack [button $bx.c$i.2 -bg $peakinfo(color$i) -state disabled] -side left
     521    pack [button $bx.c$i.1 -text "Color\nmenu" \
     522            -command "setcolor $i"] -side left
    451523    pack [frame $bx.b] -side top
    452     pack [button $bx.b.1 -command {plotdata $box} -text "Update Plot"] \
    453             -side left
     524    #pack [button $bx.b.1 -command {plotdata $box} -text "Update Plot"] \
     525            #    -side left
    454526    pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right
    455527}
     
    461533    set peakinfo(color$num) $color
    462534}
     535
    463536proc makepostscriptout {} {
    464537    global graph box
     
    537610}
    538611
     612proc setlblopts {} {
     613    global expgui tcl_platform tcl_version
     614    set box .out
     615    catch {destroy $box}
     616    toplevel $box
     617    focus $box
     618    pack [frame $box.c] -side top  -anchor w
     619    pack [label $box.c.l -text "HKL label\nerase time:"] -side left
     620    pack [entry $box.c.e -textvariable expgui(fadetime) -width 8] \
     621            -side left
     622    pack [label $box.c.l1 -text seconds] -side left
     623    pack [frame $box.d] -side top  -anchor w
     624    pack [label $box.d.l -text "HKL label size:"] -side left
     625    pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 8] \
     626            -side left
     627    pack [label $box.d.l1 -text pixels] -side left
     628    # old versions if tcl/tk don't support the font command
     629    if {$tcl_version < 8.0} {
     630        $box.d.l config -fg #888
     631        $box.d.e config -fg #888 -state disabled
     632        $box.d.l1 config -fg #888
     633    }
     634    pack [frame $box.e] -side top  -anchor w
     635    pack [checkbutton $box.e.b -text "Separate window for HKL labels"\
     636            -variable expgui(hklbox)] -side left
     637    pack [button $box.a -text "Close" -command "destroy $box"] -side top
     638}
     639
     640proc setsymopts {} {
     641    global expgui peakinfo
     642    set box .out
     643    catch {destroy $box}
     644    toplevel $box
     645    focus $box
     646    pack [frame $box.d] -side left -anchor n
     647    pack [label $box.d.t -text "Symbol type"] -side top
     648    set expgui(obssym) $peakinfo(obssym)
     649    set expgui(obssize) $peakinfo(obssize)
     650    foreach symbol {square circle diamond plus cross \
     651            splus scross} \
     652            symbol_name {square circle diamond plus cross \
     653            thin-plus thin-cross} {
     654        pack [radiobutton $box.d.$symbol \
     655                -text $symbol_name -variable expgui(obssym) \
     656                -value $symbol] -side top -anchor w
     657    }
     658    pack [frame $box.e] -side left -anchor n -fill y
     659    pack [label $box.e.l -text "Symbol Size"] -side top
     660    pack [scale $box.e.s -variable expgui(obssize) \
     661            -from .1 -to 3 -resolution 0.05] -side top
     662    pack [frame $box.a] -side bottom
     663    pack [button $box.a.1 -text "Apply" \
     664            -command {set peakinfo(obssym) $expgui(obssym); \
     665            set peakinfo(obssize) $expgui(obssize)} ] -side left
     666    pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
     667}
     668
    539669# save some of the global options in ~/.gsas_config
    540670proc SaveOptions {} {
    541     global graph
     671    global graph expgui
    542672    set fp [open [file join ~ .gsas_config] a]
    543673    puts $fp "set graph(legend) $graph(legend)"
     
    545675    puts $fp "set graph(outname) $graph(outname)"
    546676    puts $fp "set graph(outcmd) $graph(outcmd)"
     677    puts $fp "set expgui(lblfontsize) $expgui(lblfontsize)"
     678    puts $fp "set expgui(fadetime) $expgui(fadetime)"
     679    puts $fp "set expgui(hklbox) $expgui(hklbox)"
     680    puts $fp "set peakinfo(obssym) $peakinfo(obssym)"
     681    puts $fp "set peakinfo(obssize) $peakinfo(obssize)"
     682
    547683    close $fp
    548684}
     
    583719    }
    584720    # check every second
    585 #    after 10000 updateifnew
    586721    after 1000 updateifnew
    587722}
     
    627762set box [graph .g]
    628763Blt_ZoomStack $box
    629 $box element create obs -color black -symbol scross -linewidth 0
     764$box element create obs -color black -linewidth 0 \
     765        -symbol $peakinfo(obssym) \
     766        -pixels [expr 0.125 * $peakinfo(obssize)]i
    630767$box element create calc -color red  -symbol none 
    631768$box element create diff -color blue  -symbol none 
     
    637774    $box element config bckg -xdata xvec -ydata bckvec
    638775    bind $box <Shift-Button-1> "lblhkl %W %x"
     776#    bind $box <Shift-Double-Button-1> "lblallhkl %W"
     777    bind $box <Shift-Button-3> "delallhkllbl %W"
    639778}
    640779$box yaxis config -title {}
     
    685824            -command "minioptionsbox $num"
    686825}
     826.a.options.menu add command -label "Obs symbol" -command setsymopts
    687827if {$expgui(tcldump) != ""} {
    688828    .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
     
    705845            -variable graph(yunits) -value 1 \
    706846            -command {set cycle [getcycle];readdata .g}
     847    .a.options.menu add command -label "HKL labeling" -command setlblopts
    707848}
    708849   
     
    721862pack $box -fill both -expand yes
    722863donewait
     864proc plotdataupdate {array element action} {
     865    global box peakinfo reflns graph
     866    # parse the element
     867    regexp {([a-z]*)([0-9]*)} $element junk var num
     868    if {$var == "color"} {
     869        catch {
     870            .opt$num.c$num.2 config -bg $peakinfo($element)
     871        }
     872        set i $num
     873        set j 0
     874        if [set peakinfo(flag$i)] {
     875            catch {
     876                $box element config phase$i -color $peakinfo(color$i)
     877            } errmsg
     878            foreach X $reflns($i) {
     879                incr j
     880                catch {
     881                    $box marker config peaks${i}_$j \
     882                            $graph(MarkerColorOpt) $peakinfo(color$i)
     883                }
     884            }
     885        }
     886        return
     887    }
     888    waitmsg {Updating}
     889    plotdata $box
     890    donewait
     891}
     892trace variable peakinfo w plotdataupdate
Note: See TracChangeset for help on using the changeset viewer.