Context Navigation

energyLevels.tcl @ 761

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

Added a new <note> object which can be used to add annotations to
the input side. Each <note> has a <contents> area which contains
a url for a web site or a file. All file urls are treated as
relative to the "docs" directory where the tool.xml is located.

Fixed the output for <number>, <integer>, <boolean>, and <choice>
so that it shows multiple values when "All" is pressed, and it
highlights the current value. Also fixed the download option for
this widget so that it works properly.

Fixed the energy level viewer so that its download option works.

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

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

Context Navigation

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

Download in other formats: