Context Navigation

energyLevels.tcl @ 465

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

Fixed the bug report dialog so that Control-1-1-3-3 will bring up details
about the error message, so you can see the stack trace.

Fixed the nanovisviewer so that the cut planes stay in the right place
when you change volumes.

Fixed an error in the download mechanism for the energy levels viewer.
It was complaining about the new -description parameter.

File size: 30.7 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	-description ""
265	}
266	foreach {opt val} $settings {
267	if {![info exists params($opt)]} {
268	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
269	}
270	set params($opt) $val
271	}
272
273	# convert -linestyle to BLT -dashes
274	switch -- $params(-linestyle) {
275	dashed { set params(-linestyle) {4 4} }
276	dotted { set params(-linestyle) {2 4} }
277	default { set params(-linestyle) {} }
278	}
279
280	# if -brightness is set, then update the color
281	if {$params(-brightness) != 0} {
282	set params(-color) [Rappture::color::brightness \
283	$params(-color) $params(-brightness)]
284	}
285	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
286	# can't handle -autocolors yet
287	set params(-color) blue
288	}
289
290	set pos [lsearch -exact $dataobj $_dlist]
291	if {$pos < 0} {
292	lappend _dlist $dataobj
293	set _dobj2color($dataobj) $params(-color)
294	set _dobj2raise($dataobj) $params(-raise)
295
296	foreach {lcol ecol} $cols break
297	set _dobj2cols($dataobj-label) $lcol
298	set _dobj2cols($dataobj-energy) $ecol
299
300	$_dispatcher event -idle !redraw
301	}
302	}
303
304	# ----------------------------------------------------------------------
305	# USAGE: delete ?<dataobj1> <dataobj2> ...?
306	#
307	# Clients use this to delete a dataobj from the plot. If no dataobjs
308	# are specified, then all dataobjs are deleted.
309	# ----------------------------------------------------------------------
310	itcl::body Rappture::EnergyLevels::delete {args} {
311	if {[llength $args] == 0} {
312	set args $_dlist
313	}
314
315	# delete all specified data objs
316	set changed 0
317	foreach dataobj $args {
318	set pos [lsearch -exact $_dlist $dataobj]
319	if {$pos >= 0} {
320	set _dlist [lreplace $_dlist $pos $pos]
321	catch {unset _dobj2color($dataobj)}
322	catch {unset _dobj2raise($dataobj)}
323	catch {unset _dobj2cols($dataobj-label)}
324	catch {unset _dobj2cols($dataobj-energy)}
325	set changed 1
326	}
327	}
328
329	# if anything changed, then rebuild the plot
330	if {$changed} {
331	$_dispatcher event -idle !redraw
332	}
333	}
334
335	# ----------------------------------------------------------------------
336	# USAGE: scale ?<dataobj1> <dataobj2> ...?
337	#
338	# Sets the default limits for the overall plot according to the
339	# limits of the data for all of the given <dataobj> objects. This
340	# accounts for all dataobjs--even those not showing on the screen.
341	# Because of this, the limits are appropriate for all data as
342	# the user scans through data in the ResultSet viewer.
343	# ----------------------------------------------------------------------
344	itcl::body Rappture::EnergyLevels::scale {args} {
345	set _emin ""
346	set _emax ""
347	foreach obj $args {
348	if {![info exists _dobj2cols($obj-energy)]} {
349	# don't recognize this object? then ignore it
350	continue
351	}
352	foreach {min max} [$obj limits $_dobj2cols($obj-energy)] break
353
354	if {"" != $min && "" != $max} {
355	if {"" == $_emin} {
356	set _emin $min
357	set _emax $max
358	} else {
359	if {$min < $_emin} { set _emin $min }
360	if {$max > $_emax} { set _emax $max }
361	}
362	}
363	}
364	set _eviewmin "" ;# reset zoom view
365	set _eviewmax ""
366	}
367
368	# ----------------------------------------------------------------------
369	# USAGE: _redraw
370	#
371	# Used internally to load a list of energy levels from a <table> within
372	# the data objects.
373	# ----------------------------------------------------------------------
374	itcl::body Rappture::EnergyLevels::_redraw {{what all}} {
375	# scale data now, if we haven't already
376	if {"" == $_emin \|\| "" == $_emax} {
377	eval scale $_dlist
378	}
379
380	# put the dataobj list in order according to -raise options
381	set dlist $_dlist
382	foreach obj $dlist {
383	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
384	set i [lsearch -exact $dlist $obj]
385	if {$i >= 0} {
386	set dlist [lreplace $dlist $i $i]
387	lappend dlist $obj
388	}
389	}
390	}
391	set topdobj [lindex $dlist end]
392
393	_getLayout
394
395	#
396	# Redraw the overall layout
397	#
398	if {$what == "all"} {
399	$c delete all
400	if {[llength $dlist] == 0} {
401	return
402	}
403
404	#
405	# Scan through all data objects and plot them in order from
406	# the bottom up.
407	#
408	set e2y [expr {($yzoom1-$yzoom0)/($_emax-$_emin)}]
409
410	set title ""
411	set dataobj ""
412	foreach dataobj $dlist {
413	if {"" == $title} {
414	set title [$dataobj hints label]
415	}
416
417	set ecol $_dobj2cols($dataobj-energy)
418	set color $_dobj2color($dataobj)
419	if {"" == $color} {
420	set color $itk_option(-levelcolor)
421	}
422	set color [Rappture::color::brightness $color 0.7]
423
424	foreach eval [$dataobj values -column $ecol] {
425	set y [expr {($eval-$_emin)*$e2y + $yzoom0}]
426	$c create line $xx0 $y $xx1 $y -fill $color -width 1
427	}
428	}
429
430	#
431	# Scan through the data and look for HOMO/LUMO levels.
432	# Set the default view to the energy just above and
433	# just below the HOMO/LUMO levels.
434	#
435	set _edefmin [expr {0.4*($_emax-$_emin) + $_emin}]
436	set _edefmax [expr {0.6*($_emax-$_emin) + $_emin}]
437
438	set nlumo -1
439	set nhomo -1
440
441	set dataobj [lindex $dlist end]
442	if {"" != $dataobj} {
443	set lcol $_dobj2cols($dataobj-label)
444	set ecol $_dobj2cols($dataobj-energy)
445	set units [$dataobj columns -units $ecol]
446
447	set n 0
448	foreach eval [$dataobj values -column $ecol] \
449	lval [$dataobj values -column $lcol] {
450
451	if {[string equal -nocase $lval "HOMO"]} {
452	set nhomo $n
453	set _lhomo $lval
454	set nlumo [expr {$n+1}]
455	set _llumo "LUMO"
456	} elseif {[string equal -nocase $lval "Ground State"]} {
457	set nhomo $n
458	set _lhomo $lval
459	set nlumo [expr {$n+1}]
460	set _llumo "1st Excited State"
461	} elseif {[string equal -nocase $lval "LUMO"]
462	\|\| [string equal -nocase $lval "1st Excited State"]} {
463	set nlumo $n
464	set _llumo $lval
465	}
466	incr n
467	}
468
469	if {$nhomo >= 0 && $nlumo >= 0} {
470	set elist [$dataobj values -column $ecol]
471	set _ehomo [lindex $elist $nhomo]
472	set _elumo [lindex $elist $nlumo]
473	set gap [expr {$_elumo - $_ehomo}]
474	set _edefmin [expr {$_ehomo - 0.3*$gap}]
475	set _edefmax [expr {$_elumo + 0.3*$gap}]
476
477	set y [expr {($_ehomo-$_emin)*$e2y + $yzoom0}]
478	set id [$c create rectangle $xx0 $y $xx1 $y0 \
479	-stipple [Rappture::icon rdiag] \
480	-outline "" -fill $itk_option(-shadecolor)]
481	$c lower $id
482	}
483	}
484	if {"" == $_eviewmin \|\| "" == $_eviewmax} {
485	set _eviewmin $_edefmin
486	set _eviewmax $_edefmax
487	}
488
489	if {"" != $title} {
490	pack $itk_component(title) -side top -before $c
491	$itk_component(title) configure -text $title
492	} else {
493	pack forget $itk_component(title)
494	}
495
496	# draw the lines for the "zoom" view (fixed up below)
497	set color $itk_option(-foreground)
498	$c create line $x0 $yzoom0 $x1 $yzoom0 -fill $color -tags zmin
499	$c create line $x0 $yzoom0 $x1 $yzoom0 -fill $color -tags zmax
500
501	$c create line $x1 $yzoom0 $x2 $yzoom0 -fill $color -tags zoomup
502	$c create line $x1 $yzoom0 $x2 $yzoom1 -fill $color -tags zoomdn
503
504	$c create line $x2 $yzoom0 $x3 $yzoom0 -fill $color
505	$c create line $x2 $yzoom1 $x3 $yzoom1 -fill $color
506	}
507
508	#
509	# Redraw the "zoom" area on the right side
510	#
511	if {$what == "zoom" \|\| $what == "all"} {
512	set e2y [expr {($yzoom1-$yzoom0)/($_emax-$_emin)}]
513
514	set y [expr {($_eviewmin-$_emin)*$e2y + $yzoom0}]
515	$c coords zmin $x0 $y $x1 $y
516	$c coords zoomup $x1 $y $x2 $yzoom0
517
518	set y [expr {($_eviewmax-$_emin)*$e2y + $yzoom0}]
519	$c coords zmax $x0 $y $x1 $y
520	$c coords zoomdn $x1 $y $x2 $yzoom1
521
522	# redraw all levels in the current view
523	$c delete zlevels zlabels
524
525	set e2y [expr {($yzoom1-$yzoom0)/($_eviewmax-$_eviewmin)}]
526	foreach dataobj $dlist {
527	set ecol $_dobj2cols($dataobj-energy)
528	set color $_dobj2color($dataobj)
529	if {"" == $color} {
530	set color $itk_option(-levelcolor)
531	}
532
533	set n 0
534	foreach eval [$dataobj values -column $ecol] {
535	set y [expr {($eval-$_eviewmin)*$e2y + $yzoom0}]
536	if {$y >= $y1 && $y <= $y0} {
537	set id [$c create line $xx2 $y $xx3 $y \
538	-fill $color -width 1 \
539	-tags [list zlevels $dataobj-$n]]
540	}
541	incr n
542	}
543	}
544
545	if {"" != $_ehomo && "" != $_elumo} {
546	set ecol $_dobj2cols($topdobj-energy)
547	set units [$topdobj columns -units $ecol]
548
549	set yy0 [expr {($_ehomo-$_eviewmin)*$e2y + $yzoom0}]
550	set yy1 [expr {($_elumo-$_eviewmin)*$e2y + $yzoom0}]
551
552	set textht [font metrics $itk_option(-font) -linespace]
553	if {$yy0-$yy1 >= 1.5*$textht} {
554	$c create line [expr {$x3-10}] $yy0 [expr {$x3-10}] $yy1 \
555	-arrow both -fill $itk_option(-foreground) \
556	-tags zlabels
557	$c create text [expr {$x3-15}] [expr {0.5*($yy0+$yy1)}] \
558	-anchor e -text "Eg = [expr {$_elumo-$_ehomo}] $units" \
559	-tags zlabels
560
561	# label the HOMO level
562	set tid [$c create text [expr {0.5*($x2+$x3)}] $yy0 -anchor c \
563	-text "$_lhomo = $_ehomo $units" \
564	-fill $itk_option(-leveltextforeground) \
565	-tags zlabels]
566
567	foreach {xb0 yb0 xb1 yb1} [$c bbox $tid] break
568	set tid2 [$c create rectangle \
569	[expr {$xb0-1}] [expr {$yb0-1}] \
570	[expr {$xb1+1}] [expr {$yb1+1}] \
571	-outline $itk_option(-leveltextforeground) \
572	-fill $itk_option(-leveltextbackground) \
573	-tags zlabels]
574	$c lower $tid2 $tid
575
576	# label the LUMO level
577	set tid [$c create text [expr {0.5*($x2+$x3)}] $yy1 -anchor c \
578	-text "$_llumo = $_elumo $units" \
579	-fill $itk_option(-leveltextforeground) \
580	-tags zlabels]
581
582	foreach {xb0 yb0 xb1 yb1} [$c bbox $tid] break
583	set tid2 [$c create rectangle \
584	[expr {$xb0-1}] [expr {$yb0-1}] \
585	[expr {$xb1+1}] [expr {$yb1+1}] \
586	-outline $itk_option(-leveltextforeground) \
587	-fill $itk_option(-leveltextbackground) \
588	-tags zlabels]
589	$c lower $tid2 $tid
590	}
591
592	if {$yy0 < $y0} {
593	set id [$c create rectangle $xx2 $yy0 $xx3 $y0 \
594	-stipple [Rappture::icon rdiag] \
595	-outline "" -fill $itk_option(-shadecolor) \
596	-tags zlabels]
597	$c lower $id
598	}
599	}
600	}
601	}
602
603	# ----------------------------------------------------------------------
604	# USAGE: _zoom in
605	# USAGE: _zoom out
606	# USAGE: _zoom reset
607	# USAGE: _zoom at <x> <y>
608	# USAGE: _zoom nudge <dir>
609	#
610	# Called automatically when the user clicks on one of the zoom
611	# controls for this widget. Changes the zoom for the current view.
612	# ----------------------------------------------------------------------
613	itcl::body Rappture::EnergyLevels::_zoom {option args} {
614	switch -- $option {
615	in {
616	set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
617	set delE [expr {0.8*($_eviewmax - $_eviewmin)}]
618	_view $midE $delE
619	}
620	out {
621	set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
622	set delE [expr {1.25*($_eviewmax - $_eviewmin)}]
623	_view $midE $delE
624	}
625	reset {
626	set _eviewmin $_edefmin
627	set _eviewmax $_edefmax
628	$_dispatcher event -idle !zoom
629	}
630	at {
631	if {[llength $args] != 2} {
632	error "wrong # args: should be \"_zoom at x y\""
633	}
634	set x [lindex $args 0]
635	set y [lindex $args 1]
636
637	_getLayout
638	set y2e [expr {($_emax-$_emin)/($yzoom1-$yzoom0)}]
639
640	if {$x > $x1} {
641	return
642	}
643	set midE [expr {($y-$yzoom0)*$y2e + $_emin}]
644	set delE [expr {$_eviewmax - $_eviewmin}]
645	_view $midE $delE
646	}
647	nudge {
648	if {[llength $args] != 1} {
649	error "wrong # args: should be \"_zoom nudge dir\""
650	}
651	set dir [lindex $args 0]
652
653	set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
654	set delE [expr {$_eviewmax - $_eviewmin}]
655	set midE [expr {$midE + $dir0.25$delE}]
656	_view $midE $delE
657	}
658	}
659	focus $itk_component(graph)
660	}
661
662	# ----------------------------------------------------------------------
663	# USAGE: _view <midE> <delE>
664	#
665	# Called automatically when the user clicks/drags on the left side
666	# of the widget where energy levels are displayed. Sets the zoom
667	# view so that it's centered on the <y> coordinate.
668	# ----------------------------------------------------------------------
669	itcl::body Rappture::EnergyLevels::_view {midE delE} {
670	if {$delE > $_emax-$_emin} {
671	set delE [expr {$_emax - $_emin}]
672	}
673	if {$midE - 0.5*$delE < $_emin} {
674	set _eviewmin $_emin
675	set _eviewmax [expr {$_eviewmin+$delE}]
676	} elseif {$midE + 0.5*$delE > $_emax} {
677	set _eviewmax $_emax
678	set _eviewmin [expr {$_eviewmax-$delE}]
679	} else {
680	set _eviewmin [expr {$midE - 0.5*$delE}]
681	set _eviewmax [expr {$midE + 0.5*$delE}]
682	}
683	$_dispatcher event -idle !zoom
684	}
685
686	# ----------------------------------------------------------------------
687	# USAGE: _hilite brush <x> <y>
688	# USAGE: _hilite show <dataobj> <level>
689	# USAGE: _hilite hide
690	#
691	# Used internally to highlight energy levels in the zoom view and
692	# show their associated energy. The "brush" operation is called
693	# as the mouse moves in the zoom view, to see if the <x>,<y>
694	# coordinate is touching a level. The show/hide operations are
695	# then used to show/hide level info.
696	# ----------------------------------------------------------------------
697	itcl::body Rappture::EnergyLevels::_hilite {option args} {
698	switch -- $option {
699	brush {
700	if {[llength $args] != 2} {
701	error "wrong # args: should be \"_hilite brush x y\""
702	}
703	set x [lindex $args 0]
704	set y [lindex $args 1]
705
706	_getLayout
707	if {$x < $x2 \|\| $x > $x3} {
708	return ;# pointer must be in "zoom" area
709	}
710
711	set c $itk_component(graph)
712	set id [$c find withtag current]
713
714	# touching a line? then find the level and show its info
715	if {"" != $id} {
716	set e2y [expr {($yzoom1-$yzoom0)/($_eviewmax-$_eviewmin)}]
717
718	# put the dataobj list in order according to -raise options
719	set dlist $_dlist
720	foreach obj $dlist {
721	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
722	set i [lsearch -exact $dlist $obj]
723	if {$i >= 0} {
724	set dlist [lreplace $dlist $i $i]
725	lappend dlist $obj
726	}
727	}
728	}
729
730	set found 0
731	foreach dataobj $dlist {
732	set ecol $_dobj2cols($dataobj-energy)
733	set n 0
734	foreach eval [$dataobj values -column $ecol] {
735	set ylevel [expr {($eval-$_eviewmin)*$e2y + $yzoom0}]
736	if {$y >= $ylevel-3 && $y <= $ylevel+3} {
737	set found 1
738	break
739	}
740	incr n
741	}
742	if {$found} break
743	}
744	if {$found} {
745	_hilite show $dataobj $n
746	} else {
747	_hilite hide
748	}
749	} else {
750	_hilite hide
751	}
752	}
753	show {
754	if {[llength $args] != 2} {
755	error "wrong # args: should be \"_hilite show dataobj level\""
756	}
757	set dataobj [lindex $args 0]
758	set level [lindex $args 1]
759
760	if {$_hilite == "$dataobj $level"} {
761	return
762	}
763	_hilite hide
764
765	set lcol $_dobj2cols($dataobj-label)
766	set lval [lindex [$dataobj values -column $lcol] $level]
767	set ecol $_dobj2cols($dataobj-energy)
768	set eval [lindex [$dataobj values -column $ecol] $level]
769	set units [$dataobj columns -units $ecol]
770
771	if {$eval == $_ehomo \|\| $eval == $_elumo} {
772	$itk_component(graph) itemconfigure $dataobj-$level -width 2
773	set _hilite "$dataobj $level"
774	# don't pop up info for the HOMO/LUMO levels
775	return
776	}
777
778	_getLayout
779	set e2y [expr {($yzoom1-$yzoom0)/($_eviewmax-$_eviewmin)}]
780	set y [expr {($eval-$_eviewmin)*$e2y + $yzoom0}]
781
782	set tid [$c create text [expr {0.5*($x2+$x3)}] $y -anchor c \
783	-text "$lval = $eval $units" \
784	-fill $itk_option(-leveltextforeground) \
785	-tags hilite]
786
787	foreach {x0 y0 x1 y1} [$c bbox $tid] break
788	set tid2 [$c create rectangle \
789	[expr {$x0-1}] [expr {$y0-1}] \
790	[expr {$x1+1}] [expr {$y1+1}] \
791	-outline $itk_option(-leveltextforeground) \
792	-fill $itk_option(-leveltextbackground) \
793	-tags hilite]
794	$c lower $tid2 $tid
795
796	$c itemconfigure $dataobj-$level -width 2
797	set _hilite "$dataobj $level"
798	}
799	hide {
800	if {"" != $_hilite} {
801	$itk_component(graph) delete hilite
802	$itk_component(graph) itemconfigure zlevels -width 1
803	set _hilite ""
804	}
805	}
806	default {
807	error "bad option \"$option\": should be brush, show, hide"
808	}
809	}
810	}
811
812	# ----------------------------------------------------------------------
813	# USAGE: _getLayout
814	#
815	# Used internally to compute a series of variables used when redrawing
816	# the widget. Creates the variables with the proper values in the
817	# calling context.
818	# ----------------------------------------------------------------------
819	itcl::body Rappture::EnergyLevels::_getLayout {} {
820	upvar c c
821	set c $itk_component(graph)
822
823	upvar w w
824	set w [winfo width $c]
825
826	upvar h h
827	set h [winfo height $c]
828
829	#
830	# Measure the size of a typical label and use that to size
831	# the left/right portions. If the label is too big, leave
832	# at least a little room for the labels.
833	#
834	set size [font measure $itk_option(-font) "$_llumo = X.XXXXXXe-XX eV"]
835	set size [expr {$size + 6*$itk_option(-padding)}]
836
837	set textht [font metrics $itk_option(-font) -linespace]
838	set ypad [expr {int(0.5*($textht + 6))}]
839
840	if {$size > $w-20} {
841	set size [expr {$w-20}]
842	} elseif {$size < 0.66*$w} {
843	set size [expr {0.66*$w}]
844	}
845	set xm [expr {$w - $size}]
846
847	upvar x0 x0
848	set x0 $itk_option(-padding)
849
850	upvar x1 x1
851	set x1 [expr {$xm - $itk_option(-padding)}]
852
853	upvar x2 x2
854	set x2 [expr {$xm + $itk_option(-padding)}]
855
856	upvar x3 x3
857	set x3 [expr {$w - $itk_option(-padding)}]
858
859
860	upvar xx0 xx0
861	set xx0 [expr {$x0 + $itk_option(-padding)}]
862
863	upvar xx1 xx1
864	set xx1 [expr {$x1 - $itk_option(-padding)}]
865
866	upvar xx2 xx2
867	set xx2 [expr {$x2 + $itk_option(-padding)}]
868
869	upvar xx3 xx3
870	set xx3 [expr {$x3 - $itk_option(-padding)}]
871
872
873	upvar y0 y0
874	set y0 [expr {$h - $itk_option(-padding)}]
875
876	upvar yzoom0 yzoom0
877	set yzoom0 [expr {$y0 - $ypad}]
878
879	upvar y1 y1
880	set y1 $itk_option(-padding)
881
882	upvar yzoom1 yzoom1
883	set yzoom1 [expr {$y1 + $ypad}]
884	}
885
886	# ----------------------------------------------------------------------
887	# OPTION: -levelColor
888	# ----------------------------------------------------------------------
889	itcl::configbody Rappture::EnergyLevels::levelcolor {
890	$_dispatcher event -idle !redraw
891	}
892
893	# ----------------------------------------------------------------------
894	# OPTION: -leveltextforeground
895	# ----------------------------------------------------------------------
896	itcl::configbody Rappture::EnergyLevels::leveltextforeground {
897	$_dispatcher event -idle !redraw
898	}
899
900	# ----------------------------------------------------------------------
901	# OPTION: -leveltextbackground
902	# ----------------------------------------------------------------------
903	itcl::configbody Rappture::EnergyLevels::leveltextbackground {
904	$_dispatcher event -idle !redraw
905	}

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

Context Navigation

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

Download in other formats: