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

Last change on this file since 11 was 11, checked in by mmc, 16 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# ======================================================================
12package require Itk
13package require BLT
14
15option add *Pager.arrangement "pages" widgetDefault
16option add *Pager.width 0 widgetDefault
17option add *Pager.height 0 widgetDefault
18option add *Pager.padding 8 widgetDefault
19option add *Pager.crumbColor black widgetDefault
20option add *Pager.crumbNumberColor white widgetDefault
21option add *Pager.dimCrumbColor gray70 widgetDefault
22option add *Pager.activeCrumbColor blue widgetDefault
23option add *Pager.crumbFont \
24    -*-helvetica-bold-r-normal-*-*-120-* widgetDefault
25
26blt::bitmap define Pager-arrow {
27#define arrow_width 9
28#define arrow_height 9
29static 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
34itcl::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                                                                               
66itk::usual Pager {
67}
68
69# ----------------------------------------------------------------------
70# CONSTRUCTOR
71# ----------------------------------------------------------------------
72itcl::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# ----------------------------------------------------------------------
128itcl::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# ----------------------------------------------------------------------
186itcl::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# ----------------------------------------------------------------------
216itcl::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# ----------------------------------------------------------------------
238itcl::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# ----------------------------------------------------------------------
275itcl::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# ----------------------------------------------------------------------
376itcl::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# ----------------------------------------------------------------------
396itcl::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# ----------------------------------------------------------------------
467itcl::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# ----------------------------------------------------------------------
504itcl::configbody Rappture::Pager::width {
505    $_dispatcher event -idle !fixsize
506}
507
508# ----------------------------------------------------------------------
509# OPTION: -height
510# ----------------------------------------------------------------------
511itcl::configbody Rappture::Pager::height {
512    $_dispatcher event -idle !fixsize
513}
514
515# ----------------------------------------------------------------------
516# OPTION: -padding
517# ----------------------------------------------------------------------
518itcl::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# ----------------------------------------------------------------------
534itcl::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.