Context Navigation

source: branches/1.3/gui/scripts/energyLevels.tcl @ 4664

Last change on this file since 4664 was 3844, checked in by ldelgass, 11 years ago
Sync with trunk. Branch now differs only from trunk by r3722 (branch is version 1.3, trunk is version 1.4)
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: