Context Navigation

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

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

Fixed the output viewer for numbers/integers to show a plot of
the value versus input parameters. As you change the ResultSet?
control, the x-axis updates to show the number versus values
in the result set.

Fixed the Rappture::result command to include the user's login
in the metadata, so we know who performed the computation.

File size: 35.9 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: EnergyLevels - visualizer for discrete energy levels
3	#
4	# This widget is a simple visualizer for a set of quantized energy
5	# levels, as you might find for a molecule or a quantum well. It
6	# takes the Rappture XML representation for a <table> and extracts
7	# values from the "energy" column, then plots those energies on a
8	# graph.
9	# ======================================================================
10	# AUTHOR: Michael McLennan, Purdue University
11	# Copyright (c) 2004-2005 Purdue Research Foundation
12	#
13	# See the file "license.terms" for information on usage and
14	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15	# ======================================================================
16	package require Itk
17	package require BLT
18
19	option add *EnergyLevels.width 4i widgetDefault
20	option add *EnergyLevels.height 4i widgetDefault
21	option add *EnergyLevels.padding 4 widgetDefault
22	option add *EnergyLevels.controlBackground gray widgetDefault
23	option add *EnergyLevels.shadeColor gray widgetDefault
24	option add *EnergyLevels.levelColor black widgetDefault
25	option add *EnergyLevels.levelTextForeground black widgetDefault
26	option add *EnergyLevels.levelTextBackground white widgetDefault
27
28	option add *EnergyLevels.font \
29	--helvetica-medium-r-normal--12-* widgetDefault
30
31	itcl::class Rappture::EnergyLevels {
32	inherit itk::Widget
33
34	itk_option define -padding padding Padding 0
35	itk_option define -shadecolor shadeColor ShadeColor ""
36	itk_option define -levelcolor levelColor LevelColor ""
37	itk_option define -leveltextforeground levelTextForeground Foreground ""
38	itk_option define -leveltextbackground levelTextBackground Background ""
39
40	constructor {args} { # defined below }
41
42	public proc columns {table}
43
44	public method add {table {settings ""}}
45	public method delete {args}
46	public method 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 -title "Download as..."
426	set inner [$popup component inner]
427	label $inner.summary -text "" -anchor w
428	pack $inner.summary -side top
429	radiobutton $inner.csv -text "Data as Comma-Separated Values" \
430	-variable Rappture::EnergyLevels::_downloadPopup(format) \
431	-value csv
432	pack $inner.csv -anchor w
433	radiobutton $inner.pdf -text "Image as PDF/PostScript" \
434	-variable Rappture::EnergyLevels::_downloadPopup(format) \
435	-value pdf
436	pack $inner.pdf -anchor w
437	button $inner.go -text "Download Now" \
438	-command [lindex $args 0]
439	pack $inner.go -pady 4
440	} else {
441	set inner [$popup component inner]
442	}
443	set num [llength [get]]
444	set num [expr {($num == 1) ? "1 result" : "$num results"}]
445	$inner.summary configure -text "Download $num in the following format:"
446	update idletasks ;# fix initial sizes
447	return $popup
448	}
449	now {
450	set popup .energyresultdownload
451	if {[winfo exists .energyresultdownload]} {
452	$popup deactivate
453	}
454	switch -- $_downloadPopup(format) {
455	csv {
456	# reverse the objects so the selected data appears on top
457	set dlist ""
458	foreach dataobj [get] {
459	set dlist [linsert $dlist 0 $dataobj]
460	}
461	# generate the comma-separated value data for these objects
462	set csvdata ""
463	foreach dataobj $dlist {
464	append csvdata "[string repeat - 60]\n"
465	append csvdata " [$dataobj hints label]\n"
466	if {[info exists _dobj2desc($dataobj)]
467	&& [llength [split $_dobj2desc($dataobj) \n]] > 1} {
468	set indent "for:"
469	foreach line [split $_dobj2desc($dataobj) \n] {
470	append csvdata " $indent $line\n"
471	set indent " "
472	}
473	}
474	append csvdata "[string repeat - 60]\n"
475
476	set ecol $_dobj2cols($dataobj-energy)
477	set units [$dataobj columns -units $ecol]
478	foreach eval [$dataobj values -column $ecol] {
479	append csvdata [format "%20.15g $units\n" $eval]
480	}
481	append csvdata "\n"
482	}
483	return [list .txt $csvdata]
484	}
485	pdf {
486	set psdata [$itk_component(graph) postscript]
487
488	set cmds {
489	set fout "energy[pid].pdf"
490	exec ps2pdf - $fout << $psdata
491
492	set fid [open $fout r]
493	fconfigure $fid -translation binary -encoding binary
494	set pdfdata [read $fid]
495	close $fid
496
497	file delete -force $fout
498	}
499	if {[catch $cmds result] == 0} {
500	return [list .pdf $pdfdata]
501	}
502	return [list .ps $psdata]
503	}
504	}
505	}
506	default {
507	error "bad option \"$option\": should be coming, controls, now"
508	}
509	}
510	}
511
512	# ----------------------------------------------------------------------
513	# USAGE: _redraw
514	#
515	# Used internally to load a list of energy levels from a <table> within
516	# the data objects.
517	# ----------------------------------------------------------------------
518	itcl::body Rappture::EnergyLevels::_redraw {{what all}} {
519	# scale data now, if we haven't already
520	if {"" == $_emin \|\| "" == $_emax} {
521	eval scale $_dlist
522	}
523
524	set dlist [get]
525	set topdobj [lindex $dlist end]
526	_getLayout
527
528	#
529	# Redraw the overall layout
530	#
531	if {$what == "all"} {
532	$c delete all
533	if {[llength $dlist] == 0} {
534	return
535	}
536
537	#
538	# Scan through all data objects and plot them in order from
539	# the bottom up.
540	#
541	set e2y [expr {($yzoom1-$yzoom0)/($_emax-$_emin)}]
542
543	set title ""
544	set dataobj ""
545	foreach dataobj $dlist {
546	if {"" == $title} {
547	set title [$dataobj hints label]
548	}
549
550	set ecol $_dobj2cols($dataobj-energy)
551	set color $_dobj2color($dataobj)
552	if {"" == $color} {
553	set color $itk_option(-levelcolor)
554	}
555	set color [Rappture::color::brightness $color 0.7]
556
557	foreach eval [$dataobj values -column $ecol] {
558	set y [expr {($eval-$_emin)*$e2y + $yzoom0}]
559	$c create line $xx0 $y $xx1 $y -fill $color -width 1
560	}
561	}
562
563	#
564	# Scan through the data and look for HOMO/LUMO levels.
565	# Set the default view to the energy just above and
566	# just below the HOMO/LUMO levels.
567	#
568	set _edefmin [expr {0.4*($_emax-$_emin) + $_emin}]
569	set _edefmax [expr {0.6*($_emax-$_emin) + $_emin}]
570
571	set nlumo -1
572	set nhomo -1
573
574	set dataobj [lindex $dlist end]
575	if {"" != $dataobj} {
576	set lcol $_dobj2cols($dataobj-label)
577	set ecol $_dobj2cols($dataobj-energy)
578	set units [$dataobj columns -units $ecol]
579
580	set n 0
581	foreach eval [$dataobj values -column $ecol] \
582	lval [$dataobj values -column $lcol] {
583
584	if {[string equal -nocase $lval "HOMO"]} {
585	set nhomo $n
586	set _lhomo $lval
587	set nlumo [expr {$n+1}]
588	set _llumo "LUMO"
589	} elseif {[string equal -nocase $lval "Ground State"]} {
590	set nhomo $n
591	set _lhomo $lval
592	set nlumo [expr {$n+1}]
593	set _llumo "1st Excited State"
594	} elseif {[string equal -nocase $lval "LUMO"]
595	\|\| [string equal -nocase $lval "1st Excited State"]} {
596	set nlumo $n
597	set _llumo $lval
598	}
599	incr n
600	}
601
602	if {$nhomo >= 0 && $nlumo >= 0} {
603	set elist [$dataobj values -column $ecol]
604	set _ehomo [lindex $elist $nhomo]
605	set _elumo [lindex $elist $nlumo]
606	if {"" != $_elumo && "" != $_ehomo} {
607	set gap [expr {$_elumo - $_ehomo}]
608	set _edefmin [expr {$_ehomo - 0.3*$gap}]
609	set _edefmax [expr {$_elumo + 0.3*$gap}]
610
611	set y [expr {($_ehomo-$_emin)*$e2y + $yzoom0}]
612	set id [$c create rectangle $xx0 $y $xx1 $y0 \
613	-stipple [Rappture::icon rdiag] \
614	-outline "" -fill $itk_option(-shadecolor)]
615	$c lower $id
616	}
617	}
618	}
619	if {"" == $_eviewmin \|\| "" == $_eviewmax} {
620	set _eviewmin $_edefmin
621	set _eviewmax $_edefmax
622	}
623
624	if {"" != $title} {
625	pack $itk_component(title) -side top -before $c
626	$itk_component(title) configure -text $title
627	} else {
628	pack forget $itk_component(title)
629	}
630
631	# draw the lines for the "zoom" view (fixed up below)
632	set color $itk_option(-foreground)
633	$c create line $x0 $yzoom0 $x1 $yzoom0 -fill $color -tags zmin
634	$c create line $x0 $yzoom0 $x1 $yzoom0 -fill $color -tags zmax
635
636	$c create line $x1 $yzoom0 $x2 $yzoom0 -fill $color -tags zoomup
637	$c create line $x1 $yzoom0 $x2 $yzoom1 -fill $color -tags zoomdn
638
639	$c create line $x2 $yzoom0 $x3 $yzoom0 -fill $color
640	$c create line $x2 $yzoom1 $x3 $yzoom1 -fill $color
641	}
642
643	#
644	# Redraw the "zoom" area on the right side
645	#
646	if {$what == "zoom" \|\| $what == "all"} {
647	set e2y [expr {($yzoom1-$yzoom0)/($_emax-$_emin)}]
648
649	set y [expr {($_eviewmin-$_emin)*$e2y + $yzoom0}]
650	$c coords zmin $x0 $y $x1 $y
651	$c coords zoomup $x1 $y $x2 $yzoom0
652
653	set y [expr {($_eviewmax-$_emin)*$e2y + $yzoom0}]
654	$c coords zmax $x0 $y $x1 $y
655	$c coords zoomdn $x1 $y $x2 $yzoom1
656
657	# redraw all levels in the current view
658	$c delete zlevels zlabels
659
660	set e2y [expr {($yzoom1-$yzoom0)/($_eviewmax-$_eviewmin)}]
661	foreach dataobj $dlist {
662	set ecol $_dobj2cols($dataobj-energy)
663	set color $_dobj2color($dataobj)
664	if {"" == $color} {
665	set color $itk_option(-levelcolor)
666	}
667
668	set n 0
669	foreach eval [$dataobj values -column $ecol] {
670	set y [expr {($eval-$_eviewmin)*$e2y + $yzoom0}]
671	if {$y >= $y1 && $y <= $y0} {
672	set id [$c create line $xx2 $y $xx3 $y \
673	-fill $color -width 1 \
674	-tags [list zlevels $dataobj-$n]]
675	}
676	incr n
677	}
678	}
679
680	if {"" != $topdobj && "" != $_ehomo && "" != $_elumo} {
681	set ecol $_dobj2cols($topdobj-energy)
682	set units [$topdobj columns -units $ecol]
683
684	set yy0 [expr {($_ehomo-$_eviewmin)*$e2y + $yzoom0}]
685	set yy1 [expr {($_elumo-$_eviewmin)*$e2y + $yzoom0}]
686
687	set textht [font metrics $itk_option(-font) -linespace]
688	if {$yy0-$yy1 >= 1.5*$textht} {
689	$c create line [expr {$x3-10}] $yy0 [expr {$x3-10}] $yy1 \
690	-arrow both -fill $itk_option(-foreground) \
691	-tags zlabels
692	$c create text [expr {$x3-15}] [expr {0.5*($yy0+$yy1)}] \
693	-anchor e -text "Eg = [expr {$_elumo-$_ehomo}] $units" \
694	-tags zlabels
695
696	# label the HOMO level
697	set tid [$c create text [expr {0.5*($x2+$x3)}] $yy0 -anchor c \
698	-text "$_lhomo = $_ehomo $units" \
699	-fill $itk_option(-leveltextforeground) \
700	-tags zlabels]
701
702	foreach {xb0 yb0 xb1 yb1} [$c bbox $tid] break
703	set tid2 [$c create rectangle \
704	[expr {$xb0-1}] [expr {$yb0-1}] \
705	[expr {$xb1+1}] [expr {$yb1+1}] \
706	-outline $itk_option(-leveltextforeground) \
707	-fill $itk_option(-leveltextbackground) \
708	-tags zlabels]
709	$c lower $tid2 $tid
710
711	# label the LUMO level
712	set tid [$c create text [expr {0.5*($x2+$x3)}] $yy1 -anchor c \
713	-text "$_llumo = $_elumo $units" \
714	-fill $itk_option(-leveltextforeground) \
715	-tags zlabels]
716
717	foreach {xb0 yb0 xb1 yb1} [$c bbox $tid] break
718	set tid2 [$c create rectangle \
719	[expr {$xb0-1}] [expr {$yb0-1}] \
720	[expr {$xb1+1}] [expr {$yb1+1}] \
721	-outline $itk_option(-leveltextforeground) \
722	-fill $itk_option(-leveltextbackground) \
723	-tags zlabels]
724	$c lower $tid2 $tid
725	}
726
727	if {$yy0 < $y0} {
728	set id [$c create rectangle $xx2 $yy0 $xx3 $y0 \
729	-stipple [Rappture::icon rdiag] \
730	-outline "" -fill $itk_option(-shadecolor) \
731	-tags zlabels]
732	$c lower $id
733	}
734	}
735	}
736	}
737
738	# ----------------------------------------------------------------------
739	# USAGE: _zoom in
740	# USAGE: _zoom out
741	# USAGE: _zoom reset
742	# USAGE: _zoom at <x> <y>
743	# USAGE: _zoom nudge <dir>
744	#
745	# Called automatically when the user clicks on one of the zoom
746	# controls for this widget. Changes the zoom for the current view.
747	# ----------------------------------------------------------------------
748	itcl::body Rappture::EnergyLevels::_zoom {option args} {
749	switch -- $option {
750	in {
751	set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
752	set delE [expr {0.8*($_eviewmax - $_eviewmin)}]
753	_view $midE $delE
754	}
755	out {
756	set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
757	set delE [expr {1.25*($_eviewmax - $_eviewmin)}]
758	_view $midE $delE
759	}
760	reset {
761	set _eviewmin $_edefmin
762	set _eviewmax $_edefmax
763	$_dispatcher event -idle !zoom
764	}
765	at {
766	if {[llength $args] != 2} {
767	error "wrong # args: should be \"_zoom at x y\""
768	}
769	set x [lindex $args 0]
770	set y [lindex $args 1]
771
772	_getLayout
773	set y2e [expr {($_emax-$_emin)/($yzoom1-$yzoom0)}]
774
775	if {$x > $x1} {
776	return
777	}
778	set midE [expr {($y-$yzoom0)*$y2e + $_emin}]
779	set delE [expr {$_eviewmax - $_eviewmin}]
780	_view $midE $delE
781	}
782	nudge {
783	if {[llength $args] != 1} {
784	error "wrong # args: should be \"_zoom nudge dir\""
785	}
786	set dir [lindex $args 0]
787
788	set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
789	set delE [expr {$_eviewmax - $_eviewmin}]
790	set midE [expr {$midE + $dir0.25$delE}]
791	_view $midE $delE
792	}
793	}
794	focus $itk_component(graph)
795	}
796
797	# ----------------------------------------------------------------------
798	# USAGE: _view <midE> <delE>
799	#
800	# Called automatically when the user clicks/drags on the left side
801	# of the widget where energy levels are displayed. Sets the zoom
802	# view so that it's centered on the <y> coordinate.
803	# ----------------------------------------------------------------------
804	itcl::body Rappture::EnergyLevels::_view {midE delE} {
805	if {$delE > $_emax-$_emin} {
806	set delE [expr {$_emax - $_emin}]
807	}
808	if {$midE - 0.5*$delE < $_emin} {
809	set _eviewmin $_emin
810	set _eviewmax [expr {$_eviewmin+$delE}]
811	} elseif {$midE + 0.5*$delE > $_emax} {
812	set _eviewmax $_emax
813	set _eviewmin [expr {$_eviewmax-$delE}]
814	} else {
815	set _eviewmin [expr {$midE - 0.5*$delE}]
816	set _eviewmax [expr {$midE + 0.5*$delE}]
817	}
818	$_dispatcher event -idle !zoom
819	}
820
821	# ----------------------------------------------------------------------
822	# USAGE: _hilite brush <x> <y>
823	# USAGE: _hilite show <dataobj> <level>
824	# USAGE: _hilite hide
825	#
826	# Used internally to highlight energy levels in the zoom view and
827	# show their associated energy. The "brush" operation is called
828	# as the mouse moves in the zoom view, to see if the <x>,<y>
829	# coordinate is touching a level. The show/hide operations are
830	# then used to show/hide level info.
831	# ----------------------------------------------------------------------
832	itcl::body Rappture::EnergyLevels::_hilite {option args} {
833	switch -- $option {
834	brush {
835	if {[llength $args] != 2} {
836	error "wrong # args: should be \"_hilite brush x y\""
837	}
838	set x [lindex $args 0]
839	set y [lindex $args 1]
840
841	_getLayout
842	if {$x < $x2 \|\| $x > $x3} {
843	return ;# pointer must be in "zoom" area
844	}
845
846	set c $itk_component(graph)
847	set id [$c find withtag current]
848
849	# touching a line? then find the level and show its info
850	if {"" != $id} {
851	set e2y [expr {($yzoom1-$yzoom0)/($_eviewmax-$_eviewmin)}]
852
853	# put the dataobj list in order according to -raise options
854	set dlist $_dlist
855	foreach obj $dlist {
856	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
857	set i [lsearch -exact $dlist $obj]
858	if {$i >= 0} {
859	set dlist [lreplace $dlist $i $i]
860	lappend dlist $obj
861	}
862	}
863	}
864
865	set found 0
866	foreach dataobj $dlist {
867	set ecol $_dobj2cols($dataobj-energy)
868	set n 0
869	foreach eval [$dataobj values -column $ecol] {
870	set ylevel [expr {($eval-$_eviewmin)*$e2y + $yzoom0}]
871	if {$y >= $ylevel-3 && $y <= $ylevel+3} {
872	set found 1
873	break
874	}
875	incr n
876	}
877	if {$found} break
878	}
879	if {$found} {
880	_hilite show $dataobj $n
881	} else {
882	_hilite hide
883	}
884	} else {
885	_hilite hide
886	}
887	}
888	show {
889	if {[llength $args] != 2} {
890	error "wrong # args: should be \"_hilite show dataobj level\""
891	}
892	set dataobj [lindex $args 0]
893	set level [lindex $args 1]
894
895	if {$_hilite == "$dataobj $level"} {
896	return
897	}
898	_hilite hide
899
900	set lcol $_dobj2cols($dataobj-label)
901	set lval [lindex [$dataobj values -column $lcol] $level]
902	set ecol $_dobj2cols($dataobj-energy)
903	set eval [lindex [$dataobj values -column $ecol] $level]
904	set units [$dataobj columns -units $ecol]
905
906	if {$eval == $_ehomo \|\| $eval == $_elumo} {
907	$itk_component(graph) itemconfigure $dataobj-$level -width 2
908	set _hilite "$dataobj $level"
909	# don't pop up info for the HOMO/LUMO levels
910	return
911	}
912
913	_getLayout
914	set e2y [expr {($yzoom1-$yzoom0)/($_eviewmax-$_eviewmin)}]
915	set y [expr {($eval-$_eviewmin)*$e2y + $yzoom0}]
916
917	set tid [$c create text [expr {0.5*($x2+$x3)}] $y -anchor c \
918	-text "$lval = $eval $units" \
919	-fill $itk_option(-leveltextforeground) \
920	-tags hilite]
921
922	foreach {x0 y0 x1 y1} [$c bbox $tid] break
923	set tid2 [$c create rectangle \
924	[expr {$x0-1}] [expr {$y0-1}] \
925	[expr {$x1+1}] [expr {$y1+1}] \
926	-outline $itk_option(-leveltextforeground) \
927	-fill $itk_option(-leveltextbackground) \
928	-tags hilite]
929	$c lower $tid2 $tid
930
931	$c itemconfigure $dataobj-$level -width 2
932	set _hilite "$dataobj $level"
933	}
934	hide {
935	if {"" != $_hilite} {
936	$itk_component(graph) delete hilite
937	$itk_component(graph) itemconfigure zlevels -width 1
938	set _hilite ""
939	}
940	}
941	default {
942	error "bad option \"$option\": should be brush, show, hide"
943	}
944	}
945	}
946
947	# ----------------------------------------------------------------------
948	# USAGE: _getLayout
949	#
950	# Used internally to compute a series of variables used when redrawing
951	# the widget. Creates the variables with the proper values in the
952	# calling context.
953	# ----------------------------------------------------------------------
954	itcl::body Rappture::EnergyLevels::_getLayout {} {
955	upvar c c
956	set c $itk_component(graph)
957
958	upvar w w
959	set w [winfo width $c]
960
961	upvar h h
962	set h [winfo height $c]
963
964	#
965	# Measure the size of a typical label and use that to size
966	# the left/right portions. If the label is too big, leave
967	# at least a little room for the labels.
968	#
969	set size [font measure $itk_option(-font) "$_llumo = X.XXXXXXe-XX eV"]
970	set size [expr {$size + 6*$itk_option(-padding)}]
971
972	set textht [font metrics $itk_option(-font) -linespace]
973	set ypad [expr {int(0.5*($textht + 6))}]
974
975	if {$size > $w-20} {
976	set size [expr {$w-20}]
977	} elseif {$size < 0.66*$w} {
978	set size [expr {0.66*$w}]
979	}
980	set xm [expr {$w - $size}]
981
982	upvar x0 x0
983	set x0 $itk_option(-padding)
984
985	upvar x1 x1
986	set x1 [expr {$xm - $itk_option(-padding)}]
987
988	upvar x2 x2
989	set x2 [expr {$xm + $itk_option(-padding)}]
990
991	upvar x3 x3
992	set x3 [expr {$w - $itk_option(-padding)}]
993
994
995	upvar xx0 xx0
996	set xx0 [expr {$x0 + $itk_option(-padding)}]
997
998	upvar xx1 xx1
999	set xx1 [expr {$x1 - $itk_option(-padding)}]
1000
1001	upvar xx2 xx2
1002	set xx2 [expr {$x2 + $itk_option(-padding)}]
1003
1004	upvar xx3 xx3
1005	set xx3 [expr {$x3 - $itk_option(-padding)}]
1006
1007
1008	upvar y0 y0
1009	set y0 [expr {$h - $itk_option(-padding)}]
1010
1011	upvar yzoom0 yzoom0
1012	set yzoom0 [expr {$y0 - $ypad}]
1013
1014	upvar y1 y1
1015	set y1 $itk_option(-padding)
1016
1017	upvar yzoom1 yzoom1
1018	set yzoom1 [expr {$y1 + $ypad}]
1019	}
1020
1021	# ----------------------------------------------------------------------
1022	# OPTION: -levelColor
1023	# ----------------------------------------------------------------------
1024	itcl::configbody Rappture::EnergyLevels::levelcolor {
1025	$_dispatcher event -idle !redraw
1026	}
1027
1028	# ----------------------------------------------------------------------
1029	# OPTION: -leveltextforeground
1030	# ----------------------------------------------------------------------
1031	itcl::configbody Rappture::EnergyLevels::leveltextforeground {
1032	$_dispatcher event -idle !redraw
1033	}
1034
1035	# ----------------------------------------------------------------------
1036	# OPTION: -leveltextbackground
1037	# ----------------------------------------------------------------------
1038	itcl::configbody Rappture::EnergyLevels::leveltextbackground {
1039	$_dispatcher event -idle !redraw
1040	}

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

Download in other formats: