Context Navigation

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

Last change on this file since 5520 was 3813, checked in by ldelgass, 11 years ago
Fix bug in 'add' method of viewer widgets: list search for existing dataobj entry was wrong (list and pattern transposed), causing potential duplicate entries in dataobj list.
File size: 35.8 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	array set params $settings
277
278	# convert -linestyle to BLT -dashes
279	switch -- $params(-linestyle) {
280	dashed { set params(-linestyle) {4 4} }
281	dotted { set params(-linestyle) {2 4} }
282	default { set params(-linestyle) {} }
283	}
284
285	# if -brightness is set, then update the color
286	if {$params(-brightness) != 0} {
287	set params(-color) [Rappture::color::brightness \
288	$params(-color) $params(-brightness)]
289	}
290	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
291	# can't handle -autocolors yet
292	set params(-color) blue
293	}
294
295	set pos [lsearch -exact $_dlist $dataobj]
296	if {$pos < 0} {
297	lappend _dlist $dataobj
298	set _dobj2color($dataobj) $params(-color)
299	set _dobj2raise($dataobj) $params(-raise)
300	set _dobj2desc($dataobj) $params(-description)
301
302	foreach {lcol ecol} $cols break
303	set _dobj2cols($dataobj-label) $lcol
304	set _dobj2cols($dataobj-energy) $ecol
305
306	$_dispatcher event -idle !redraw
307	}
308	}
309
310	# ----------------------------------------------------------------------
311	# USAGE: delete ?<dataobj1> <dataobj2> ...?
312	#
313	# Clients use this to delete a dataobj from the plot. If no dataobjs
314	# are specified, then all dataobjs are deleted.
315	# ----------------------------------------------------------------------
316	itcl::body Rappture::EnergyLevels::delete {args} {
317	if {[llength $args] == 0} {
318	set args $_dlist
319	}
320
321	# delete all specified data objs
322	set changed 0
323	foreach dataobj $args {
324	set pos [lsearch -exact $_dlist $dataobj]
325	if {$pos >= 0} {
326	set _dlist [lreplace $_dlist $pos $pos]
327	catch {unset _dobj2color($dataobj)}
328	catch {unset _dobj2raise($dataobj)}
329	catch {unset _dobj2desc($dataobj)}
330	catch {unset _dobj2cols($dataobj-label)}
331	catch {unset _dobj2cols($dataobj-energy)}
332	set changed 1
333	}
334	}
335
336	# if anything changed, then rebuild the plot
337	if {$changed} {
338	$_dispatcher event -idle !redraw
339	}
340	}
341
342	# ----------------------------------------------------------------------
343	# USAGE: get
344	#
345	# Clients use this to query the list of objects being plotted, in
346	# order from bottom to top of this result.
347	# ----------------------------------------------------------------------
348	itcl::body Rappture::EnergyLevels::get {} {
349	# put the dataobj list in order according to -raise options
350	set dlist $_dlist
351	foreach obj $dlist {
352	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
353	set i [lsearch -exact $dlist $obj]
354	if {$i >= 0} {
355	set dlist [lreplace $dlist $i $i]
356	lappend dlist $obj
357	}
358	}
359	}
360	return $dlist
361	}
362
363	# ----------------------------------------------------------------------
364	# USAGE: scale ?<dataobj1> <dataobj2> ...?
365	#
366	# Sets the default limits for the overall plot according to the
367	# limits of the data for all of the given <dataobj> objects. This
368	# accounts for all dataobjs--even those not showing on the screen.
369	# Because of this, the limits are appropriate for all data as
370	# the user scans through data in the ResultSet viewer.
371	# ----------------------------------------------------------------------
372	itcl::body Rappture::EnergyLevels::scale {args} {
373	set _emin ""
374	set _emax ""
375	foreach obj $args {
376	if {![info exists _dobj2cols($obj-energy)]} {
377	# don't recognize this object? then ignore it
378	continue
379	}
380	foreach {min max} [$obj limits $_dobj2cols($obj-energy)] break
381
382	if {"" != $min && "" != $max} {
383	if {"" == $_emin} {
384	set _emin $min
385	set _emax $max
386	} else {
387	if {$min < $_emin} { set _emin $min }
388	if {$max > $_emax} { set _emax $max }
389	}
390	}
391	}
392
393	if {"" != $_emin && $_emin == $_emax} {
394	set _emin [expr {$_emin-0.1}]
395	set _emax [expr {$_emax+0.1}]
396	}
397
398	set _eviewmin "" ;# reset zoom view
399	set _eviewmax ""
400	}
401
402	# ----------------------------------------------------------------------
403	# USAGE: download coming
404	# USAGE: download controls <downloadCommand>
405	# USAGE: download now
406	#
407	# Clients use this method to create a downloadable representation
408	# of the plot. Returns a list of the form {ext string}, where
409	# "ext" is the file extension (indicating the type of data) and
410	# "string" is the data itself.
411	# ----------------------------------------------------------------------
412	itcl::body Rappture::EnergyLevels::download {option args} {
413	switch $option {
414	coming {
415	# nothing to do
416	}
417	controls {
418	set popup .energyresultdownload
419	if {![winfo exists .energyresultdownload]} {
420	# if we haven't created the popup yet, do it now
421	Rappture::Balloon $popup \
422	-title "[Rappture::filexfer::label downloadWord] as..."
423	set inner [$popup component inner]
424	label $inner.summary -text "" -anchor w
425	pack $inner.summary -side top
426	radiobutton $inner.csv -text "Data as Comma-Separated Values" \
427	-variable Rappture::EnergyLevels::_downloadPopup(format) \
428	-value csv
429	pack $inner.csv -anchor w
430	radiobutton $inner.pdf -text "Image as PDF/PostScript" \
431	-variable Rappture::EnergyLevels::_downloadPopup(format) \
432	-value pdf
433	pack $inner.pdf -anchor w
434	button $inner.go -text [Rappture::filexfer::label download] \
435	-command [lindex $args 0]
436	pack $inner.go -pady 4
437	} else {
438	set inner [$popup component inner]
439	}
440	set num [llength [get]]
441	set num [expr {($num == 1) ? "1 result" : "$num results"}]
442	$inner.summary configure -text "[Rappture::filexfer::label downloadWord] $num in the following format:"
443	update idletasks ;# fix initial sizes
444	return $popup
445	}
446	now {
447	set popup .energyresultdownload
448	if {[winfo exists .energyresultdownload]} {
449	$popup deactivate
450	}
451	switch -- $_downloadPopup(format) {
452	csv {
453	# reverse the objects so the selected data appears on top
454	set dlist ""
455	foreach dataobj [get] {
456	set dlist [linsert $dlist 0 $dataobj]
457	}
458	# generate the comma-separated value data for these objects
459	set csvdata ""
460	foreach dataobj $dlist {
461	append csvdata "[string repeat - 60]\n"
462	append csvdata " [$dataobj hints label]\n"
463	if {[info exists _dobj2desc($dataobj)]
464	&& [llength [split $_dobj2desc($dataobj) \n]] > 1} {
465	set indent "for:"
466	foreach line [split $_dobj2desc($dataobj) \n] {
467	append csvdata " $indent $line\n"
468	set indent " "
469	}
470	}
471	append csvdata "[string repeat - 60]\n"
472
473	set ecol $_dobj2cols($dataobj-energy)
474	set units [$dataobj columns -units $ecol]
475	foreach eval [$dataobj values -column $ecol] {
476	append csvdata [format "%20.15g $units\n" $eval]
477	}
478	append csvdata "\n"
479	}
480	return [list .txt $csvdata]
481	}
482	pdf {
483	set psdata [$itk_component(graph) postscript]
484
485	set cmds {
486	set fout "energy[pid].pdf"
487	exec ps2pdf - $fout << $psdata
488
489	set fid [open $fout r]
490	fconfigure $fid -translation binary -encoding binary
491	set pdfdata [read $fid]
492	close $fid
493
494	file delete -force $fout
495	}
496	if {[catch $cmds result] == 0} {
497	return [list .pdf $pdfdata]
498	}
499	return [list .ps $psdata]
500	}
501	}
502	}
503	default {
504	error "bad option \"$option\": should be coming, controls, now"
505	}
506	}
507	}
508
509	# ----------------------------------------------------------------------
510	# USAGE: _redraw
511	#
512	# Used internally to load a list of energy levels from a <table> within
513	# the data objects.
514	# ----------------------------------------------------------------------
515	itcl::body Rappture::EnergyLevels::_redraw {{what all}} {
516	# scale data now, if we haven't already
517	if {"" == $_emin \|\| "" == $_emax} {
518	eval scale $_dlist
519	}
520
521	set dlist [get]
522	set topdobj [lindex $dlist end]
523	_getLayout
524
525	#
526	# Redraw the overall layout
527	#
528	if {$what == "all"} {
529	$c delete all
530	if {[llength $dlist] == 0} {
531	return
532	}
533
534	#
535	# Scan through all data objects and plot them in order from
536	# the bottom up.
537	#
538	set e2y [expr {($yzoom1-$yzoom0)/($_emax-$_emin)}]
539
540	set title ""
541	set dataobj ""
542	foreach dataobj $dlist {
543	if {"" == $title} {
544	set title [$dataobj hints label]
545	}
546
547	set ecol $_dobj2cols($dataobj-energy)
548	set color $_dobj2color($dataobj)
549	if {"" == $color} {
550	set color $itk_option(-levelcolor)
551	}
552	set color [Rappture::color::brightness $color 0.7]
553
554	foreach eval [$dataobj values -column $ecol] {
555	set y [expr {($eval-$_emin)*$e2y + $yzoom0}]
556	$c create line $xx0 $y $xx1 $y -fill $color -width 1
557	}
558	}
559
560	#
561	# Scan through the data and look for HOMO/LUMO levels.
562	# Set the default view to the energy just above and
563	# just below the HOMO/LUMO levels.
564	#
565	set _edefmin [expr {0.4*($_emax-$_emin) + $_emin}]
566	set _edefmax [expr {0.6*($_emax-$_emin) + $_emin}]
567
568	set nlumo -1
569	set nhomo -1
570
571	set dataobj [lindex $dlist end]
572	if {"" != $dataobj} {
573	set lcol $_dobj2cols($dataobj-label)
574	set ecol $_dobj2cols($dataobj-energy)
575	set units [$dataobj columns -units $ecol]
576
577	set n 0
578	foreach eval [$dataobj values -column $ecol] \
579	lval [$dataobj values -column $lcol] {
580
581	if {[string equal -nocase $lval "HOMO"]} {
582	set nhomo $n
583	set _lhomo $lval
584	set nlumo [expr {$n+1}]
585	set _llumo "LUMO"
586	} elseif {[string equal -nocase $lval "Ground State"]} {
587	set nhomo $n
588	set _lhomo $lval
589	set nlumo [expr {$n+1}]
590	set _llumo "1st Excited State"
591	} elseif {[string equal -nocase $lval "LUMO"]
592	\|\| [string equal -nocase $lval "1st Excited State"]} {
593	set nlumo $n
594	set _llumo $lval
595	}
596	incr n
597	}
598
599	if {$nhomo >= 0 && $nlumo >= 0} {
600	set elist [$dataobj values -column $ecol]
601	set _ehomo [lindex $elist $nhomo]
602	set _elumo [lindex $elist $nlumo]
603	if {"" != $_elumo && "" != $_ehomo} {
604	set gap [expr {$_elumo - $_ehomo}]
605	set _edefmin [expr {$_ehomo - 0.3*$gap}]
606	set _edefmax [expr {$_elumo + 0.3*$gap}]
607
608	set y [expr {($_ehomo-$_emin)*$e2y + $yzoom0}]
609	set id [$c create rectangle $xx0 $y $xx1 $y0 \
610	-stipple [Rappture::icon rdiag] \
611	-outline "" -fill $itk_option(-shadecolor)]
612	$c lower $id
613	}
614	}
615	}
616	if {"" == $_eviewmin \|\| "" == $_eviewmax} {
617	set _eviewmin $_edefmin
618	set _eviewmax $_edefmax
619	}
620
621	if {"" != $title} {
622	pack $itk_component(title) -side top -before $c
623	$itk_component(title) configure -text $title
624	} else {
625	pack forget $itk_component(title)
626	}
627
628	# draw the lines for the "zoom" view (fixed up below)
629	set color $itk_option(-foreground)
630	$c create line $x0 $yzoom0 $x1 $yzoom0 -fill $color -tags zmin
631	$c create line $x0 $yzoom0 $x1 $yzoom0 -fill $color -tags zmax
632
633	$c create line $x1 $yzoom0 $x2 $yzoom0 -fill $color -tags zoomup
634	$c create line $x1 $yzoom0 $x2 $yzoom1 -fill $color -tags zoomdn
635
636	$c create line $x2 $yzoom0 $x3 $yzoom0 -fill $color
637	$c create line $x2 $yzoom1 $x3 $yzoom1 -fill $color
638	}
639
640	#
641	# Redraw the "zoom" area on the right side
642	#
643	if {$what == "zoom" \|\| $what == "all"} {
644	set e2y [expr {($yzoom1-$yzoom0)/($_emax-$_emin)}]
645
646	set y [expr {($_eviewmin-$_emin)*$e2y + $yzoom0}]
647	$c coords zmin $x0 $y $x1 $y
648	$c coords zoomup $x1 $y $x2 $yzoom0
649
650	set y [expr {($_eviewmax-$_emin)*$e2y + $yzoom0}]
651	$c coords zmax $x0 $y $x1 $y
652	$c coords zoomdn $x1 $y $x2 $yzoom1
653
654	# redraw all levels in the current view
655	$c delete zlevels zlabels
656
657	set e2y [expr {($yzoom1-$yzoom0)/($_eviewmax-$_eviewmin)}]
658	foreach dataobj $dlist {
659	set ecol $_dobj2cols($dataobj-energy)
660	set color $_dobj2color($dataobj)
661	if {"" == $color} {
662	set color $itk_option(-levelcolor)
663	}
664
665	set n 0
666	foreach eval [$dataobj values -column $ecol] {
667	set y [expr {($eval-$_eviewmin)*$e2y + $yzoom0}]
668	if {$y >= $y1 && $y <= $y0} {
669	set id [$c create line $xx2 $y $xx3 $y \
670	-fill $color -width 1 \
671	-tags [list zlevels $dataobj-$n]]
672	}
673	incr n
674	}
675	}
676
677	if {"" != $topdobj && "" != $_ehomo && "" != $_elumo} {
678	set ecol $_dobj2cols($topdobj-energy)
679	set units [$topdobj columns -units $ecol]
680
681	set yy0 [expr {($_ehomo-$_eviewmin)*$e2y + $yzoom0}]
682	set yy1 [expr {($_elumo-$_eviewmin)*$e2y + $yzoom0}]
683
684	set textht [font metrics $itk_option(-font) -linespace]
685	if {$yy0-$yy1 >= 1.5*$textht} {
686	$c create line [expr {$x3-10}] $yy0 [expr {$x3-10}] $yy1 \
687	-arrow both -fill $itk_option(-foreground) \
688	-tags zlabels
689	$c create text [expr {$x3-15}] [expr {0.5*($yy0+$yy1)}] \
690	-anchor e -text "Eg = [expr {$_elumo-$_ehomo}] $units" \
691	-tags zlabels
692
693	# label the HOMO level
694	set tid [$c create text [expr {0.5*($x2+$x3)}] $yy0 -anchor c \
695	-text "$_lhomo = $_ehomo $units" \
696	-fill $itk_option(-leveltextforeground) \
697	-tags zlabels]
698
699	foreach {xb0 yb0 xb1 yb1} [$c bbox $tid] break
700	set tid2 [$c create rectangle \
701	[expr {$xb0-1}] [expr {$yb0-1}] \
702	[expr {$xb1+1}] [expr {$yb1+1}] \
703	-outline $itk_option(-leveltextforeground) \
704	-fill $itk_option(-leveltextbackground) \
705	-tags zlabels]
706	$c lower $tid2 $tid
707
708	# label the LUMO level
709	set tid [$c create text [expr {0.5*($x2+$x3)}] $yy1 -anchor c \
710	-text "$_llumo = $_elumo $units" \
711	-fill $itk_option(-leveltextforeground) \
712	-tags zlabels]
713
714	foreach {xb0 yb0 xb1 yb1} [$c bbox $tid] break
715	set tid2 [$c create rectangle \
716	[expr {$xb0-1}] [expr {$yb0-1}] \
717	[expr {$xb1+1}] [expr {$yb1+1}] \
718	-outline $itk_option(-leveltextforeground) \
719	-fill $itk_option(-leveltextbackground) \
720	-tags zlabels]
721	$c lower $tid2 $tid
722	}
723
724	if {$yy0 < $y0} {
725	set id [$c create rectangle $xx2 $yy0 $xx3 $y0 \
726	-stipple [Rappture::icon rdiag] \
727	-outline "" -fill $itk_option(-shadecolor) \
728	-tags zlabels]
729	$c lower $id
730	}
731	}
732	}
733	}
734
735	# ----------------------------------------------------------------------
736	# USAGE: _zoom in
737	# USAGE: _zoom out
738	# USAGE: _zoom reset
739	# USAGE: _zoom at <x> <y>
740	# USAGE: _zoom nudge <dir>
741	#
742	# Called automatically when the user clicks on one of the zoom
743	# controls for this widget. Changes the zoom for the current view.
744	# ----------------------------------------------------------------------
745	itcl::body Rappture::EnergyLevels::_zoom {option args} {
746	switch -- $option {
747	in {
748	set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
749	set delE [expr {0.8*($_eviewmax - $_eviewmin)}]
750	_view $midE $delE
751	}
752	out {
753	set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
754	set delE [expr {1.25*($_eviewmax - $_eviewmin)}]
755	_view $midE $delE
756	}
757	reset {
758	set _eviewmin $_edefmin
759	set _eviewmax $_edefmax
760	$_dispatcher event -idle !zoom
761	}
762	at {
763	if {[llength $args] != 2} {
764	error "wrong # args: should be \"_zoom at x y\""
765	}
766	set x [lindex $args 0]
767	set y [lindex $args 1]
768
769	_getLayout
770	set y2e [expr {($_emax-$_emin)/($yzoom1-$yzoom0)}]
771
772	if {$x > $x1} {
773	return
774	}
775	set midE [expr {($y-$yzoom0)*$y2e + $_emin}]
776	set delE [expr {$_eviewmax - $_eviewmin}]
777	_view $midE $delE
778	}
779	nudge {
780	if {[llength $args] != 1} {
781	error "wrong # args: should be \"_zoom nudge dir\""
782	}
783	set dir [lindex $args 0]
784
785	set midE [expr {0.5*($_eviewmax + $_eviewmin)}]
786	set delE [expr {$_eviewmax - $_eviewmin}]
787	set midE [expr {$midE + $dir0.25$delE}]
788	_view $midE $delE
789	}
790	}
791	focus $itk_component(graph)
792	}
793
794	# ----------------------------------------------------------------------
795	# USAGE: _view <midE> <delE>
796	#
797	# Called automatically when the user clicks/drags on the left side
798	# of the widget where energy levels are displayed. Sets the zoom
799	# view so that it's centered on the <y> coordinate.
800	# ----------------------------------------------------------------------
801	itcl::body Rappture::EnergyLevels::_view {midE delE} {
802	if {$delE > $_emax-$_emin} {
803	set delE [expr {$_emax - $_emin}]
804	}
805	if {$midE - 0.5*$delE < $_emin} {
806	set _eviewmin $_emin
807	set _eviewmax [expr {$_eviewmin+$delE}]
808	} elseif {$midE + 0.5*$delE > $_emax} {
809	set _eviewmax $_emax
810	set _eviewmin [expr {$_eviewmax-$delE}]
811	} else {
812	set _eviewmin [expr {$midE - 0.5*$delE}]
813	set _eviewmax [expr {$midE + 0.5*$delE}]
814	}
815	$_dispatcher event -idle !zoom
816	}
817
818	# ----------------------------------------------------------------------
819	# USAGE: _hilite brush <x> <y>
820	# USAGE: _hilite show <dataobj> <level>
821	# USAGE: _hilite hide
822	#
823	# Used internally to highlight energy levels in the zoom view and
824	# show their associated energy. The "brush" operation is called
825	# as the mouse moves in the zoom view, to see if the <x>,<y>
826	# coordinate is touching a level. The show/hide operations are
827	# then used to show/hide level info.
828	# ----------------------------------------------------------------------
829	itcl::body Rappture::EnergyLevels::_hilite {option args} {
830	switch -- $option {
831	brush {
832	if {[llength $args] != 2} {
833	error "wrong # args: should be \"_hilite brush x y\""
834	}
835	set x [lindex $args 0]
836	set y [lindex $args 1]
837
838	_getLayout
839	if {$x < $x2 \|\| $x > $x3} {
840	return ;# pointer must be in "zoom" area
841	}
842
843	set c $itk_component(graph)
844	set id [$c find withtag current]
845
846	# touching a line? then find the level and show its info
847	if {"" != $id} {
848	set e2y [expr {($yzoom1-$yzoom0)/($_eviewmax-$_eviewmin)}]
849
850	# put the dataobj list in order according to -raise options
851	set dlist $_dlist
852	foreach obj $dlist {
853	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
854	set i [lsearch -exact $dlist $obj]
855	if {$i >= 0} {
856	set dlist [lreplace $dlist $i $i]
857	lappend dlist $obj
858	}
859	}
860	}
861
862	set found 0
863	foreach dataobj $dlist {
864	set ecol $_dobj2cols($dataobj-energy)
865	set n 0
866	foreach eval [$dataobj values -column $ecol] {
867	set ylevel [expr {($eval-$_eviewmin)*$e2y + $yzoom0}]
868	if {$y >= $ylevel-3 && $y <= $ylevel+3} {
869	set found 1
870	break
871	}
872	incr n
873	}
874	if {$found} break
875	}
876	if {$found} {
877	_hilite show $dataobj $n
878	} else {
879	_hilite hide
880	}
881	} else {
882	_hilite hide
883	}
884	}
885	show {
886	if {[llength $args] != 2} {
887	error "wrong # args: should be \"_hilite show dataobj level\""
888	}
889	set dataobj [lindex $args 0]
890	set level [lindex $args 1]
891
892	if {$_hilite == "$dataobj $level"} {
893	return
894	}
895	_hilite hide
896
897	set lcol $_dobj2cols($dataobj-label)
898	set lval [lindex [$dataobj values -column $lcol] $level]
899	set ecol $_dobj2cols($dataobj-energy)
900	set eval [lindex [$dataobj values -column $ecol] $level]
901	set units [$dataobj columns -units $ecol]
902
903	if {$eval == $_ehomo \|\| $eval == $_elumo} {
904	$itk_component(graph) itemconfigure $dataobj-$level -width 2
905	set _hilite "$dataobj $level"
906	# don't pop up info for the HOMO/LUMO levels
907	return
908	}
909
910	_getLayout
911	set e2y [expr {($yzoom1-$yzoom0)/($_eviewmax-$_eviewmin)}]
912	set y [expr {($eval-$_eviewmin)*$e2y + $yzoom0}]
913
914	set tid [$c create text [expr {0.5*($x2+$x3)}] $y -anchor c \
915	-text "$lval = $eval $units" \
916	-fill $itk_option(-leveltextforeground) \
917	-tags hilite]
918
919	foreach {x0 y0 x1 y1} [$c bbox $tid] break
920	set tid2 [$c create rectangle \
921	[expr {$x0-1}] [expr {$y0-1}] \
922	[expr {$x1+1}] [expr {$y1+1}] \
923	-outline $itk_option(-leveltextforeground) \
924	-fill $itk_option(-leveltextbackground) \
925	-tags hilite]
926	$c lower $tid2 $tid
927
928	$c itemconfigure $dataobj-$level -width 2
929	set _hilite "$dataobj $level"
930	}
931	hide {
932	if {"" != $_hilite} {
933	$itk_component(graph) delete hilite
934	$itk_component(graph) itemconfigure zlevels -width 1
935	set _hilite ""
936	}
937	}
938	default {
939	error "bad option \"$option\": should be brush, show, hide"
940	}
941	}
942	}
943
944	# ----------------------------------------------------------------------
945	# USAGE: _getLayout
946	#
947	# Used internally to compute a series of variables used when redrawing
948	# the widget. Creates the variables with the proper values in the
949	# calling context.
950	# ----------------------------------------------------------------------
951	itcl::body Rappture::EnergyLevels::_getLayout {} {
952	upvar c c
953	set c $itk_component(graph)
954
955	upvar w w
956	set w [winfo width $c]
957
958	upvar h h
959	set h [winfo height $c]
960
961	#
962	# Measure the size of a typical label and use that to size
963	# the left/right portions. If the label is too big, leave
964	# at least a little room for the labels.
965	#
966	set size [font measure $itk_option(-font) "$_llumo = X.XXXXXXe-XX eV"]
967	set size [expr {$size + 6*$itk_option(-padding)}]
968
969	set textht [font metrics $itk_option(-font) -linespace]
970	set ypad [expr {int(0.5*($textht + 6))}]
971
972	if {$size > $w-20} {
973	set size [expr {$w-20}]
974	} elseif {$size < 0.66*$w} {
975	set size [expr {0.66*$w}]
976	}
977	set xm [expr {$w - $size}]
978
979	upvar x0 x0
980	set x0 $itk_option(-padding)
981
982	upvar x1 x1
983	set x1 [expr {$xm - $itk_option(-padding)}]
984
985	upvar x2 x2
986	set x2 [expr {$xm + $itk_option(-padding)}]
987
988	upvar x3 x3
989	set x3 [expr {$w - $itk_option(-padding)}]
990
991
992	upvar xx0 xx0
993	set xx0 [expr {$x0 + $itk_option(-padding)}]
994
995	upvar xx1 xx1
996	set xx1 [expr {$x1 - $itk_option(-padding)}]
997
998	upvar xx2 xx2
999	set xx2 [expr {$x2 + $itk_option(-padding)}]
1000
1001	upvar xx3 xx3
1002	set xx3 [expr {$x3 - $itk_option(-padding)}]
1003
1004
1005	upvar y0 y0
1006	set y0 [expr {$h - $itk_option(-padding)}]
1007
1008	upvar yzoom0 yzoom0
1009	set yzoom0 [expr {$y0 - $ypad}]
1010
1011	upvar y1 y1
1012	set y1 $itk_option(-padding)
1013
1014	upvar yzoom1 yzoom1
1015	set yzoom1 [expr {$y1 + $ypad}]
1016	}
1017
1018	# ----------------------------------------------------------------------
1019	# OPTION: -levelColor
1020	# ----------------------------------------------------------------------
1021	itcl::configbody Rappture::EnergyLevels::levelcolor {
1022	$_dispatcher event -idle !redraw
1023	}
1024
1025	# ----------------------------------------------------------------------
1026	# OPTION: -leveltextforeground
1027	# ----------------------------------------------------------------------
1028	itcl::configbody Rappture::EnergyLevels::leveltextforeground {
1029	$_dispatcher event -idle !redraw
1030	}
1031
1032	# ----------------------------------------------------------------------
1033	# OPTION: -leveltextbackground
1034	# ----------------------------------------------------------------------
1035	itcl::configbody Rappture::EnergyLevels::leveltextbackground {
1036	$_dispatcher event -idle !redraw
1037	}

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

Download in other formats: