Context Navigation

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

Last change on this file since 413 was 413, checked in by mmc, 18 years ago

Added <description> capability to output objects, including axes.

Fixed the ResultSet? so that it is more compact and supports the simulation number as a parameter. This is useful when there are datasets with wildly varying parameters.

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: