Context Navigation

pager.tcl @ 21

Last change on this file since 21 was 11, checked in by mmc, 19 years ago

Major reorganization of the entire package. The config.xml file
is now irrelevant. All the action is in the tool.xml file. The
main program now organizes all input into 1) side-by-side pages,
2) input/result (wizard-style) pages, or 3) a series of wizard-
style pages. The <input> can have <phase> parts representing
the various pages.

Added a new ContourResult? widget based on Swaroop's vtk plotting
code.

Also, added easymesh and showmesh to the "tools" directory.
We need these for Eric Polizzi's code.

File size: 22.2 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: pager - notebook for displaying pages of widgets
3	#
4	# This widget is something like a tabbed notebook, but with a little
5	# more flexibility. Pages can be inserted and deleted, and then shown
6	# in various arrangements.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2005
10	# Purdue Research Foundation, West Lafayette, IN
11	# ======================================================================
12	package require Itk
13	package require BLT
14
15	option add *Pager.arrangement "pages" widgetDefault
16	option add *Pager.width 0 widgetDefault
17	option add *Pager.height 0 widgetDefault
18	option add *Pager.padding 8 widgetDefault
19	option add *Pager.crumbColor black widgetDefault
20	option add *Pager.crumbNumberColor white widgetDefault
21	option add *Pager.dimCrumbColor gray70 widgetDefault
22	option add *Pager.activeCrumbColor blue widgetDefault
23	option add *Pager.crumbFont \
24	--helvetica-bold-r-normal---120- widgetDefault
25
26	blt::bitmap define Pager-arrow {
27	#define arrow_width 9
28	#define arrow_height 9
29	static unsigned char arrow_bits[] = {
30	0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xff, 0x00, 0xff, 0x01, 0xff, 0x00,
31	0x70, 0x00, 0x30, 0x00, 0x10, 0x00};
32	}
33
34	itcl::class Rappture::Pager {
35	inherit itk::Widget
36
37	itk_option define -width width Width 0
38	itk_option define -height height Height 0
39	itk_option define -padding padding Padding 0
40	itk_option define -crumbcolor crumbColor Foreground ""
41	itk_option define -crumbnumbercolor crumbNumberColor Foreground ""
42	itk_option define -crumbfont crumbFont Font ""
43	itk_option define -dimcrumbcolor dimCrumbColor DimForeground ""
44	itk_option define -activecrumbcolor activeCrumbColor ActiveForeground ""
45	itk_option define -arrangement arrangement Arrangement ""
46
47	constructor {args} { # defined below }
48
49	public method insert {pos args}
50	public method delete {first {last ""}}
51	public method index {name}
52	public method page {args}
53	public method current {args}
54
55	protected method _layout {}
56	protected method _fixSize {}
57	protected method _drawCrumbs {how}
58
59	private variable _counter 0 ;# counter for page names
60	private variable _dispatcher "" ;# dispatcher for !events
61	private variable _pages "" ;# list of known pages
62	private variable _page2info ;# maps page name => -frame,-title,-command
63	private variable _current "" ;# page currently shown
64	}
65
66	itk::usual Pager {
67	}
68
69	# ----------------------------------------------------------------------
70	# CONSTRUCTOR
71	# ----------------------------------------------------------------------
72	itcl::body Rappture::Pager::constructor {args} {
73	Rappture::dispatcher _dispatcher
74	$_dispatcher register !layout
75	$_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
76	$_dispatcher register !fixsize
77	$_dispatcher dispatch $this !fixsize "[itcl::code $this _fixSize]; list"
78
79	itk_component add controls {
80	frame $itk_interior.cntls
81	}
82
83	itk_component add next {
84	button $itk_component(controls).next -width 6 -text "Next >" \
85	-command [itcl::code $this current next>]
86	}
87	pack $itk_component(next) -side right
88
89	itk_component add back {
90	button $itk_component(controls).back -width 6 -text "< Back" \
91	-command [itcl::code $this current <back]
92	}
93	pack $itk_component(back) -side left
94
95	set font [$itk_component(next) cget -font]
96	set ht [font metrics $font -linespace]
97	itk_component add breadcrumbs {
98	canvas $itk_interior.breadcrumbs -width 10 -height [expr {$ht+2}]
99	}
100
101	itk_component add line {
102	frame $itk_interior.line -height 2 -borderwidth 1 -relief sunken
103	}
104
105
106	itk_component add inside {
107	frame $itk_interior.inside
108	}
109	pack $itk_component(inside) -expand yes -fill both
110	pack propagate $itk_component(inside) no
111
112	eval itk_initialize $args
113	$_dispatcher event -idle !layout
114	}
115
116	# ----------------------------------------------------------------------
117	# USAGE: insert <pos> ?-name <name>? ?-title <label>? ?-command <str>?
118	#
119	# Clients use this to insert a new page into this pager. The page is
120	# inserted into the list at position <pos>, which can be an integer
121	# starting from 0 or the keyword "end". The optional <name> can be
122	# used to identify the page. If it is not supplied, a name is created
123	# for the page. The -title and -command are other values associated
124	# with the page.
125	#
126	# Returns the name used to identify the page.
127	# ----------------------------------------------------------------------
128	itcl::body Rappture::Pager::insert {pos args} {
129	if {"end" == $pos} {
130	set pos [llength $_pages]
131	} elseif {![string is integer $pos]} {
132	error "bad index \"$pos\": should be integer or \"end\""
133	}
134
135	Rappture::getopts args params {
136	value -name page#auto
137	value -title "Page #auto"
138	value -command ""
139	}
140	if {[llength $args] > 0} {
141	error "wrong # args: should be \"insert pos ?-name n? ?-title t? ?-command c?\""
142	}
143
144	incr _counter
145	if {$_counter > 1} {
146	set subst "#$_counter"
147	} else {
148	set subst ""
149	}
150	if {[regexp {#auto} $params(-name)]} {
151	regsub -all {#auto} $params(-name) $subst params(-name)
152	}
153	if {[regexp {#auto} $params(-title)]} {
154	regsub -all {#auto} $params(-title) $subst params(-title)
155	}
156
157	# allocate the page
158	if {[info exists _page2info($params(-name)-frame)]} {
159	error "page \"$params(-name)\" already exists"
160	}
161	set win $itk_component(inside).page$_counter
162	frame $win
163	set _page2info($params(-name)-frame) $win
164	set _page2info($params(-name)-title) $params(-title)
165	set _page2info($params(-name)-command) $params(-command)
166	set _pages [linsert $_pages $pos $params(-name)]
167
168	#bind $win <Configure> \
169	# [itcl::code $_dispatcher event -idle !fixsize]
170
171	$_dispatcher event -idle !layout
172
173	return $params(-name)
174	}
175
176	# ----------------------------------------------------------------------
177	# USAGE: delete <first> ?<last>?
178	#
179	# Clients use this to delete one or more pages from this widget.
180	# The <first> and <last> represent the integer index of the desired
181	# page. You can use the "index" method to convert a page name to
182	# its integer index. If only <first> is specified, then that one
183	# page is deleted. If <last> is specified, then all pages in the
184	# range <first> to <last> are deleted.
185	# ----------------------------------------------------------------------
186	itcl::body Rappture::Pager::delete {first {last ""}} {
187	if {$last == ""} {
188	set last $first
189	}
190	if {![regexp {^[0-9]+\|end$} $first]} {
191	error "bad index \"$first\": should be integer or \"end\""
192	}
193	if {![regexp {^[0-9]+\|end$} $last]} {
194	error "bad index \"$last\": should be integer or \"end\""
195	}
196
197	foreach name [lrange $_pages $first $last] {
198	if {[info exists _page2info($name-frame)]} {
199	destroy $_page2info($name-frame)
200	unset _page2info($name-frame)
201	unset _page2info($name-title)
202	unset _page2info($name-command)
203	}
204	}
205	set _pages [lreplace $_pages $first $last]
206
207	$_dispatcher event -idle !layout
208	}
209
210	# ----------------------------------------------------------------------
211	# USAGE: index <name>\|@n
212	#
213	# Clients use this to convert a page <name> into its corresponding
214	# integer index. Returns an error if the <name> is not recognized.
215	# ----------------------------------------------------------------------
216	itcl::body Rappture::Pager::index {name} {
217	set i [lsearch $_pages $name]
218	if {$i >= 0} {
219	return $i
220	}
221	if {[regexp {^@([0-9]+)$} $name match i]} {
222	return $i
223	}
224	error "bad page name \"$name\": should be @int or one of [join [lsort $_pages] {, }]"
225	}
226
227	# ----------------------------------------------------------------------
228	# USAGE: page
229	# USAGE: page <name>\|@n ?-frame\|-title\|-command? ?<newvalue>?
230	#
231	# Clients use this to get information about pages. With no args, it
232	# returns a list of all page names. Otherwise, it returns the
233	# requested information for a page specified by its <name> or index
234	# @n. By default, it returns the -frame for the page, but it can
235	# also return the -title and -command. The -title and -command
236	# can also be set to a <newvalue>.
237	# ----------------------------------------------------------------------
238	itcl::body Rappture::Pager::page {args} {
239	if {[llength $args] == 0} {
240	return $_pages
241	}
242	set i [index [lindex $args 0]]
243	set name [lindex $_pages $i]
244
245	set args [lrange $args 1 end]
246	Rappture::getopts args params {
247	flag what -frame default
248	flag what -title
249	flag what -command
250	}
251
252	if {[llength $args] == 0} {
253	set opt $params(what)
254	return $_page2info($name$opt)
255	} elseif {[llength $args] == 1} {
256	set val [lindex $args 0]
257	if {$params(-title)} {
258	set _page2info($name-title) $val
259	} elseif {$params(-command)} {
260	set _page2info($name-command) $val
261	}
262	} else {
263	error "wrong # args: should be \"page ?which? ?-frame\|-title\|-command? ?newvalue?\""
264	}
265	}
266
267	# ----------------------------------------------------------------------
268	# USAGE: current ?<name>\|next>\|<back?
269	#
270	# Used to query/set the current page in the notebook. With no args,
271	# it returns the name of the current page. Otherwise, it sets the
272	# current page. The special token "next>" is used to set the pager
273	# to the next logical page, and "<back" sets to the previous.
274	# ----------------------------------------------------------------------
275	itcl::body Rappture::Pager::current {args} {
276	switch -- [llength $args] {
277	0 {
278	return $_current
279	}
280	1 {
281	if {$itk_option(-arrangement) != "pages"} {
282	return ""
283	}
284	set name [lindex $args 0]
285	set index 0
286	if {$name == "next>"} {
287	if {$_current == ""} {
288	set index 0
289	} else {
290	set i [lsearch -exact $_pages $_current]
291	set index [expr {$i+1}]
292	if {$index >= [llength $_pages]} {
293	set index [expr {[llength $_pages]-1}]
294	}
295	}
296	set _current [lindex $_pages $index]
297	} elseif {$name == "<back"} {
298	if {$_current == ""} {
299	set index end
300	} else {
301	set i [lsearch -exact $_pages $_current]
302	set index [expr {$i-1}]
303	if {$index < 0} {
304	set index 0
305	}
306	}
307	set _current [lindex $_pages $index]
308	} else {
309	if {$name == ""} {
310	set _current ""
311	set index 0
312	} else {
313	set index [lsearch -exact $_pages $name]
314	if {$index < 0} {
315	error "can't move to page \"$name\""
316	}
317	set _current [lindex $_pages $index]
318	}
319	}
320
321	foreach w [pack slaves $itk_component(inside)] {
322	pack forget $w
323	}
324	if {$_current != ""} {
325	pack $_page2info($_current-frame) -expand yes -fill both \
326	-padx $itk_option(-padding) -pady $itk_option(-padding)
327	}
328
329	if {$index == 0} {
330	pack forget $itk_component(back)
331	} else {
332	set prev [expr {$index-1}]
333	if {$prev >= 0} {
334	set label "< [page @$prev -title]"
335	} else {
336	set label "< Back"
337	}
338	$itk_component(back) configure -text $label
339	pack $itk_component(back) -side left
340	}
341	if {$index == [expr {[llength $_pages]-1}]} {
342	pack forget $itk_component(next)
343	} else {
344	set next [expr {$index+1}]
345	if {$next <= [llength $_pages]} {
346	set label "[page @$next -title] >"
347	} else {
348	set label "Next >"
349	}
350	$itk_component(next) configure -text $label
351	pack $itk_component(next) -side right
352	}
353	_drawCrumbs current
354
355	#
356	# If this new page has a command associated with it, then
357	# invoke it now.
358	#
359	if {"" != $_current
360	&& [string length $_page2info($_current-command)] > 0} {
361	uplevel #0 $_page2info($_current-command)
362	}
363	}
364	default {
365	error "wrong # args: should be \"current name\|next>\|<back\""
366	}
367	}
368	}
369
370	# ----------------------------------------------------------------------
371	# USAGE: _layout
372	#
373	# Used internally to fix the current page management whenever pages
374	# are added or deleted, or when the page arrangement changes.
375	# ----------------------------------------------------------------------
376	itcl::body Rappture::Pager::_layout {} {
377	if {$itk_option(-arrangement) == "pages"} {
378	if {$_current == ""} {
379	set _current [lindex $_pages 0]
380	if {$_current != ""} {
381	current $_current
382	}
383	}
384	_drawCrumbs all
385	}
386	}
387
388	# ----------------------------------------------------------------------
389	# USAGE: _fixSize
390	#
391	# Invoked automatically whenever a page changes size or the -width
392	# or -height options change. When the -width/-height are zero, this
393	# method computes the minimum size needed to accommodate all pages.
394	# Otherwise, it passes the size request onto the hull.
395	# ----------------------------------------------------------------------
396	itcl::body Rappture::Pager::_fixSize {} {
397	switch -- $itk_option(-arrangement) {
398	pages {
399	if {$itk_option(-width) <= 0} {
400	update idletasks
401	set maxw [expr {
402	[winfo reqwidth $itk_component(next)]
403	+ 10
404	+ [winfo reqwidth $itk_component(back)]}]
405
406	foreach name $_pages {
407	set w [winfo reqwidth $_page2info($name-frame)]
408	if {$w > $maxw} { set maxw $w }
409	}
410	set maxw [expr {$maxw + 2*$itk_option(-padding)}]
411	$itk_component(inside) configure -width $maxw
412	} else {
413	$itk_component(inside) configure -width $itk_option(-width)
414	}
415
416	if {$itk_option(-height) <= 0} {
417	update idletasks
418	set maxh 0
419	foreach name $_pages {
420	set h [winfo reqheight $_page2info($name-frame)]
421	if {$h > $maxh} { set maxh $h }
422	}
423	set maxh [expr {$maxh + 2*$itk_option(-padding)}]
424	$itk_component(inside) configure -height $maxh
425	} else {
426	$itk_component(inside) configure -height $itk_option(-height)
427	}
428	}
429	side-by-side {
430	if {$itk_option(-width) <= 0} {
431	update idletasks
432	set maxw [expr {
433	[winfo reqwidth $itk_component(next)]
434	+ 10
435	+ [winfo reqwidth $itk_component(back)]}]
436
437	set wtotal 0
438	foreach name $_pages {
439	set w [winfo reqwidth $_page2info($name-frame)]
440	set wtotal [expr {$wtotal + $w + 2*$itk_option(-padding)}]
441	}
442	if {$wtotal > $maxw} { set maxw $wtotal }
443	$itk_component(inside) configure -width $maxw
444	} else {
445	$itk_component(inside) configure -width $itk_option(-width)
446	}
447
448	if {$itk_option(-height) <= 0} {
449	update idletasks
450	set maxh 0
451	foreach name $_pages {
452	set h [winfo reqheight $_page2info($name-frame)]
453	if {$h > $maxh} { set maxh $h }
454	}
455	set maxh [expr {$maxh + 2*$itk_option(-padding)}]
456	$itk_component(inside) configure -height $maxh
457	} else {
458	$itk_component(inside) configure -height $itk_option(-height)
459	}
460	}
461	}
462	}
463
464	# ----------------------------------------------------------------------
465	# OPTION: -arrangement
466	# ----------------------------------------------------------------------
467	itcl::configbody Rappture::Pager::arrangement {
468	switch -- $itk_option(-arrangement) {
469	pages {
470	pack forget $itk_component(inside)
471	pack $itk_component(controls) -side bottom -fill x -padx 8 -pady 8
472	if {[llength $_pages] > 2} {
473	pack $itk_component(breadcrumbs) -side top -fill x \
474	-padx 8 -pady 8
475	pack $itk_component(line) -side top -fill x
476	}
477	pack $itk_component(inside) -expand yes -fill both
478	current [lindex $_pages 0]
479	}
480	side-by-side {
481	pack forget $itk_component(controls)
482	pack forget $itk_component(line)
483	pack forget $itk_component(breadcrumbs)
484
485	foreach w [pack slaves $itk_component(inside)] {
486	pack forget $w
487	}
488	foreach name $_pages {
489	pack $_page2info($name-frame) -side left \
490	-expand yes -fill both \
491	-padx $itk_option(-padding) -pady $itk_option(-padding)
492	}
493	}
494	default {
495	error "bad value \"$itk_option(-arrangement)\": should be pages or side-by-side"
496	}
497	}
498	$_dispatcher event -now !fixsize
499	}
500
501	# ----------------------------------------------------------------------
502	# OPTION: -width
503	# ----------------------------------------------------------------------
504	itcl::configbody Rappture::Pager::width {
505	$_dispatcher event -idle !fixsize
506	}
507
508	# ----------------------------------------------------------------------
509	# OPTION: -height
510	# ----------------------------------------------------------------------
511	itcl::configbody Rappture::Pager::height {
512	$_dispatcher event -idle !fixsize
513	}
514
515	# ----------------------------------------------------------------------
516	# OPTION: -padding
517	# ----------------------------------------------------------------------
518	itcl::configbody Rappture::Pager::padding {
519	if {$_current != ""} {
520	pack $_page2info($_current-frame) -expand yes -fill both \
521	-padx $itk_option(-padding) -pady $itk_option(-padding)
522	}
523	$_dispatcher event -idle !fixsize
524	}
525
526	# ----------------------------------------------------------------------
527	# USAGE: _drawCrumbs all\|current
528	#
529	# Invoked automatically whenever the pages change. The value "all"
530	# signifies that the number of pages has changed, so all should be
531	# redrawn. The value "current" means that the current page has
532	# changed, so there is just a simple color change.
533	# ----------------------------------------------------------------------
534	itcl::body Rappture::Pager::_drawCrumbs {how} {
535	set c $itk_component(breadcrumbs)
536	set fnt $itk_option(-crumbfont)
537
538	switch -- $how {
539	all {
540	$c delete all
541
542	set x 0
543	set y [expr {[winfo reqheight $c]/2}]
544	set last [lindex $_pages end]
545
546	set num 1
547	foreach name $_pages {
548	set ht [expr {[font metrics $fnt -linespace]+2}]
549	set id [$c create oval $x [expr {$y-$ht/2}] \
550	[expr {$x+$ht}] [expr {$y+$ht/2}] \
551	-outline "" -fill $itk_option(-dimcrumbcolor) \
552	-tags $name]
553	set id [$c create text [expr {$x+$ht/2}] [expr {$y+1}] \
554	-text $num -fill $itk_option(-crumbnumbercolor) \
555	-tags [list $name $name-num]]
556	set x [expr {$x + $ht+2}]
557
558	set id [$c create text $x [expr {$y+1}] -anchor w \
559	-text [page $name -title] -font $fnt -tags $name]
560
561	$c bind $name <Enter> [itcl::code $this _drawCrumbs active]
562	$c bind $name <Leave> [itcl::code $this _drawCrumbs current]
563	$c bind $name <ButtonPress> [itcl::code $this current $name]
564
565	foreach {x0 y0 x1 y1} [$c bbox $id] break
566	set x [expr {$x + ($x1-$x0)+6}]
567
568	if {$name != $last} {
569	set id [$c create bitmap $x $y -anchor w \
570	-bitmap Pager-arrow \
571	-foreground $itk_option(-dimcrumbcolor)]
572	foreach {x0 y0 x1 y1} [$c bbox $id] break
573	set x [expr {$x + ($x1-$x0)+6}]
574	}
575
576	incr num
577	}
578
579	# fix the scrollregion in case we go off screen
580	$c configure -scrollregion [$c bbox all]
581
582	_drawCrumbs current
583	}
584	current {
585	# make all crumbs dim
586	foreach name $_pages {
587	$c itemconfigure $name \
588	-fill $itk_option(-dimcrumbcolor)
589	$c itemconfigure $name-num \
590	-fill $itk_option(-crumbnumbercolor)
591	}
592
593	# make all the current crumb bright
594	if {$_current != ""} {
595	$c itemconfigure $_current \
596	-fill $itk_option(-crumbcolor)
597	$c itemconfigure $_current-num \
598	-fill $itk_option(-crumbnumbercolor)
599
600	# scroll the view to see the crumb
601	if {[$c bbox $_current] != ""} {
602	foreach {x0 y0 x1 y1} [$c bbox $_current] break
603	foreach {xm0 ym0 xm1 ym1} [$c bbox all] break
604	set xm [expr {double($x0)/($xm1-$xm0)}]
605	$c xview moveto $xm
606	}
607	} else {
608	$c xview moveto 0
609	}
610	}
611	active {
612	foreach tag [$c gettags current] {
613	if {[lsearch -exact $_pages $tag] >= 0} {
614	$c itemconfigure $tag -fill $itk_option(-activecrumbcolor)
615	$c itemconfigure $tag-num -fill white
616	}
617	}
618	}
619	}
620	}

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

Context Navigation

source: trunk/gui/scripts/pager.tcl @ 21

Download in other formats: