Context Navigation

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

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

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

Download in other formats: