source: trunk/gui/scripts/energyLevels.tcl @ 13

Last change on this file since 13 was 13, checked in by mmc, 16 years ago

Many improvements, including a new energy level viewer
for Huckel-IV. Added support for a new <boolean> type.
Fixed the cloud/field stuff so that when a cloud is 1D,
it reverts to BLT vectors so it will plot correctly.
Fixed the install script to work better on Windows.

File size: 30.2 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: EnergyLevels - visualizer for discrete energy levels
3#
4#  This widget is a simple visualizer for a set of quantized energy
5#  levels, as you might find for a molecule or a quantum well.  It
6#  takes the Rappture XML representation for a <table> and extracts
7#  values from the "energy" column, then plots those energies on a
8#  graph.
9# ======================================================================
10#  AUTHOR:  Michael McLennan, Purdue University
11#  Copyright (c) 2004-2005
12#  Purdue Research Foundation, West Lafayette, IN
13# ======================================================================
14package require Itk
15package require BLT
16
17option add *EnergyLevels.width 4i widgetDefault
18option add *EnergyLevels.height 4i widgetDefault
19option add *EnergyLevels.padding 4 widgetDefault
20option add *EnergyLevels.controlBackground gray widgetDefault
21option add *EnergyLevels.shadeColor gray widgetDefault
22option add *EnergyLevels.levelColor black widgetDefault
23option add *EnergyLevels.levelTextForeground black widgetDefault
24option add *EnergyLevels.levelTextBackground white widgetDefault
25
26option add *EnergyLevels.font \
27    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
28
29blt::bitmap define EnergyLevels-reset {
30#define reset_width 12
31#define reset_height 12
32static unsigned char reset_bits[] = {
33   0x00, 0x00, 0x00, 0x00, 0xfc, 0x03, 0x04, 0x02, 0x04, 0x02, 0x04, 0x02,
34   0x04, 0x02, 0x04, 0x02, 0x04, 0x02, 0xfc, 0x03, 0x00, 0x00, 0x00, 0x00};
35}
36
37blt::bitmap define EnergyLevels-zoomin {
38#define zoomin_width 12
39#define zoomin_height 12
40static unsigned char zoomin_bits[] = {
41   0x7c, 0x00, 0x82, 0x00, 0x11, 0x01, 0x11, 0x01, 0x7d, 0x01, 0x11, 0x01,
42   0x11, 0x01, 0x82, 0x03, 0xfc, 0x07, 0x80, 0x0f, 0x00, 0x0f, 0x00, 0x06};
43}
44
45blt::bitmap define EnergyLevels-zoomout {
46#define zoomout_width 12
47#define zoomout_height 12
48static unsigned char zoomout_bits[] = {
49   0x7c, 0x00, 0x82, 0x00, 0x01, 0x01, 0x01, 0x01, 0x7d, 0x01, 0x01, 0x01,
50   0x01, 0x01, 0x82, 0x03, 0xfc, 0x07, 0x80, 0x0f, 0x00, 0x0f, 0x00, 0x06};
51}
52
53blt::bitmap define EnergyLevels-rdiag {
54#define rdiag_width 8
55#define rdiag_height 8
56static unsigned char rdiag_bits[] = {
57   0x66, 0x33, 0x99, 0xcc, 0x66, 0x33, 0x99, 0xcc};
58}
59
60
61itcl::class Rappture::EnergyLevels {
62    inherit itk::Widget
63
64    itk_option define -padding padding Padding 0
65    itk_option define -shadecolor shadeColor ShadeColor ""
66    itk_option define -levelcolor levelColor LevelColor ""
67    itk_option define -leveltextforeground levelTextForeground Foreground ""
68    itk_option define -leveltextbackground levelTextBackground Background ""
69
70    constructor {args} { # defined below }
71
72    public proc columns {table}
73
74    public method add {table {settings ""}}
75    public method delete {args}
76    public method scale {args}
77
78    protected method _redraw {{what all}}
79    protected method _zoom {option args}
80    protected method _view {midE delE}
81    protected method _hilite {option args}
82    protected method _getLayout {}
83
84    private variable _dispatcher "" ;# dispatcher for !events
85
86    private variable _dlist ""     ;# list of data objects
87    private variable _dobj2color   ;# maps data obj => color option
88    private variable _dobj2raise   ;# maps data obj => raise option
89    private variable _dobj2cols    ;# maps data obj => column names
90    private variable _emin ""      ;# autoscale min for energy
91    private variable _emax ""      ;# autoscale max for energy
92    private variable _eviewmin ""  ;# min for "zoom" view
93    private variable _eviewmax ""  ;# max for "zoom" view
94    private variable _edefmin ""   ;# min for default "zoom" view
95    private variable _edefmax ""   ;# max for default "zoom" view
96    private variable _ehomo ""     ;# energy of HOMO level in topmost dataset
97    private variable _elumo ""     ;# energy of LUMO level in topmost dataset
98    private variable _hilite ""    ;# item currently highlighted
99}
100
101itk::usual EnergyLevels {
102    keep -background -foreground -cursor -font
103}
104
105# ----------------------------------------------------------------------
106# CONSTRUCTOR
107# ----------------------------------------------------------------------
108itcl::body Rappture::EnergyLevels::constructor {args} {
109    Rappture::dispatcher _dispatcher
110    $_dispatcher register !redraw
111    $_dispatcher dispatch $this !redraw "[itcl::code $this _redraw all]; list"
112    $_dispatcher register !zoom
113    $_dispatcher dispatch $this !zoom "[itcl::code $this _redraw zoom]; list"
114
115    itk_option add hull.width hull.height
116    pack propagate $itk_component(hull) no
117
118    itk_component add controls {
119        frame $itk_interior.cntls
120    } {
121        usual
122        rename -background -controlbackground controlBackground Background
123    }
124    pack $itk_component(controls) -side right -fill y
125
126    itk_component add reset {
127        button $itk_component(controls).reset \
128            -borderwidth 1 -padx 1 -pady 1 \
129            -bitmap EnergyLevels-reset \
130            -command [itcl::code $this _zoom reset]
131    } {
132        usual
133        ignore -borderwidth
134        rename -highlightbackground -controlbackground controlBackground Background }
135    pack $itk_component(reset) -padx 4 -pady 4
136    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
137
138    itk_component add zoomin {
139        button $itk_component(controls).zin \
140            -borderwidth 1 -padx 1 -pady 1 \
141            -bitmap EnergyLevels-zoomin \
142            -command [itcl::code $this _zoom in]
143    } {
144        usual
145        ignore -borderwidth
146        rename -highlightbackground -controlbackground controlBackground Background
147    }
148    pack $itk_component(zoomin) -padx 4 -pady 4
149    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
150
151    itk_component add zoomout {
152        button $itk_component(controls).zout \
153            -borderwidth 1 -padx 1 -pady 1 \
154            -bitmap EnergyLevels-zoomout \
155            -command [itcl::code $this _zoom out]
156    } {
157        usual
158        ignore -borderwidth
159        rename -highlightbackground -controlbackground controlBackground Background
160    }
161    pack $itk_component(zoomout) -padx 4 -pady 4
162    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
163
164    #
165    # Add label for the title.
166    #
167    itk_component add title {
168        label $itk_interior.title
169    }
170    pack $itk_component(title) -side top
171
172    #
173    # Add graph showing levels
174    #
175    itk_component add graph {
176        canvas $itk_interior.graph -highlightthickness 0
177    } {
178        usual
179        ignore -highlightthickness
180    }
181    pack $itk_component(graph) -expand yes -fill both
182
183    bind $itk_component(graph) <Configure> \
184        [list $_dispatcher event -idle !redraw]
185
186    bind $itk_component(graph) <ButtonPress-1> \
187        [itcl::code $this _zoom at %x %y]
188    bind $itk_component(graph) <B1-Motion> \
189        [itcl::code $this _zoom at %x %y]
190
191    bind $itk_component(graph) <Motion> \
192        [itcl::code $this _hilite brush %x %y]
193    bind $itk_component(graph) <Leave> \
194        [itcl::code $this _hilite hide]
195
196    bind $itk_component(graph) <KeyPress-Up> \
197        [itcl::code $this _zoom nudge 1]
198    bind $itk_component(graph) <KeyPress-Right> \
199        [itcl::code $this _zoom nudge 1]
200    bind $itk_component(graph) <KeyPress-plus> \
201        [itcl::code $this _zoom nudge 1]
202
203    bind $itk_component(graph) <KeyPress-Down> \
204        [itcl::code $this _zoom nudge -1]
205    bind $itk_component(graph) <KeyPress-Left> \
206        [itcl::code $this _zoom nudge -1]
207    bind $itk_component(graph) <KeyPress-minus> \
208        [itcl::code $this _zoom nudge -1]
209
210    eval itk_initialize $args
211}
212
213# ----------------------------------------------------------------------
214# USAGE: columns <table>
215#
216# Clients use this to scan a <table> XML object and see if it contains
217# columns for energy levels.  If so, it returns a list of two column
218# names: {labels energies}.
219# ----------------------------------------------------------------------
220itcl::body Rappture::EnergyLevels::columns {dataobj} {
221    set names [$dataobj columns -component]
222    set epos [lsearch -exact $names column(levels)]
223    if {$epos >= 0} {
224        set units [$dataobj columns -units $epos]
225        if {![string match energy* [Rappture::Units::description $units]]} {
226            set epos -1
227        }
228    }
229
230    # can't find column named "levels"? then look for column with energies
231    if {$epos < 0} {
232        set index 0
233        foreach units [$dataobj columns -units] {
234            if {[string match energy* [Rappture::Units::description $units]]} {
235                if {$epos >= 0} {
236                    # more than one energy column -- bail out
237                    set epos -1
238                    break
239                }
240                set epos $index
241            }
242            incr index
243        }
244    }
245
246    # look for a column with labels
247    set lpos -1
248    set index 0
249    foreach units [$dataobj columns -units] {
250        if {"" == $units} {
251            set vals [$dataobj values -column $index]
252            if {[regexp {(^|[[:space:]])HOMO([[:space:]]|$)} $vals]} {
253                if {$lpos >= 0} {
254                    # more than one labels column -- bail out
255                    set lpos -1
256                    break
257                }
258                set lpos $index
259            }
260        }
261        incr index
262    }
263
264    if {$epos >= 0 || $lpos >= 0} {
265        return [list [lindex $names $lpos] [lindex $names $epos]]
266    }
267    return ""
268}
269
270# ----------------------------------------------------------------------
271# USAGE: add <dataobj> ?<settings>?
272#
273# Clients use this to add a data object to the plot.  The optional
274# <settings> are used to configure the plot.  Allowed settings are
275# -color, -brightness, -width, -linestyle and -raise.
276# ----------------------------------------------------------------------
277itcl::body Rappture::EnergyLevels::add {dataobj {settings ""}} {
278    #
279    # Make sure this table contains energy levels.
280    #
281    set cols [Rappture::EnergyLevels::columns $dataobj]
282    if {"" == $cols} {
283        error "table \"$dataobj\" does not contain energy levels"
284    }
285
286    #
287    # Scan through the settings and resolve all values.
288    #
289    array set params {
290        -color black
291        -brightness 0
292        -width 1
293        -raise 0
294        -linestyle solid
295    }
296    foreach {opt val} $settings {
297        if {![info exists params($opt)]} {
298            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
299        }
300        set params($opt) $val
301    }
302
303    # convert -linestyle to BLT -dashes
304    switch -- $params(-linestyle) {
305        dashed { set params(-linestyle) {4 4} }
306        dotted { set params(-linestyle) {2 4} }
307        default { set params(-linestyle) {} }
308    }
309
310    # if -brightness is set, then update the color
311    if {$params(-brightness) != 0} {
312        set params(-color) [Rappture::color::brightness \
313            $params(-color) $params(-brightness)]
314    }
315
316    set pos [lsearch -exact $dataobj $_dlist]
317    if {$pos < 0} {
318        lappend _dlist $dataobj
319        set _dobj2color($dataobj) $params(-color)
320        set _dobj2raise($dataobj) $params(-raise)
321
322        foreach {lcol ecol} $cols break
323        set _dobj2cols($dataobj-label) $lcol
324        set _dobj2cols($dataobj-energy) $ecol
325
326        $_dispatcher event -idle !redraw
327    }
328}
329
330# ----------------------------------------------------------------------
331# USAGE: delete ?<dataobj1> <dataobj2> ...?
332#
333# Clients use this to delete a dataobj from the plot.  If no dataobjs
334# are specified, then all dataobjs are deleted.
335# ----------------------------------------------------------------------
336itcl::body Rappture::EnergyLevels::delete {args} {
337    if {[llength $args] == 0} {
338        set args $_dlist
339        set _eviewmin ""
340        set _eviewmax ""
341    }
342
343    # delete all specified data objs
344    set changed 0
345    foreach dataobj $args {
346        set pos [lsearch -exact $_dlist $dataobj]
347        if {$pos >= 0} {
348            set _dlist [lreplace $_dlist $pos $pos]
349            catch {unset _dobj2color($dataobj)}
350            catch {unset _dobj2raise($dataobj)}
351            catch {unset _dobj2cols($dataobj-label)}
352            catch {unset _dobj2cols($dataobj-energy)}
353            set changed 1
354        }
355    }
356
357    # if anything changed, then rebuild the plot
358    if {$changed} {
359        $_dispatcher event -idle !redraw
360    }
361}
362
363# ----------------------------------------------------------------------
364# USAGE: scale ?<dataobj1> <dataobj2> ...?
365#
366# Sets the default limits for the overall plot according to the
367# limits of the data for all of the given <dataobj> objects.  This
368# accounts for all dataobjs--even those not showing on the screen.
369# Because of this, the limits are appropriate for all data as
370# the user scans through data in the ResultSet viewer.
371# ----------------------------------------------------------------------
372itcl::body Rappture::EnergyLevels::scale {args} {
373    set _emin ""
374    set _emax ""
375    foreach obj $args {
376        if {![info exists _dobj2cols($obj-energy)]} {
377            # don't recognize this object? then ignore it
378            continue
379        }
380        foreach {min max} [$obj limits $_dobj2cols($obj-energy)] break
381
382        if {"" != $min && "" != $max} {
383            if {"" == $_emin} {
384                set _emin $min
385                set _emax $max
386            } else {
387                if {$min < $_emin} { set _emin $min }
388                if {$max > $_emax} { set _emax $max }
389            }
390        }
391    }
392}
393
394# ----------------------------------------------------------------------
395# USAGE: _redraw
396#
397# Used internally to load a list of energy levels from a <table> within
398# the data objects.
399# ----------------------------------------------------------------------
400itcl::body Rappture::EnergyLevels::_redraw {{what all}} {
401    # scale data now, if we haven't already
402    if {"" == $_emin || "" == $_emax} {
403        eval scale $_dlist
404    }
405
406    # put the dataobj list in order according to -raise options
407    set dlist $_dlist
408    foreach obj $dlist {
409        if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
410            set i [lsearch -exact $dlist $obj]
411            if {$i >= 0} {
412                set dlist [lreplace $dlist $i $i]
413                lappend dlist $obj
414            }
415        }
416    }
417    set topdobj [lindex $dlist end]
418
419    _getLayout
420
421    #
422    # Redraw the overall layout
423    #
424    if {$what == "all"} {
425        $c delete all
426        if {[llength $dlist] == 0} {
427            return
428        }
429
430        #
431        # Scan through all data objects and plot them in order from
432        # the bottom up.
433        #
434        set e2y [expr {($y1-$y0)/($_emax-$_emin)}]
435
436        set title ""
437        set dataobj ""
438        foreach dataobj $dlist {
439            if {"" == $title} {
440                set title [$dataobj hints label]
441            }
442
443            set ecol $_dobj2cols($dataobj-energy)
444            set color $_dobj2color($dataobj)
445            if {"" == $color} {
446                set color $itk_option(-levelcolor)
447            }
448            set color [Rappture::color::brightness $color 0.7]
449
450            foreach eval [$dataobj values -column $ecol] {
451                set y [expr {($eval-$_emin)*$e2y + $y0}]
452                $c create line $xx0 $y $xx1 $y -fill $color -width 1
453            }
454        }
455
456        #
457        # Scan through the data and look for HOMO/LUMO levels.
458        # Set the default view to the energy just above and
459        # just below the HOMO/LUMO levels.
460        #
461        set _edefmin [expr {0.4*($_emax-$_emin) + $_emin}]
462        set _edefmax [expr {0.6*($_emax-$_emin) + $_emin}]
463
464        set nlumo -1
465        set nhomo -1
466
467        set dataobj [lindex $dlist end]
468        if {"" != $dataobj} {
469            set lcol $_dobj2cols($dataobj-label)
470            set ecol $_dobj2cols($dataobj-energy)
471            set units [$dataobj columns -units $ecol]
472
473            set n 0
474            foreach eval [$dataobj values -column $ecol] \
475                    lval [$dataobj values -column $lcol] {
476
477                if {$lval == "HOMO"} {
478                    set nhomo $n
479                    set nlumo [expr {$n+1}]
480                } elseif {$lval == "LUMO"} {
481                    set nlumo $n
482                }
483                incr n
484            }
485
486            if {$nhomo >= 0 && $nlumo >= 0} {
487                set elist [$dataobj values -column $ecol]
488                set _ehomo [lindex $elist $nhomo]
489                set _elumo [lindex $elist $nlumo]
490                set gap [expr {$_elumo - $_ehomo}]
491                set _edefmin [expr {$_ehomo - 0.3*$gap}]
492                set _edefmax [expr {$_elumo + 0.3*$gap}]
493
494                set y [expr {($_ehomo-$_emin)*$e2y + $y0}]
495                set id [$c create rectangle $xx0 $y $xx1 $y0 \
496                    -stipple EnergyLevels-rdiag \
497                    -outline "" -fill $itk_option(-shadecolor)]
498                $c lower $id
499            }
500        }
501        if {"" == $_eviewmin || "" == $_eviewmax} {
502            set _eviewmin $_edefmin
503            set _eviewmax $_edefmax
504        }
505
506        if {"" != $title} {
507            pack $itk_component(title) -side top -before $c
508            $itk_component(title) configure -text $title
509        } else {
510            pack forget $itk_component(title)
511        }
512
513        # draw the lines for the "zoom" view (fixed up below)
514        set color $itk_option(-foreground)
515        $c create line $x0 $y0 $x1 $y0 -fill $color -tags zmin
516        $c create line $x0 $y0 $x1 $y0 -fill $color -tags zmax
517
518        $c create line $x1 $y0 $x2 $y0 -fill $color -tags zoomup
519        $c create line $x1 $y0 $x2 $y1 -fill $color -tags zoomdn
520
521        $c create line $x2 $y0 $x3 $y0 -fill $color
522        $c create line $x2 $y1 $x3 $y1 -fill $color
523    }
524
525    #
526    # Redraw the "zoom" area on the right side
527    #
528    if {$what == "zoom" || $what == "all"} {
529        set e2y [expr {($y1-$y0)/($_emax-$_emin)}]
530
531        set y [expr {($_eviewmin-$_emin)*$e2y + $y0}]
532        $c coords zmin $x0 $y $x1 $y
533        $c coords zoomup $x1 $y $x2 $y0
534
535        set y [expr {($_eviewmax-$_emin)*$e2y + $y0}]
536        $c coords zmax $x0 $y $x1 $y
537        $c coords zoomdn $x1 $y $x2 $y1
538
539        # redraw all levels in the current view
540        $c delete zlevels zlabels
541
542        set e2y [expr {($y1-$y0)/($_eviewmax-$_eviewmin)}]
543        foreach dataobj $dlist {
544            set ecol $_dobj2cols($dataobj-energy)
545            set color $_dobj2color($dataobj)
546            if {"" == $color} {
547                set color $itk_option(-levelcolor)
548            }
549
550            set n 0
551            foreach eval [$dataobj values -column $ecol] {
552                if {$eval >= $_eviewmin && $eval <= $_eviewmax} {
553                    set y [expr {($eval-$_eviewmin)*$e2y + $y0}]
554                    set id [$c create line $xx2 $y $xx3 $y \
555                        -fill $color -width 1 \
556                        -tags [list zlevels $dataobj-$n]]
557                }
558                incr n
559            }
560        }
561
562        if {"" != $_ehomo && "" != $_elumo} {
563            set ecol $_dobj2cols($topdobj-energy)
564            set units [$topdobj columns -units $ecol]
565
566            set yy0 [expr {($_ehomo-$_eviewmin)*$e2y + $y0}]
567            set yy1 [expr {($_elumo-$_eviewmin)*$e2y + $y0}]
568            $c create line [expr {$x3-10}] $yy0 [expr {$x3-10}] $yy1 \
569                -arrow both -fill $itk_option(-foreground) \
570                -tags zlabels
571            $c create text [expr {$x3-15}] [expr {0.5*($yy0+$yy1)}] \
572                -anchor e -text "Eg = [expr {$_elumo-$_ehomo}] $units" \
573                -tags zlabels
574
575            # label the HOMO level
576            set tid [$c create text [expr {0.5*($x2+$x3)}] $yy0 -anchor c \
577                -text "HOMO = $_ehomo $units" \
578                -fill $itk_option(-leveltextforeground) \
579                -tags zlabels]
580
581            foreach {xb0 yb0 xb1 yb1} [$c bbox $tid] break
582            set tid2 [$c create rectangle \
583                [expr {$xb0-1}] [expr {$yb0-1}] \
584                [expr {$xb1+1}] [expr {$yb1+1}] \
585                -outline $itk_option(-leveltextforeground) \
586                -fill $itk_option(-leveltextbackground) \
587                -tags zlabels]
588            $c lower $tid2 $tid
589
590            # label the LUMO level
591            set tid [$c create text [expr {0.5*($x2+$x3)}] $yy1 -anchor c \
592                -text "LUMO = $_elumo $units" \
593                -fill $itk_option(-leveltextforeground) \
594                -tags zlabels]
595
596            foreach {xb0 yb0 xb1 yb1} [$c bbox $tid] break
597            set tid2 [$c create rectangle \
598                [expr {$xb0-1}] [expr {$yb0-1}] \
599                [expr {$xb1+1}] [expr {$yb1+1}] \
600                -outline $itk_option(-leveltextforeground) \
601                -fill $itk_option(-leveltextbackground) \
602                -tags zlabels]
603            $c lower $tid2 $tid
604
605            set id [$c create rectangle $xx2 $yy0 $xx3 $y0 \
606                -stipple EnergyLevels-rdiag \
607                -outline "" -fill $itk_option(-shadecolor) \
608                -tags zlabels]
609            $c lower $id
610        }
611    }
612}
613
614# ----------------------------------------------------------------------
615# USAGE: _zoom in
616# USAGE: _zoom out
617# USAGE: _zoom reset
618# USAGE: _zoom at <x> <y>
619# USAGE: _zoom nudge <dir>
620#
621# Called automatically when the user clicks on one of the zoom
622# controls for this widget.  Changes the zoom for the current view.
623# ----------------------------------------------------------------------
624itcl::body Rappture::EnergyLevels::_zoom {option args} {
625    switch -- $option {
626        in {
627            set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
628            set delE [expr {0.8*($_eviewmax - $_eviewmin)}]
629            _view $midE $delE
630        }
631        out {
632            set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
633            set delE [expr {1.25*($_eviewmax - $_eviewmin)}]
634            _view $midE $delE
635        }
636        reset {
637            set _eviewmin $_edefmin
638            set _eviewmax $_edefmax
639            $_dispatcher event -idle !zoom
640        }
641        at {
642            if {[llength $args] != 2} {
643                error "wrong # args: should be \"_zoom at x y\""
644            }
645            set x [lindex $args 0]
646            set y [lindex $args 1]
647
648            _getLayout
649            set y2e [expr {($_emax-$_emin)/($y1-$y0)}]
650
651            if {$x > $x1} {
652                return
653            }
654            set midE [expr {($y-$y0)*$y2e + $_emin}]
655            set delE [expr {$_eviewmax - $_eviewmin}]
656            _view $midE $delE
657        }
658        nudge {
659            if {[llength $args] != 1} {
660                error "wrong # args: should be \"_zoom nudge dir\""
661            }
662            set dir [lindex $args 0]
663
664            set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
665            set delE [expr {$_eviewmax - $_eviewmin}]
666            set midE [expr {$midE + $dir*0.25*$delE}]
667            _view $midE $delE
668        }
669    }
670    focus $itk_component(graph)
671}
672
673# ----------------------------------------------------------------------
674# USAGE: _view <midE> <delE>
675#
676# Called automatically when the user clicks/drags on the left side
677# of the widget where energy levels are displayed.  Sets the zoom
678# view so that it's centered on the <y> coordinate.
679# ----------------------------------------------------------------------
680itcl::body Rappture::EnergyLevels::_view {midE delE} {
681    if {$delE > $_emax-$_emin} {
682        set delE [expr {$_emax - $_emin}]
683    }
684    if {$midE - 0.5*$delE < $_emin} {
685        set _eviewmin $_emin
686        set _eviewmax [expr {$_eviewmin+$delE}]
687    } elseif {$midE + 0.5*$delE > $_emax} {
688        set _eviewmax $_emax
689        set _eviewmin [expr {$_eviewmax-$delE}]
690    } else {
691        set _eviewmin [expr {$midE - 0.5*$delE}]
692        set _eviewmax [expr {$midE + 0.5*$delE}]
693    }
694    $_dispatcher event -idle !zoom
695}
696
697# ----------------------------------------------------------------------
698# USAGE: _hilite brush <x> <y>
699# USAGE: _hilite show <dataobj> <level>
700# USAGE: _hilite hide
701#
702# Used internally to highlight energy levels in the zoom view and
703# show their associated energy.  The "brush" operation is called
704# as the mouse moves in the zoom view, to see if the <x>,<y>
705# coordinate is touching a level.  The show/hide operations are
706# then used to show/hide level info.
707# ----------------------------------------------------------------------
708itcl::body Rappture::EnergyLevels::_hilite {option args} {
709    switch -- $option {
710        brush {
711            if {[llength $args] != 2} {
712                error "wrong # args: should be \"_hilite brush x y\""
713            }
714            set x [lindex $args 0]
715            set y [lindex $args 1]
716
717            _getLayout
718            if {$x < $x2 || $x > $x3} {
719                return   ;# pointer must be in "zoom" area
720            }
721
722            set c $itk_component(graph)
723            set id [$c find withtag current]
724
725            # touching a line? then find the level and show its info
726            if {"" != $id} {
727                set e2y [expr {($y1-$y0)/($_eviewmax-$_eviewmin)}]
728
729                # put the dataobj list in order according to -raise options
730                set dlist $_dlist
731                foreach obj $dlist {
732                    if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
733                        set i [lsearch -exact $dlist $obj]
734                        if {$i >= 0} {
735                            set dlist [lreplace $dlist $i $i]
736                            lappend dlist $obj
737                        }
738                    }
739                }
740
741                set found 0
742                foreach dataobj $dlist {
743                    set ecol $_dobj2cols($dataobj-energy)
744                    set n 0
745                    foreach eval [$dataobj values -column $ecol] {
746                        set ylevel [expr {($eval-$_eviewmin)*$e2y + $y0}]
747                        if {$y >= $ylevel-3 && $y <= $ylevel+3} {
748                            set found 1
749                            break
750                        }
751                        incr n
752                    }
753                    if {$found} break
754                }
755                if {$found} {
756                    _hilite show $dataobj $n
757                } else {
758                    _hilite hide
759                }
760            } else {
761                _hilite hide
762            }
763        }
764        show {
765            if {[llength $args] != 2} {
766                error "wrong # args: should be \"_hilite show dataobj level\""
767            }
768            set dataobj [lindex $args 0]
769            set level [lindex $args 1]
770
771            if {$_hilite == "$dataobj $level"} {
772                return
773            }
774            _hilite hide
775
776            set lcol $_dobj2cols($dataobj-label)
777            set lval [lindex [$dataobj values -column $lcol] $level]
778            set ecol $_dobj2cols($dataobj-energy)
779            set eval [lindex [$dataobj values -column $ecol] $level]
780            set units [$dataobj columns -units $ecol]
781
782            if {$eval == $_ehomo || $eval == $_elumo} {
783                # don't pop up info for the HOMO/LUMO levels
784                return
785            }
786
787            _getLayout
788            set e2y [expr {($y1-$y0)/($_eviewmax-$_eviewmin)}]
789            set y [expr {($eval-$_eviewmin)*$e2y + $y0}]
790
791            set tid [$c create text [expr {0.5*($x2+$x3)}] $y -anchor c \
792                -text "$lval = $eval $units" \
793                -fill $itk_option(-leveltextforeground) \
794                -tags hilite]
795
796            foreach {x0 y0 x1 y1} [$c bbox $tid] break
797            set tid2 [$c create rectangle \
798                [expr {$x0-1}] [expr {$y0-1}] \
799                [expr {$x1+1}] [expr {$y1+1}] \
800                -outline $itk_option(-leveltextforeground) \
801                -fill $itk_option(-leveltextbackground) \
802                -tags hilite]
803            $c lower $tid2 $tid
804
805            $c itemconfigure $dataobj-$level -width 2
806            set _hilite "$dataobj $level"
807        }
808        hide {
809            if {"" != $_hilite} {
810                $itk_component(graph) delete hilite
811                $itk_component(graph) itemconfigure zlevels -width 1
812                set _hilite ""
813            }
814        }
815        default {
816            error "bad option \"$option\": should be brush, show, hide"
817        }
818    }
819}
820
821# ----------------------------------------------------------------------
822# USAGE: _getLayout
823#
824# Used internally to compute a series of variables used when redrawing
825# the widget.  Creates the variables with the proper values in the
826# calling context.
827# ----------------------------------------------------------------------
828itcl::body Rappture::EnergyLevels::_getLayout {} {
829    upvar c c
830    set c $itk_component(graph)
831
832    upvar w w
833    set w [winfo width $c]
834
835    upvar h h
836    set h [winfo height $c]
837
838    #
839    # Measure the size of a typical label and use that to size
840    # the left/right portions.  If the label is too big, leave
841    # at least a little room for the labels.
842    #
843    set size [font measure $itk_option(-font) "HOMO = X.XXXXXXe-XX eV"]
844    set size [expr {$size + 6*$itk_option(-padding)}]
845
846    if {$size > $w-20} {
847        set size [expr {$w-20}]
848    } elseif {$size < 0.66*$w} {
849        set size [expr {0.66*$w}]
850    }
851    set xm [expr {$w - $size}]
852
853    upvar x0 x0
854    set x0 $itk_option(-padding)
855
856    upvar x1 x1
857    set x1 [expr {$xm - $itk_option(-padding)}]
858
859    upvar x2 x2
860    set x2 [expr {$xm + $itk_option(-padding)}]
861
862    upvar x3 x3
863    set x3 [expr {$w - $itk_option(-padding)}]
864
865
866    upvar xx0 xx0
867    set xx0 [expr {$x0 + $itk_option(-padding)}]
868
869    upvar xx1 xx1
870    set xx1 [expr {$x1 - $itk_option(-padding)}]
871
872    upvar xx2 xx2
873    set xx2 [expr {$x2 + $itk_option(-padding)}]
874
875    upvar xx3 xx3
876    set xx3 [expr {$x3 - $itk_option(-padding)}]
877
878
879    upvar y0 y0
880    set y0 [expr {$h - $itk_option(-padding)}]
881
882    upvar y1 y1
883    set y1 $itk_option(-padding)
884}
885
886# ----------------------------------------------------------------------
887# OPTION: -levelColor
888# ----------------------------------------------------------------------
889itcl::configbody Rappture::EnergyLevels::levelcolor {
890    $_dispatcher event -idle !redraw
891}
892
893# ----------------------------------------------------------------------
894# OPTION: -leveltextforeground
895# ----------------------------------------------------------------------
896itcl::configbody Rappture::EnergyLevels::leveltextforeground {
897    $_dispatcher event -idle !redraw
898}
899
900# ----------------------------------------------------------------------
901# OPTION: -leveltextbackground
902# ----------------------------------------------------------------------
903itcl::configbody Rappture::EnergyLevels::leveltextbackground {
904    $_dispatcher event -idle !redraw
905}
Note: See TracBrowser for help on using the repository browser.