Context Navigation

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

Last change on this file since 3394 was 3330, checked in by gah, 11 years ago
merge (by hand) with Rappture1.2 branch
File size: 36.0 KB

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

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

Download in other formats: