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

Last change on this file since 24 was 24, checked in by mmc, 17 years ago

Fixed the device viewer to resize itself properly based on its
contents. The device layout takes into account the size of any
icon for a material layer, so a picture of a device can be embedded
by creating a single layer with an icon.

Fixed the Gauge to resize its icon area properly when the -spectrum
is configured later on.

File size: 22.4 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 -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 -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    # the number of pages affects the arrangment -- force an update
172    configure -arrangement $itk_option(-arrangement)
173
174    $_dispatcher event -idle !layout
175
176    return $params(-name)
177}
178
179# ----------------------------------------------------------------------
180# USAGE: delete <first> ?<last>?
181#
182# Clients use this to delete one or more pages from this widget.
183# The <first> and <last> represent the integer index of the desired
184# page.  You can use the "index" method to convert a page name to
185# its integer index.  If only <first> is specified, then that one
186# page is deleted.  If <last> is specified, then all pages in the
187# range <first> to <last> are deleted.
188# ----------------------------------------------------------------------
189itcl::body Rappture::Pager::delete {first {last ""}} {
190    if {$last == ""} {
191        set last $first
192    }
193    if {![regexp {^[0-9]+|end$} $first]} {
194        error "bad index \"$first\": should be integer or \"end\""
195    }
196    if {![regexp {^[0-9]+|end$} $last]} {
197        error "bad index \"$last\": should be integer or \"end\""
198    }
199
200    foreach name [lrange $_pages $first $last] {
201        if {[info exists _page2info($name-frame)]} {
202            destroy $_page2info($name-frame)
203            unset _page2info($name-frame)
204            unset _page2info($name-title)
205            unset _page2info($name-command)
206        }
207    }
208    set _pages [lreplace $_pages $first $last]
209
210    # the number of pages affects the arrangment -- force an update
211    configure -arrangement $itk_option(-arrangement)
212
213    $_dispatcher event -idle !layout
214}
215
216# ----------------------------------------------------------------------
217# USAGE: index <name>|@n
218#
219# Clients use this to convert a page <name> into its corresponding
220# integer index.  Returns an error if the <name> is not recognized.
221# ----------------------------------------------------------------------
222itcl::body Rappture::Pager::index {name} {
223    set i [lsearch $_pages $name]
224    if {$i >= 0} {
225        return $i
226    }
227    if {[regexp {^@([0-9]+)$} $name match i]} {
228        return $i
229    }
230    error "bad page name \"$name\": should be @int or one of [join [lsort $_pages] {, }]"
231}
232
233# ----------------------------------------------------------------------
234# USAGE: page
235# USAGE: page <name>|@n ?-frame|-title|-command? ?<newvalue>?
236#
237# Clients use this to get information about pages.  With no args, it
238# returns a list of all page names.  Otherwise, it returns the
239# requested information for a page specified by its <name> or index
240# @n.  By default, it returns the -frame for the page, but it can
241# also return the -title and -command.  The -title and -command
242# can also be set to a <newvalue>.
243# ----------------------------------------------------------------------
244itcl::body Rappture::Pager::page {args} {
245    if {[llength $args] == 0} {
246        return $_pages
247    }
248    set i [index [lindex $args 0]]
249    set name [lindex $_pages $i]
250
251    set args [lrange $args 1 end]
252    Rappture::getopts args params {
253        flag what -frame default
254        flag what -title
255        flag what -command
256    }
257
258    if {[llength $args] == 0} {
259        set opt $params(what)
260        return $_page2info($name$opt)
261    } elseif {[llength $args] == 1} {
262        set val [lindex $args 0]
263        if {$params(-title)} {
264            set _page2info($name-title) $val
265        } elseif {$params(-command)} {
266            set _page2info($name-command) $val
267        }
268    } else {
269        error "wrong # args: should be \"page ?which? ?-frame|-title|-command? ?newvalue?\""
270    }
271}
272
273# ----------------------------------------------------------------------
274# USAGE: current ?<name>|next>|<back?
275#
276# Used to query/set the current page in the notebook.  With no args,
277# it returns the name of the current page.  Otherwise, it sets the
278# current page.  The special token "next>" is used to set the pager
279# to the next logical page, and "<back" sets to the previous.
280# ----------------------------------------------------------------------
281itcl::body Rappture::Pager::current {args} {
282    switch -- [llength $args] {
283        0 {
284            return $_current
285        }
286        1 {
287            if {$itk_option(-arrangement) != "pages"} {
288                return ""
289            }
290            set name [lindex $args 0]
291            set index 0
292            if {$name == "next>"} {
293                if {$_current == ""} {
294                    set index 0
295                } else {
296                    set i [lsearch -exact $_pages $_current]
297                    set index [expr {$i+1}]
298                    if {$index >= [llength $_pages]} {
299                        set index [expr {[llength $_pages]-1}]
300                    }
301                }
302                set _current [lindex $_pages $index]
303            } elseif {$name == "<back"} {
304                if {$_current == ""} {
305                    set index end
306                } else {
307                    set i [lsearch -exact $_pages $_current]
308                    set index [expr {$i-1}]
309                    if {$index < 0} {
310                        set index 0
311                    }
312                }
313                set _current [lindex $_pages $index]
314            } else {
315                if {$name == ""} {
316                    set _current ""
317                    set index 0
318                } else {
319                    set index [lsearch -exact $_pages $name]
320                    if {$index < 0} {
321                        error "can't move to page \"$name\""
322                    }
323                    set _current [lindex $_pages $index]
324                }
325            }
326
327            foreach w [pack slaves $itk_component(inside)] {
328                pack forget $w
329            }
330            if {$_current != ""} {
331                pack $_page2info($_current-frame) -expand yes -fill both \
332                    -padx $itk_option(-padding) -pady $itk_option(-padding)
333            }
334
335            if {$index == 0} {
336                pack forget $itk_component(back)
337            } else {
338                set prev [expr {$index-1}]
339                if {$prev >= 0} {
340                    set label "< [page @$prev -title]"
341                } else {
342                    set label "< Back"
343                }
344                $itk_component(back) configure -text $label
345                pack $itk_component(back) -side left
346            }
347            if {$index == [expr {[llength $_pages]-1}]} {
348                pack forget $itk_component(next)
349            } else {
350                set next [expr {$index+1}]
351                if {$next <= [llength $_pages]} {
352                    set label "[page @$next -title] >"
353                } else {
354                    set label "Next >"
355                }
356                $itk_component(next) configure -text $label
357                pack $itk_component(next) -side right
358            }
359            _drawCrumbs current
360
361            #
362            # If this new page has a command associated with it, then
363            # invoke it now.
364            #
365            if {"" != $_current
366                  && [string length $_page2info($_current-command)] > 0} {
367                uplevel #0 $_page2info($_current-command)
368            }
369        }
370        default {
371            error "wrong # args: should be \"current name|next>|<back\""
372        }
373    }
374}
375
376# ----------------------------------------------------------------------
377# USAGE: _layout
378#
379# Used internally to fix the current page management whenever pages
380# are added or deleted, or when the page arrangement changes.
381# ----------------------------------------------------------------------
382itcl::body Rappture::Pager::_layout {} {
383    if {$itk_option(-arrangement) == "pages"} {
384        if {$_current == ""} {
385            set _current [lindex $_pages 0]
386            if {$_current != ""} {
387                current $_current
388            }
389        }
390        _drawCrumbs all
391    }
392}
393
394# ----------------------------------------------------------------------
395# USAGE: _fixSize
396#
397# Invoked automatically whenever a page changes size or the -width
398# or -height options change.  When the -width/-height are zero, this
399# method computes the minimum size needed to accommodate all pages.
400# Otherwise, it passes the size request onto the hull.
401# ----------------------------------------------------------------------
402itcl::body Rappture::Pager::_fixSize {} {
403    switch -- $itk_option(-arrangement) {
404        pages {
405            if {$itk_option(-width) <= 0} {
406                update idletasks
407                set maxw [expr {
408                    [winfo reqwidth $itk_component(next)]
409                    + 10
410                    + [winfo reqwidth $itk_component(back)]}]
411
412                foreach name $_pages {
413                    set w [winfo reqwidth $_page2info($name-frame)]
414                    if {$w > $maxw} { set maxw $w }
415                }
416                set maxw [expr {$maxw + 2*$itk_option(-padding)}]
417                $itk_component(inside) configure -width $maxw
418            } else {
419                $itk_component(inside) configure -width $itk_option(-width)
420            }
421
422            if {$itk_option(-height) <= 0} {
423                update idletasks
424                set maxh 0
425                foreach name $_pages {
426                    set h [winfo reqheight $_page2info($name-frame)]
427                    if {$h > $maxh} { set maxh $h }
428                }
429                set maxh [expr {$maxh + 2*$itk_option(-padding)}]
430                $itk_component(inside) configure -height $maxh
431            } else {
432                $itk_component(inside) configure -height $itk_option(-height)
433            }
434        }
435        side-by-side {
436            if {$itk_option(-width) <= 0} {
437                update idletasks
438                set maxw [expr {
439                    [winfo reqwidth $itk_component(next)]
440                    + 10
441                    + [winfo reqwidth $itk_component(back)]}]
442
443                set wtotal 0
444                foreach name $_pages {
445                    set w [winfo reqwidth $_page2info($name-frame)]
446                    set wtotal [expr {$wtotal + $w + 2*$itk_option(-padding)}]
447                }
448                if {$wtotal > $maxw} { set maxw $wtotal }
449                $itk_component(inside) configure -width $maxw
450            } else {
451                $itk_component(inside) configure -width $itk_option(-width)
452            }
453
454            if {$itk_option(-height) <= 0} {
455                update idletasks
456                set maxh 0
457                foreach name $_pages {
458                    set h [winfo reqheight $_page2info($name-frame)]
459                    if {$h > $maxh} { set maxh $h }
460                }
461                set maxh [expr {$maxh + 2*$itk_option(-padding)}]
462                $itk_component(inside) configure -height $maxh
463            } else {
464                $itk_component(inside) configure -height $itk_option(-height)
465            }
466        }
467    }
468}
469
470# ----------------------------------------------------------------------
471# OPTION: -arrangement
472# ----------------------------------------------------------------------
473itcl::configbody Rappture::Pager::arrangement {
474    switch -- $itk_option(-arrangement) {
475        pages {
476            pack forget $itk_component(inside)
477            pack $itk_component(controls) -side bottom -fill x -padx 8 -pady 8
478            if {[llength $_pages] > 2} {
479                pack $itk_component(breadcrumbs) -side top -fill x \
480                    -padx 8 -pady 8
481                pack $itk_component(line) -side top -fill x
482            }
483            pack $itk_component(inside) -expand yes -fill both
484            current [lindex $_pages 0]
485        }
486        side-by-side {
487            pack forget $itk_component(controls)
488            pack forget $itk_component(line)
489            pack forget $itk_component(breadcrumbs)
490
491            foreach w [pack slaves $itk_component(inside)] {
492                pack forget $w
493            }
494            foreach name $_pages {
495                pack $_page2info($name-frame) -side left \
496                    -expand yes -fill both \
497                    -padx $itk_option(-padding) -pady $itk_option(-padding)
498            }
499        }
500        default {
501            error "bad value \"$itk_option(-arrangement)\": should be pages or side-by-side"
502        }
503    }
504    $_dispatcher event -now !fixsize
505}
506
507# ----------------------------------------------------------------------
508# OPTION: -width
509# ----------------------------------------------------------------------
510itcl::configbody Rappture::Pager::width {
511    $_dispatcher event -idle !fixsize
512}
513
514# ----------------------------------------------------------------------
515# OPTION: -height
516# ----------------------------------------------------------------------
517itcl::configbody Rappture::Pager::height {
518    $_dispatcher event -idle !fixsize
519}
520
521# ----------------------------------------------------------------------
522# OPTION: -padding
523# ----------------------------------------------------------------------
524itcl::configbody Rappture::Pager::padding {
525    if {$_current != ""} {
526        pack $_page2info($_current-frame) -expand yes -fill both \
527            -padx $itk_option(-padding) -pady $itk_option(-padding)
528    }
529    $_dispatcher event -idle !fixsize
530}
531
532# ----------------------------------------------------------------------
533# USAGE: _drawCrumbs all|current
534#
535# Invoked automatically whenever the pages change.  The value "all"
536# signifies that the number of pages has changed, so all should be
537# redrawn.  The value "current" means that the current page has
538# changed, so there is just a simple color change.
539# ----------------------------------------------------------------------
540itcl::body Rappture::Pager::_drawCrumbs {how} {
541    set c $itk_component(breadcrumbs)
542    set fnt $itk_option(-crumbfont)
543
544    switch -- $how {
545        all {
546            $c delete all
547
548            set x 0
549            set y [expr {[winfo reqheight $c]/2}]
550            set last [lindex $_pages end]
551
552            set num 1
553            foreach name $_pages {
554                set ht [expr {[font metrics $fnt -linespace]+2}]
555                set id [$c create oval $x [expr {$y-$ht/2}] \
556                    [expr {$x+$ht}] [expr {$y+$ht/2}] \
557                    -outline "" -fill $itk_option(-dimcrumbcolor) \
558                    -tags $name]
559                set id [$c create text [expr {$x+$ht/2}] [expr {$y+1}] \
560                    -text $num -fill $itk_option(-crumbnumbercolor) \
561                    -tags [list $name $name-num]]
562                set x [expr {$x + $ht+2}]
563
564                set id [$c create text $x [expr {$y+1}] -anchor w \
565                    -text [page $name -title] -font $fnt -tags $name]
566
567                $c bind $name <Enter> [itcl::code $this _drawCrumbs active]
568                $c bind $name <Leave> [itcl::code $this _drawCrumbs current]
569                $c bind $name <ButtonPress> [itcl::code $this current $name]
570
571                foreach {x0 y0 x1 y1} [$c bbox $id] break
572                set x [expr {$x + ($x1-$x0)+6}]
573
574                if {$name != $last} {
575                    set id [$c create bitmap $x $y -anchor w \
576                        -bitmap Pager-arrow \
577                        -foreground $itk_option(-dimcrumbcolor)]
578                    foreach {x0 y0 x1 y1} [$c bbox $id] break
579                    set x [expr {$x + ($x1-$x0)+6}]
580                }
581
582                incr num
583            }
584
585            # fix the scrollregion in case we go off screen
586            $c configure -scrollregion [$c bbox all]
587
588            _drawCrumbs current
589        }
590        current {
591            # make all crumbs dim
592            foreach name $_pages {
593                $c itemconfigure $name \
594                    -fill $itk_option(-dimcrumbcolor)
595                $c itemconfigure $name-num \
596                    -fill $itk_option(-crumbnumbercolor)
597            }
598
599            # make all the current crumb bright
600            if {$_current != ""} {
601                $c itemconfigure $_current \
602                    -fill $itk_option(-crumbcolor)
603                $c itemconfigure $_current-num \
604                    -fill $itk_option(-crumbnumbercolor)
605
606                # scroll the view to see the crumb
607                if {[$c bbox $_current] != ""} {
608                    foreach {x0 y0 x1 y1} [$c bbox $_current] break
609                    foreach {xm0 ym0 xm1 ym1} [$c bbox all] break
610                    set xm [expr {double($x0)/($xm1-$xm0)}]
611                    $c xview moveto $xm
612                }
613            } else {
614                $c xview moveto 0
615            }
616        }
617        active {
618            foreach tag [$c gettags current] {
619                if {[lsearch -exact $_pages $tag] >= 0} {
620                    $c itemconfigure $tag -fill $itk_option(-activecrumbcolor)
621                    $c itemconfigure $tag-num -fill white
622                }
623            }
624        }
625    }
626}
Note: See TracBrowser for help on using the repository browser.