source: trunk/gui/scripts/panes.tcl @ 2652

Last change on this file since 2652 was 1929, checked in by gah, 14 years ago
File size: 16.2 KB
Line 
1
2# ----------------------------------------------------------------------
3#  COMPONENT: Panes - creates a series of adjustable panes
4#
5#  This is a simple paned window with an adjustable sash.
6#  the same quantity, but for various ranges of input values.
7#  It also manages the controls to select and visualize the data.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2005  Purdue Research Foundation
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 *Panes.width 3i widgetDefault
18option add *Panes.height 3i widgetDefault
19option add *Panes.sashRelief sunken widgetDefault
20option add *Panes.sashWidth 2 widgetDefault
21option add *Panes.sashPadding 4 widgetDefault
22option add *Panes.sashCursor sb_v_double_arrow
23
24itcl::class Rappture::Panes {
25    inherit itk::Widget
26
27    itk_option define -sashcursor sashCursor SashCursor ""
28    itk_option define -sashrelief sashRelief SashRelief ""
29    itk_option define -sashwidth sashWidth SashWidth 0
30    itk_option define -sashpadding sashPadding SashPadding 0
31
32    constructor {args} { # defined below }
33
34    public method insert {pos args}
35    public method pane {pos}
36    public method visibility {pos {newval ""}}
37    public method fraction {pos {newval ""}}
38    public method hilite {state sash}
39
40    protected method _grab {pane X Y}
41    protected method _drag {pane X Y}
42    protected method _drop {pane X Y}
43    protected method _fixLayout {args}
44    protected method _fixSashes {args}
45
46    private variable _dispatcher ""  ;# dispatcher for !events
47    private variable _panes ""       ;# list of pane frames
48    private variable _visibility ""  ;# list of visibilities for panes
49    private variable _counter 0      ;# counter for auto-generated names
50    private variable _frac 0.0       ;# list of fractions
51    public variable orientation "vertical"
52}
53
54itk::usual Panes {
55    keep -background -cursor
56}
57
58# ----------------------------------------------------------------------
59# CONSTRUCTOR
60# ----------------------------------------------------------------------
61itcl::body Rappture::Panes::constructor {args} {
62    itk_option add hull.width hull.height
63
64    # create a dispatcher for events
65    Rappture::dispatcher _dispatcher
66    $_dispatcher register !layout
67    $_dispatcher dispatch $this !layout [itcl::code $this _fixLayout]
68    $_dispatcher register !sashes
69    $_dispatcher dispatch $this !sashes [itcl::code $this _fixSashes]
70
71    # fix the layout whenever the window size changes
72    bind Panes <Configure> [itcl::code %W _fixLayout]
73
74    set pname "pane[incr _counter]"
75    itk_component add $pname {
76        frame $itk_interior.$pname
77    }
78
79    lappend _panes $pname
80    lappend _visibility 1
81    set _frac 0.5
82
83    eval itk_initialize $args
84
85    # make sure we fix up the layout at some point
86    $_dispatcher event -idle !layout
87}
88
89# ----------------------------------------------------------------------
90# USAGE: insert <pos> ?-fraction f?
91#
92# Adds a new page to this widget at the given position <pos>.
93# ----------------------------------------------------------------------
94itcl::body Rappture::Panes::insert {pos args} {
95    Rappture::getopts args params {
96        value -fraction 0.5
97    }
98    if {[llength $args] > 0} {
99        error "wrong # args: should be \"insert pos ?-fraction f?\""
100    }
101
102    set pname "pane[incr _counter]"
103    set sash "${pname}sash"
104    itk_component add $sash {
105        frame $itk_interior.$sash
106    } {
107        usual
108        rename -cursor -sashcursor sashCursor SashCursor
109    }
110    bind $itk_component($sash) <Enter> [itcl::code $this hilite on $sash]
111    bind $itk_component($sash) <Leave> [itcl::code $this hilite off $sash]
112
113    itk_component add ${sash}ridge {
114        frame $itk_component($sash).ridge
115    } {
116        usual
117        rename -cursor -sashcursor sashCursor SashCursor
118        rename -relief -sashrelief sashRelief SashRelief
119        ignore -borderwidth
120    }
121    if { $orientation == "vertical" } {
122        pack $itk_component(${sash}ridge) -fill x
123    } else {
124        pack $itk_component(${sash}ridge) -fill y -side left
125    }
126    foreach comp [list $sash ${sash}ridge] {
127        bind $itk_component($comp) <ButtonPress-1> \
128            [itcl::code $this _grab $pname %X %Y]
129        bind $itk_component($comp) <B1-Motion> \
130            [itcl::code $this _drag $pname %X %Y]
131        bind $itk_component($comp) <ButtonRelease-1> \
132            [itcl::code $this _drop $pname %X %Y]
133    }
134
135
136    itk_component add $pname {
137        frame $itk_interior.$pname
138    }
139    set _panes [linsert $_panes $pos $pname]
140    set _visibility [linsert $_visibility $pos 1]
141    set _frac [linsert $_frac $pos $params(-fraction)]
142
143    # fix sash characteristics
144    $_dispatcher event -idle !sashes
145
146    # make sure we fix up the layout at some point
147    $_dispatcher event -idle !layout
148
149    return $itk_component($pname)
150}
151
152# ----------------------------------------------------------------------
153# USAGE: pane <pos>
154#
155# Returns the frame representing the pane at position <pos>.
156# ----------------------------------------------------------------------
157itcl::body Rappture::Panes::pane {pos} {
158    set pname [lindex $_panes $pos]
159    if {[info exists itk_component($pname)]} {
160        return $itk_component($pname)
161    }
162    return ""
163}
164
165# ----------------------------------------------------------------------
166# USAGE: visibility <pos> ?<newval>?
167#
168# Clients use this to get/set the visibility of the pane at position
169# <pos>.
170# ----------------------------------------------------------------------
171itcl::body Rappture::Panes::visibility {pos {newval ""}} {
172    if {"" == $newval} {
173        return [lindex $_visibility $pos]
174    }
175    if {![string is boolean $newval]} {
176        error "bad value \"$newval\": should be boolean"
177    }
178    if {$pos == "end" || ($pos >= 0 && $pos < [llength $_visibility])} {
179        set _visibility [lreplace $_visibility $pos $pos [expr {$newval}]]
180        $_dispatcher event -idle !layout
181    } else {
182        error "bad index \"$pos\": out of range"
183    }
184}
185
186# ----------------------------------------------------------------------
187# USAGE: fraction <pos> ?<newval>?
188#
189# Clients use this to get/set the fraction of real estate associated
190# with the pane at position <pos>.
191# ----------------------------------------------------------------------
192itcl::body Rappture::Panes::fraction {pos {newval ""}} {
193    if {"" == $newval} {
194        return [lindex $_frac $pos]
195    }
196    if {![string is double $newval]} {
197        error "bad value \"$newval\": should be fraction 0-1"
198    }
199    if {$pos == "end" || ($pos >= 0 && $pos < [llength $_frac])} {
200        set len [llength $_frac]
201        set _frac [lreplace $_frac $pos $pos xxx]
202        set total 0
203        foreach f $_frac {
204            if {"xxx" != $f} {
205                set total [expr {$total+$f}]
206            }
207        }
208        for {set i 0} {$i < $len} {incr i} {
209            set f [lindex $_frac $i]
210            if {"xxx" == $f} {
211                set f $newval
212            } else {
213                set f [expr {$f/$total - $newval/double($len-1)}]
214            }
215            set _frac [lreplace $_frac $i $i $f]
216        }
217        $_dispatcher event -idle !layout
218    } else {
219        error "bad index \"$pos\": out of range"
220    }
221}
222
223# ----------------------------------------------------------------------
224# USAGE: hilite <state> <sash>
225#
226# Invoked automatically whenever the user touches a sash.  Highlights
227# the sash by changing its size or relief.
228# ----------------------------------------------------------------------
229itcl::body Rappture::Panes::hilite {state sash} {
230    switch -- $itk_option(-sashrelief) {
231      sunken {
232        if {$state} {
233            $itk_component(${sash}ridge) configure -relief raised
234        } else {
235            $itk_component(${sash}ridge) configure -relief sunken
236        }
237      }
238      raised {
239        if {$state} {
240            $itk_component(${sash}ridge) configure -relief sunken
241        } else {
242            $itk_component(${sash}ridge) configure -relief raised
243        }
244      }
245      solid {
246        if {$state} {
247            $itk_component($sash) configure -background black
248        } else {
249            $itk_component($sash) configure \
250                -background $itk_option(-background)
251        }
252      }
253    }
254}
255
256# ----------------------------------------------------------------------
257# USAGE: _grab <pane> <X> <Y>
258#
259# Invoked automatically when the user clicks on a sash, to initiate
260# movement.
261# ----------------------------------------------------------------------
262itcl::body Rappture::Panes::_grab {pname X Y} {
263}
264
265# ----------------------------------------------------------------------
266# USAGE: _drag <pane> <X> <Y>
267#
268# Invoked automatically as the user drags a sash, to resize the panes.
269# ----------------------------------------------------------------------
270itcl::body Rappture::Panes::_drag {pname X Y} {
271    if { $orientation == "vertical" } {
272        set realY [expr {$Y-[winfo rooty $itk_component(hull)]}]
273        set Ymax  [winfo height $itk_component(hull)]
274        set frac [expr double($realY)/$Ymax]
275    } else {
276        set realX [expr {$X-[winfo rootx $itk_component(hull)]}]
277        set Xmax  [winfo width $itk_component(hull)]
278        set frac [expr double($realX)/$Xmax]
279    }
280    if {$frac < 0.05} {
281        set frac 0.05
282    }
283    if {$frac > 0.95} {
284        set frac 0.95
285    }
286    if {[llength $_frac] == 2} {
287        set _frac [list $frac [expr {1-$frac}]]
288    } else {
289        set i [expr {[lsearch $_panes $pname]-1}]
290        if {$i >= 0} {
291            set _frac [lreplace $_frac $i $i $frac]
292        }
293    }
294    _fixLayout
295
296    return $frac
297}
298
299# ----------------------------------------------------------------------
300# USAGE: _drop <pane> <X> <Y>
301#
302# Invoked automatically as the user drops a sash, to resize the panes.
303# ----------------------------------------------------------------------
304itcl::body Rappture::Panes::_drop {pname X Y} {
305    set frac [_drag $pname $X $Y]
306}
307
308# ----------------------------------------------------------------------
309# USAGE: _fixLayout ?<eventArgs>...?
310#
311# Used internally to update the layout of panes whenever a new pane
312# is added or a sash is moved.
313# ----------------------------------------------------------------------
314itcl::body Rappture::Panes::_fixLayout {args} {
315    if { $orientation == "vertical" } {
316        set h [winfo height $itk_component(hull)]
317
318        set plist ""
319        set flist ""
320        foreach p $_panes f $_frac v $_visibility {
321            set sash ${p}sash
322            if {$v} {
323                # this pane is visible -- make room for it
324                lappend plist $p
325                lappend flist $f
326                if {[info exists itk_component($sash)]} {
327                    set h [expr {$h - [winfo reqheight $itk_component($sash)]}]
328                }
329            } else {
330                # this pane is not visible -- remove sash
331                if {[info exists itk_component($sash)]} {
332                    place forget $itk_component($sash)
333                }
334                place forget $itk_component($p)
335            }
336        }
337       
338        # normalize the fractions so they add up to 1
339        set total 0
340        foreach f $flist { set total [expr {$total+$f}] }
341        set newflist ""
342        foreach f $flist {
343            lappend newflist [expr {double($f)/$total}]
344        }
345        set flist $newflist
346       
347        # lay out the various panes
348        set y 0
349        foreach p $plist f $flist {
350            set sash ${p}sash
351            if {[info exists itk_component($sash)]} {
352                set sh [winfo reqheight $itk_component($sash)]
353                place $itk_component($sash) -y $y -relx 0.5 -anchor n \
354                    -relwidth 1.0 -height $sh
355                set y [expr {$y + $sh}]
356            }
357           
358            set ph [expr {$h*$f}]
359            place $itk_component($p) -y $y -relx 0.5 -anchor n \
360                -relwidth 1.0 -height $ph
361            set y [expr {$y + $ph}]
362        }
363    } else {
364        set w [winfo width $itk_component(hull)]
365
366        set plist ""
367        set flist ""
368        foreach p $_panes f $_frac v $_visibility {
369            set sash ${p}sash
370            if {$v} {
371                # this pane is visible -- make room for it
372                lappend plist $p
373                lappend flist $f
374                if {[info exists itk_component($sash)]} {
375                    set w [expr {$w - [winfo reqwidth $itk_component($sash)]}]
376                }
377            } else {
378                # this pane is not visible -- remove sash
379                if {[info exists itk_component($sash)]} {
380                    place forget $itk_component($sash)
381                }
382                place forget $itk_component($p)
383            }
384        }
385       
386        # normalize the fractions so they add up to 1
387        set total 0
388        foreach f $flist { set total [expr {$total+$f}] }
389        set newflist ""
390        foreach f $flist {
391            lappend newflist [expr {double($f)/$total}]
392        }
393        set flist $newflist
394       
395        # lay out the various panes
396        set x 0
397        foreach p $plist f $flist {
398            set sash ${p}sash
399            if {[info exists itk_component($sash)]} {
400                set sw [winfo reqwidth $itk_component($sash)]
401                place $itk_component($sash) -x $x -rely 0.5 -anchor w \
402                    -relheight 1.0 -width $sw
403                set x [expr {$x + $sw}]
404            }
405           
406            set pw [expr {$w*$f}]
407            place $itk_component($p) -x $x -rely 0.5 -anchor w \
408                -relheight 1.0 -width $pw
409            set x [expr {$x + $pw}]
410        }
411    }   
412}
413
414# ----------------------------------------------------------------------
415# USAGE: _fixSashes
416#
417# Used internally to fix the appearance of sashes whenever a new
418# sash appears or the controlling configuration options change.
419# ----------------------------------------------------------------------
420itcl::body Rappture::Panes::_fixSashes {args} {
421    if { $orientation == "vertical" } {
422        set ht [winfo pixels $itk_component(hull) $itk_option(-sashwidth)]
423        set bd [expr {$ht/2}]
424        foreach pane $_panes {
425            set sash "${pane}sashridge"
426            if {[info exists itk_component($sash)]} {
427                $itk_component($sash) configure -height $ht -borderwidth $bd
428                if {$itk_option(-sashrelief) == "solid"} {
429                    $itk_component($sash) configure -background black
430                } else {
431                    $itk_component($sash) configure \
432                        -background $itk_option(-background)
433                }
434                pack $itk_component($sash) -pady $itk_option(-sashpadding)
435            }
436        }
437    } else {
438        set w [winfo pixels $itk_component(hull) $itk_option(-sashwidth)]
439        set bd [expr {$w/2}]
440        foreach pane $_panes {
441            set sash "${pane}sashridge"
442            if {[info exists itk_component($sash)]} {
443                $itk_component($sash) configure -width $w -borderwidth $bd
444                if {$itk_option(-sashrelief) == "solid"} {
445                    $itk_component($sash) configure -background black
446                } else {
447                    $itk_component($sash) configure \
448                        -background $itk_option(-background)
449                }
450                pack $itk_component($sash) -padx $itk_option(-sashpadding) \
451                    -side left
452            }
453        }
454    }
455}
456
457# ----------------------------------------------------------------------
458# CONFIGURATION OPTION: -sashrelief
459# ----------------------------------------------------------------------
460itcl::configbody Rappture::Panes::sashrelief {
461    $_dispatcher event -idle !sashes
462}
463
464# ----------------------------------------------------------------------
465# CONFIGURATION OPTION: -sashwidth
466# ----------------------------------------------------------------------
467itcl::configbody Rappture::Panes::sashwidth {
468    $_dispatcher event -idle !sashes
469}
470
471# ----------------------------------------------------------------------
472# CONFIGURATION OPTION: -sashpadding
473# ----------------------------------------------------------------------
474itcl::configbody Rappture::Panes::sashpadding {
475    $_dispatcher event -idle !sashes
476}
Note: See TracBrowser for help on using the repository browser.