Context Navigation

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

Last change on this file since 226 was 226, checked in by mmc, 18 years ago

Added code for Wei's visualization server.

Fixed the energyLevels widget so that it doesn't barf when the user attempts to download its contents.

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

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

Download in other formats: