Context Navigation

source: branches/blt4/gui/scripts/energyLevels.tcl @ 1695

Last change on this file since 1695 was 1342, checked in by gah, 16 years ago
preliminary HQ output from molvisviewer; unexpand tabs; all jpeg generation at 100%
File size: 30.8 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: EnergyLevels - visualizer for discrete energy levels
3	#
4	# This widget is a simple visualizer for a set of quantized energy
5	# levels, as you might find for a molecule or a quantum well. It
6	# takes the Rappture XML representation for a <table> and extracts
7	# values from the "energy" column, then plots those energies on a
8	# graph.
9	# ======================================================================
10	# AUTHOR: Michael McLennan, Purdue University
11	# Copyright (c) 2004-2005 Purdue Research Foundation
12	#
13	# See the file "license.terms" for information on usage and
14	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15	# ======================================================================
16	package require Itk
17	package require BLT
18
19	option add *EnergyLevels.width 4i widgetDefault
20	option add *EnergyLevels.height 4i widgetDefault
21	option add *EnergyLevels.padding 4 widgetDefault
22	option add *EnergyLevels.controlBackground gray widgetDefault
23	option add *EnergyLevels.shadeColor gray widgetDefault
24	option add *EnergyLevels.levelColor black widgetDefault
25	option add *EnergyLevels.levelTextForeground black widgetDefault
26	option add *EnergyLevels.levelTextBackground white widgetDefault
27
28	option add *EnergyLevels.font \
29	--helvetica-medium-r-normal--12-* widgetDefault
30
31	itcl::class Rappture::EnergyLevels {
32	inherit itk::Widget
33
34	itk_option define -padding padding Padding 0
35	itk_option define -shadecolor shadeColor ShadeColor ""
36	itk_option define -levelcolor levelColor LevelColor ""
37	itk_option define -leveltextforeground levelTextForeground Foreground ""
38	itk_option define -leveltextbackground levelTextBackground Background ""
39
40	constructor {args} { # defined below }
41
42	public proc columns {table}
43
44	public method add {table {settings ""}}
45	public method delete {args}
46	public method get {}
47	public method scale {args}
48	public method download {args} {}
49	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: