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

Last change on this file since 4709 was 3330, checked in by gah, 12 years ago

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