Context Navigation

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

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

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

Download in other formats: