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

Last change on this file since 1536 was 1373, checked in by gah, 15 years ago

First pass at changes to visualization widgets.

nanovisview.tcl use png icons.
visviewer.tcl change to sidebar layout
molvisviewer.tcl use png icons, fixed for sidebar layout.
heightmapviewer.tcl use png icons, fixed for sidebar layout.
flowvisviewer.tcl use png icons, fixed for sidebar layout.

resultviewer.tcl recognize flow data
field.tcl recognize unirect3d mesh.
field3dresult.tcl load FlowvisViewer? component description.
panes.tcl added horizontal panes. Need cursor fix. Must specify

correct cursor from options.

unirect2d.tcl added "axisorder" tag to specify order of field data.

Changed name to Unirect2d from UniRect2d.

unirect3d.tcl added "axisorder" tag to specify order of field data.

Right now, this is a test platform for me for flow
visualizations.
File size: 14.5 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 height $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 width $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.