Context Navigation

energyLevels.tcl @ 750

Last change on this file since 750 was 738, checked in by mmc, 17 years ago

Fixed a problem recently introduced with device structures on the
input side. app-rtd was having trouble changing the structure when
you changed devices via the loader.

Fix for support ticket #1631 'can't read "_axis(click-x)": no such
variable'. Added some code to guard against the case when release
gets called somehow before click.

Fix for support ticket #1688 'can't use empty string as operand of "-"'
Fix for support ticket #1689 'divide by zero'
Fix for support ticket #1707 'can't read "_dobj2cols(-energy)":
no such element in array'
All of these fixes had to do with the energy viewer, particularly
in the case where there was only 1 energy level, so the homo/lumo
levels could not be displayed.

Fix for support ticket #1704 'impossible limits (min 1.58489 >=
max 6.30957e-05)'
Added some code to guard against setting limits where min >= max.

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

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

Context Navigation

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

Download in other formats: