source: trunk/builder/scripts/slideframes.tcl @ 4503

Last change on this file since 4503 was 3177, checked in by mmc, 8 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.

File size: 12.3 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: slideframes - collection of frames with headings
3#
4#  This widget is similar to a tabbed notebook, but instead of having
5#  tabs on the side, it has headings inline with the content.  Clicking
6#  on a heading brings up the frame beneath the heading.  Only one
7#  frame can be packed at a time.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require Itk
16
17option add *Slideframes.width 0 widgetDefault
18option add *Slideframes.height 0 widgetDefault
19option add *Slideframes.headingBackground gray widgetDefault
20option add *Slideframes.headingForeground black widgetDefault
21option add *Slideframes.headingBorderWidth 2 widgetDefault
22option add *Slideframes.headingRelief raised widgetDefault
23
24itcl::class Rappture::Slideframes {
25    inherit itk::Widget
26
27    itk_option define -width width Width 0
28    itk_option define -height height Height 0
29    itk_option define -animstartcommand animStartCommand AnimStartCommand ""
30    itk_option define -animendcommand animEndCommand AnimEndCommand ""
31
32    constructor {args} { # defined below }
33    destructor { # defined below }
34
35    public method insert {pos args}
36    public method delete {args}
37    public method index {name}
38    public method page {name}
39    public method current {args}
40    public method size {} { return [llength $_pages] }
41
42    private method _fixSize {}
43    private method _fixLayout {args}
44
45    private variable _count 0       ;# counter for unique names
46    private variable _pages ""      ;# list of page frames
47    private variable _name2num      ;# maps name => id num for heading/page
48    private variable _current ""    ;# page currently shown
49    private variable _tweener ""    ;# tweener object for animations
50}
51
52itk::usual Slideframes {
53    keep -cursor -font
54    keep -headingbackground -headingforeground
55    keep -headingborderwidth -headingrelief
56}
57
58# ----------------------------------------------------------------------
59# CONSTRUCTOR
60# ----------------------------------------------------------------------
61itcl::body Rappture::Slideframes::constructor {args} {
62    itk_option add hull.width hull.height
63    pack propagate $itk_component(hull) no
64
65    bind $itk_component(hull) <Configure> [itcl::code $this _fixLayout]
66
67    set _tweener [Rappture::Tweener #auto]
68
69    eval itk_initialize $args
70}
71
72# ----------------------------------------------------------------------
73# DESTRUCTOR
74# ----------------------------------------------------------------------
75itcl::body Rappture::Slideframes::destructor {} {
76    itcl::delete object $_tweener
77}
78
79# ----------------------------------------------------------------------
80# USAGE: insert <pos> ?<name> <name>...?
81#
82# Used to insert one or more pages in the list of sliding frames.
83# Each page is identified by its <name>.  Returns the widget name
84# for each page created.
85# ----------------------------------------------------------------------
86itcl::body Rappture::Slideframes::insert {pos args} {
87    set rlist ""
88    foreach name $args {
89        if {[lsearch $_pages $name] >= 0} {
90            error "page \"$name\" already exists"
91        }
92        set id [incr _count]
93
94        set hname "heading$id"
95        itk_component add $hname {
96            button $itk_interior.$hname -text $name -highlightthickness 0 \
97                -anchor w -command [itcl::code $this current $name]
98        } {
99            usual
100            rename -background -headingbackground headingBackground Background
101            rename -foreground -headingforeground headingForeground Foreground
102            rename -borderwidth -headingborderwidth headingBorderWidth BorderWidth
103            rename -relief -headingrelief headingRelief Relief
104            ignore -highlightthickness
105        }
106
107        set pname "page$id"
108        itk_component add $pname {
109            frame $itk_interior.$pname
110        }
111        bind $itk_component($pname) <Configure> [itcl::code $this _fixSize]
112
113        if {[llength $_pages] == 0} {
114            # select first page by default
115            after idle [list catch [list $this current $name]]
116        }
117        set _pages [linsert $_pages $pos $name]
118        set _name2num($name) $id
119
120        lappend rlist $itk_component($pname)
121    }
122
123    return $rlist
124}
125
126# ----------------------------------------------------------------------
127# USAGE: delete -all
128# USAGE: delete ?<name> <name>...?
129#
130# Used to delete one or more pages from the notebook.  With the -all
131# flag, it deletes all pages.  Otherwise, it deletes each page
132# by name.  You can also delete a page by using an index of the
133# form "@n".
134# ----------------------------------------------------------------------
135itcl::body Rappture::Slideframes::delete {args} {
136    if {$args == "-all"} {
137        set args $_pages
138    }
139    foreach name $args {
140        set i [index $name]
141        set pname [lindex $_pages $i]
142        if {$pname != ""} {
143            set _pages [lreplace $_pages $i $i]
144            set id $_name2num($pname)
145            destroy $itk_component(heading$id) $itk_component(page$id)
146            unset _name2num($pname)
147        }
148    }
149}
150
151# ----------------------------------------------------------------------
152# USAGE: index <name>|@n
153#
154# Used to convert a page <name> to its corresponding integer index.
155# ----------------------------------------------------------------------
156itcl::body Rappture::Slideframes::index {name} {
157    set i [lsearch $_pages $name]
158    if {$i >= 0} {
159        return $i
160    }
161    if {[regexp {^@([0-9]+)$} $name match i]} {
162        return $i
163    }
164    error "bad page name \"$name\": should be @int or one of [join [lsort $_pages] {, }]"
165}
166
167# ----------------------------------------------------------------------
168# USAGE: page <name>|@n
169#
170# Used to convert a page <name> to its corresponding frame.
171# ----------------------------------------------------------------------
172itcl::body Rappture::Slideframes::page {name} {
173    set i [index $name]
174    set name [lindex $_pages $i]
175    set id $_name2num($name)
176    return $itk_component(page$id)
177}
178
179# ----------------------------------------------------------------------
180# USAGE: current ?<name>?
181#
182# Used to query/set the current page in the notebook.  With no args,
183# it returns the name of the current page.  Otherwise, it sets the
184# current page.
185# ----------------------------------------------------------------------
186itcl::body Rappture::Slideframes::current {args} {
187    switch -- [llength $args] {
188        0 {
189            return $_current
190        }
191        1 {
192            set name [lindex $args 0]
193            set index [lsearch -exact $_pages $name]
194            if {$index < 0} {
195                error "can't find page \"$name\""
196            }
197
198            set prev $_current
199            set _current [lindex $_pages $index]
200
201            if {$prev != $_current} {
202                $_tweener configure -from 0 -to 1 -duration 50 -steps 10 \
203                    -command [itcl::code $this _fixLayout $_current $prev %v] \
204                    -finalize [itcl::code $this _fixLayout end]
205            } else {
206                _fixLayout
207            }
208        }
209        default {
210            error "wrong # args: should be \"current ?name?\""
211        }
212    }
213}
214
215# ----------------------------------------------------------------------
216# USAGE: _fixSize
217#
218# Used to handle the requested size for this widget.  If -width or
219# -height is 0, then the size is computed based on the requested
220# sizes of internal pages.
221# ----------------------------------------------------------------------
222itcl::body Rappture::Slideframes::_fixSize {} {
223    if {"0" == $itk_option(-width)} {
224        set wd 0
225        foreach pname $_pages {
226            set id $_name2num($pname)
227            set w [winfo reqwidth $itk_component(page$id)]
228            if {$w > $wd} { set wd $w }
229        }
230        component hull configure -width $wd
231    } else {
232        component hull configure -width $itk_option(-width)
233    }
234
235    if {"0" == $itk_option(-height)} {
236        set headht 0
237        set pageht 0
238        foreach pname $_pages {
239            set id $_name2num($pname)
240            set h [winfo reqheight $itk_component(heading$id)]
241            set headht [expr {$headht + $h}]
242
243            set h [winfo reqheight $itk_component(page$id)]
244            if {$h > $pageht} { set pageht $h }
245        }
246        component hull configure -height [expr {$headht+$pageht}]
247    } else {
248        component hull configure -height $itk_option(-height)
249    }
250}
251
252# ----------------------------------------------------------------------
253# USAGE: _fixLayout ?<toName>? ?<fromName>? ?<frac>?
254#
255# Updates the layout of pages within this widget.  With no args, it
256# updates the layout based on the current page.  This is good for
257# resize operations.  The extra args let us animate from the layout
258# with one ID to the layout with another according to a fraction
259# <frac> from 0 to 1.
260# ----------------------------------------------------------------------
261itcl::body Rappture::Slideframes::_fixLayout {args} {
262    set atend 0
263    if {$args == "end"} {
264        set atend 1
265        set args ""
266    }
267
268    set toName $_current
269    set fromName ""
270    set frac 1
271    if {[llength $args] >= 1} { set toName [lindex $args 0] }
272    if {[llength $args] >= 2} { set fromName [lindex $args 1] }
273    if {[llength $args] >= 3} { set frac [lindex $args 2] }
274    if {[llength $args] > 3} {
275        error "wrong # args: should be \"_fixLayout ?id? ?previd? ?frac?\""
276    }
277
278    if {$frac == 0 && [string length $itk_option(-animstartcommand)] > 0} {
279        if {[catch [list uplevel #0 $itk_option(-animstartcommand)] err]} {
280            bgerror $err
281        }
282    }
283
284    set fromid ""
285    if {[info exists _name2num($fromName)]} {
286        set fromid $_name2num($fromName)
287    }
288
289    set toid ""
290    if {[info exists _name2num($toName)]} {
291        set toid $_name2num($toName)
292    }
293
294    set w [winfo width $itk_component(hull)]
295    set h [winfo height $itk_component(hull)]
296
297    # figure out the overall size of title buttons and space left over
298    set titlemax 0
299    foreach pname $_pages {
300        set id $_name2num($pname)
301        set titleh [winfo reqheight $itk_component(heading$id)]
302        set titlemax [expr {$titlemax + $titleh}]
303    }
304
305    set extra [expr {$h - $titlemax}]
306    if {$extra < 0} { set extra 0 }
307
308    if {$toid != ""} {
309        set pageht1 [winfo reqheight $itk_component(page$toid)]
310    } else {
311        set pageht1 0
312    }
313    if {$fromid != ""} {
314        set pageht2 [winfo reqheight $itk_component(page$fromid)]
315    } else {
316        set pageht2 0
317    }
318    set pageht [expr {$frac*$pageht1 + (1-$frac)*$pageht2}]
319    if {$pageht < $extra} {
320        set extra $pageht
321    }
322
323    # scan through all buttons and place them, along with the pages beneath
324    set ypos 0
325    foreach pname $_pages {
326        set id $_name2num($pname)
327        set titleh [winfo reqheight $itk_component(heading$id)]
328
329        # place the heading button
330        place $itk_component(heading$id) -x 0 -y $ypos -anchor nw \
331            -width $w -height $titleh
332        set ypos [expr {$ypos + $titleh}]
333
334        set pageht [winfo reqheight $itk_component(page$id)]
335        if {$id == $fromid || $id == $toid} {
336            if {$id == $toid} {
337                set ht [expr {round($extra * $frac)}]
338            } else {
339                set ht [expr {round($extra * (1-$frac))}]
340            }
341            if {$ht > $pageht} { set ht $pageht }
342            if {$ht > 0} {
343                place $itk_component(page$id) -x 0 -y $ypos -anchor nw \
344                    -width $w -height $ht
345                set ypos [expr {$ypos + $ht}]
346            } else {
347                place forget $itk_component(page$id)
348            }
349        } else {
350            place forget $itk_component(page$id)
351        }
352    }
353
354    if {$atend && [string length $itk_option(-animendcommand)] > 0} {
355        if {[catch [list uplevel #0 $itk_option(-animendcommand)] err]} {
356            bgerror $err
357        }
358    }
359}
360
361# ----------------------------------------------------------------------
362# OPTION: -width, -height
363# ----------------------------------------------------------------------
364itcl::configbody Rappture::Slideframes::width {
365    _fixSize
366}
367itcl::configbody Rappture::Slideframes::height {
368    _fixSize
369}
Note: See TracBrowser for help on using the repository browser.