Context Navigation

panes.tcl @ 5044

Last change on this file since 5044 was 5044, checked in by mmc, 9 years ago

Fixed the Panes widget to handle fractional sizes better. Instead of
adjusting the fractions internally after each change, it keeps the
requested fractions, but normalizes them before the layout. This keeps
the behavior of the widget consistent, and keeps sizes closer to what
was requested for each pane. Also, fixed the -orientation option so
that the widget can switch back and forth between orientations.

File size: 19.7 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: Panes - creates a series of adjustable panes
3	#
4	# This is a simple paned window with an adjustable sash.
5	# the same quantity, but for various ranges of input values.
6	# It also manages the controls to select and visualize the data.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2015 HUBzero Foundation, LLC
10	#
11	# See the file "license.terms" for information on usage and
12	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13	# ======================================================================
14	package require Itk
15
16	option add *Panes.width 3i widgetDefault
17	option add *Panes.height 3i widgetDefault
18	option add *Panes.sashRelief sunken widgetDefault
19	option add *Panes.sashWidth 2 widgetDefault
20	option add *Panes.sashPadding 4 widgetDefault
21	option add *Panes.orientation vertical widgetDefault
22
23	itcl::class Rappture::Panes {
24	inherit itk::Widget
25
26	itk_option define -sashrelief sashRelief SashRelief ""
27	itk_option define -sashwidth sashWidth SashWidth 0
28	itk_option define -sashpadding sashPadding SashPadding 0
29	itk_option define -orientation orientation Orientation ""
30
31	constructor {args} { # defined below }
32
33	public method insert {pos args}
34	public method pane {pos}
35	public method visibility {pos args}
36	public method fraction {pos args}
37	public method hilite {state sash}
38	public method size {}
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 _reqfrac 0.0 ;# requested fraction size of each pane
51	private variable _dragfrom 0 ;# starting coordinate of drag operation
52	private variable _dragfrac 0 ;# limit on fraction of drag operation
53	}
54
55	itk::usual Panes {
56	keep -background -cursor -sashwidth -sashrelief
57	}
58
59	# ----------------------------------------------------------------------
60	# CONSTRUCTOR
61	# ----------------------------------------------------------------------
62	itcl::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 _reqfrac 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	# ----------------------------------------------------------------------
95	itcl::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	ignore -cursor
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 -relief -sashrelief sashRelief SashRelief
119	ignore -borderwidth
120	}
121	if {$itk_option(-orientation) eq "vertical"} {
122	pack $itk_component(${sash}ridge) -fill x
123	$itk_component($sash) configure -cursor sb_v_double_arrow
124	$itk_component(${sash}ridge) configure -cursor sb_v_double_arrow
125	} else {
126	pack $itk_component(${sash}ridge) -fill y -side left
127	$itk_component($sash) configure -cursor sb_h_double_arrow
128	$itk_component(${sash}ridge) configure -cursor sb_h_double_arrow
129	}
130	foreach comp [list $sash ${sash}ridge] {
131	bind $itk_component($comp) <ButtonPress-1> \
132	[itcl::code $this _grab $pname %X %Y]
133	bind $itk_component($comp) <B1-Motion> \
134	[itcl::code $this _drag $pname %X %Y]
135	bind $itk_component($comp) <ButtonRelease-1> \
136	[itcl::code $this _drop $pname %X %Y]
137	}
138
139
140	itk_component add $pname {
141	frame $itk_interior.$pname
142	}
143	set _panes [linsert $_panes $pos $pname]
144	set _visibility [linsert $_visibility $pos 1]
145	set _reqfrac [linsert $_reqfrac $pos $params(-fraction)]
146
147	# fix sash characteristics
148	$_dispatcher event -idle !sashes
149
150	# make sure we fix up the layout at some point
151	$_dispatcher event -idle !layout
152
153	return $itk_component($pname)
154	}
155
156	# ----------------------------------------------------------------------
157	# USAGE: pane <pos>
158	#
159	# Returns the frame representing the pane at position <pos>.
160	# ----------------------------------------------------------------------
161	itcl::body Rappture::Panes::pane {pos} {
162	set pname [lindex $_panes $pos]
163	if {[info exists itk_component($pname)]} {
164	return $itk_component($pname)
165	}
166	return ""
167	}
168
169	# ----------------------------------------------------------------------
170	# USAGE: visibility <pos> ?<newval>? ?<pos> <newval> ...?
171	#
172	# Clients use this to get/set the visibility of the pane at position
173	# <pos>. Can also be used to set the visibility for multiple panes
174	# if multiple <pos>/<newval> pairs are specified in the same command.
175	# ----------------------------------------------------------------------
176	itcl::body Rappture::Panes::visibility {pos args} {
177	if {[llength $args] == 0} {
178	return [lindex $_visibility $pos]
179	}
180	if {[llength $args] % 2 == 0} {
181	error "wrong # args: should be \"visibility pos ?val pos val ...?\""
182	}
183
184	set args [linsert $args 0 $pos]
185	foreach {pos newval} $args {
186	if {![string is boolean -strict $newval]} {
187	error "bad value \"$newval\": should be boolean"
188	}
189	if {$pos eq "end" \|\| ($pos >= 0 && $pos < [llength $_visibility])} {
190	set _visibility [lreplace $_visibility $pos $pos [expr {$newval}]]
191	$_dispatcher event -idle !layout
192	} else {
193	error "bad index \"$pos\": out of range"
194	}
195	}
196	}
197
198	# ----------------------------------------------------------------------
199	# USAGE: fraction <pos> ?<newval>? ?<pos> <newval> ...?
200	#
201	# Clients use this to get/set the fraction of real estate associated
202	# with the pane at position <pos>. Can also be used to set the
203	# fractions for multiple panes if multiple <pos>/<newval> pairs
204	# are specified in the same command.
205	# ----------------------------------------------------------------------
206	itcl::body Rappture::Panes::fraction {pos args} {
207	if {[llength $args] == 0} {
208	return [lindex $_reqfrac $pos]
209	}
210	if {[llength $args] % 2 == 0} {
211	error "wrong # args: should be \"fraction pos ?val pos val ...?\""
212	}
213
214	set args [linsert $args 0 $pos]
215	foreach {pos newval} $args {
216	if {![string is double -strict $newval]} {
217	error "bad value \"$newval\": should be fraction 0-1"
218	}
219	if {$pos eq "end" \|\| ($pos >= 0 && $pos < [llength $_reqfrac])} {
220	set _reqfrac [lreplace $_reqfrac $pos $pos $newval]
221	$_dispatcher event -idle !layout
222	} else {
223	error "bad index \"$pos\": out of range"
224	}
225	}
226	}
227
228	# ----------------------------------------------------------------------
229	# USAGE: hilite <state> <sash>
230	#
231	# Invoked automatically whenever the user touches a sash. Highlights
232	# the sash by changing its size or relief.
233	# ----------------------------------------------------------------------
234	itcl::body Rappture::Panes::hilite {state sash} {
235	switch -- $itk_option(-sashrelief) {
236	flat {
237	if {$state} {
238	$itk_component(${sash}ridge) configure -background black
239	} else {
240	$itk_component(${sash}ridge) configure -background $itk_option(-background)
241	}
242	}
243	sunken {
244	if {$state} {
245	$itk_component(${sash}ridge) configure -relief raised
246	} else {
247	$itk_component(${sash}ridge) configure -relief sunken
248	}
249	}
250	raised {
251	if {$state} {
252	$itk_component(${sash}ridge) configure -relief sunken
253	} else {
254	$itk_component(${sash}ridge) configure -relief raised
255	}
256	}
257	solid {
258	if {$state} {
259	$itk_component($sash) configure -background black
260	} else {
261	$itk_component($sash) configure \
262	-background $itk_option(-background)
263	}
264	}
265	}
266	}
267
268	# ----------------------------------------------------------------------
269	# USAGE: size
270	#
271	# Returns the number of panes in this widget. That makes it easier
272	# to index the various panes, since indices run from 0 to size-1.
273	# ----------------------------------------------------------------------
274	itcl::body Rappture::Panes::size {} {
275	return [llength $_panes]
276	}
277
278	# ----------------------------------------------------------------------
279	# USAGE: _grab <pane> <X> <Y>
280	#
281	# Invoked automatically when the user clicks on a sash, to initiate
282	# movement.
283	# ----------------------------------------------------------------------
284	itcl::body Rappture::Panes::_grab {pname X Y} {
285	set pos [lsearch $_panes $pname]
286	if {$pos < 0} return
287	set frac0 [lindex $_reqfrac [expr {$pos-1}]]
288	set frac1 [lindex $_reqfrac $pos]
289	set _dragfrac [expr {$frac0+$frac1}]
290
291	if {$itk_option(-orientation) eq "vertical"} {
292	set _dragfrom $Y
293	} else {
294	set _dragfrom $X
295	}
296	}
297
298	# ----------------------------------------------------------------------
299	# USAGE: _drag <pane> <X> <Y>
300	#
301	# Invoked automatically as the user drags a sash, to resize the panes.
302	# ----------------------------------------------------------------------
303	itcl::body Rappture::Panes::_drag {pname X Y} {
304	set pos [lsearch $_panes $pname]
305	if {$pos < 0} return
306	set frac [lindex $_reqfrac $pos]
307
308	if {$itk_option(-orientation) eq "vertical"} {
309	set delY [expr {$_dragfrom-$Y}]
310	set Ymax [winfo height $itk_component(hull)]
311	set delta [expr {double($delY)/$Ymax}]
312	set frac [expr {$frac + $delta}]
313	set _dragfrom $Y
314	} else {
315	set delX [expr {$_dragfrom-$X}]
316	set Xmax [winfo width $itk_component(hull)]
317	set delta [expr {double($delX)/$Xmax}]
318	set frac [expr {$frac + $delta}]
319	set _dragfrom $X
320	}
321	if {$delta == 0.0} {
322	return
323	}
324
325	# set limits so the pane can't get too large or too small
326	if {$frac < 0.05} {
327	set frac 0.05
328	}
329	if {$frac > $_dragfrac-0.05} {
330	set frac [expr {$_dragfrac-0.05}]
331	}
332
333	# replace the fractions for this pane and the one before it
334	set prevfrac [expr {$_dragfrac-$frac}]
335	set _reqfrac [lreplace $_reqfrac [expr {$pos-1}] $pos $prevfrac $frac]
336
337	# normalize all fractions and fix the layout
338	_fixLayout
339
340	return $frac
341	}
342
343	# ----------------------------------------------------------------------
344	# USAGE: _drop <pane> <X> <Y>
345	#
346	# Invoked automatically as the user drops a sash, to resize the panes.
347	# ----------------------------------------------------------------------
348	itcl::body Rappture::Panes::_drop {pname X Y} {
349	set frac [_drag $pname $X $Y]
350	}
351
352	# ----------------------------------------------------------------------
353	# USAGE: _fixLayout ?<eventArgs>...?
354	#
355	# Used internally to update the layout of panes whenever a new pane
356	# is added or a sash is moved.
357	# ----------------------------------------------------------------------
358	itcl::body Rappture::Panes::_fixLayout {args} {
359	# normalize the fractions for all panes to they add to 1.0
360	set total 0
361	foreach f $_reqfrac v $_visibility {
362	if {$v && $f > 0} {
363	set total [expr {$total + $f}]
364	}
365	}
366	if {$total == 0.0} { set total 1 }
367
368	set normfrac ""
369	foreach f $_reqfrac v $_visibility {
370	if {$v} {
371	lappend normfrac [expr {double($f)/$total}]
372	} else {
373	lappend normfrac [expr {double($f)/$total}]
374	}
375	}
376
377	# note that sash padding can be a single number or different on each side
378	if {[llength $itk_option(-sashpadding)] == 1} {
379	set pad [expr {2*$itk_option(-sashpadding)}]
380	} else {
381	set pad [expr [join $itk_option(-sashpadding) +]]
382	}
383
384	if {$itk_option(-orientation) eq "vertical"} {
385	set h [winfo height $itk_component(hull)]
386	set sh [expr {$itk_option(-sashwidth) + $pad}]
387
388	set plist ""
389	set flist ""
390	foreach p $_panes f $normfrac v $_visibility {
391	set sash ${p}sash
392	if {$v} {
393	# this pane is visible -- make room for it
394	lappend plist $p
395	lappend flist $f
396	if {[info exists itk_component($sash)]} {
397	set h [expr {$h - $sh}]
398	}
399	} else {
400	# this pane is not visible -- remove sash
401	if {[info exists itk_component($sash)]} {
402	place forget $itk_component($sash)
403	}
404	place forget $itk_component($p)
405	}
406	}
407
408	# lay out the various panes
409	set y 0
410	foreach p $plist f $flist {
411	set sash ${p}sash
412	if {[info exists itk_component($sash)]} {
413	place $itk_component($sash) -y $y -relx 0.5 -anchor n \
414	-relwidth 1.0 -height $sh
415	set y [expr {$y + $sh}]
416	}
417
418	set ph [expr {$h*$f}]
419	place $itk_component($p) -y $y -relx 0.5 -anchor n \
420	-relwidth 1.0 -height $ph
421	set y [expr {$y + $ph}]
422	}
423	} else {
424	set w [winfo width $itk_component(hull)]
425	set sw [expr {$itk_option(-sashwidth) + $pad}]
426
427	set plist ""
428	set flist ""
429	foreach p $_panes f $normfrac v $_visibility {
430	set sash ${p}sash
431	if {$v} {
432	# this pane is visible -- make room for it
433	lappend plist $p
434	lappend flist $f
435	if {[info exists itk_component($sash)]} {
436	set w [expr {$w - $sw}]
437	}
438	} else {
439	# this pane is not visible -- remove sash
440	if {[info exists itk_component($sash)]} {
441	place forget $itk_component($sash)
442	}
443	place forget $itk_component($p)
444	}
445	}
446
447	# lay out the various panes
448	set x 0
449	foreach p $plist f $flist {
450	set sash ${p}sash
451	if {[info exists itk_component($sash)]} {
452	place $itk_component($sash) -x $x -rely 0.5 -anchor w \
453	-relheight 1.0 -width $sw
454	set x [expr {$x + $sw}]
455	}
456
457	set pw [expr {$w*$f}]
458	place $itk_component($p) -x $x -rely 0.5 -anchor w \
459	-relheight 1.0 -width $pw
460	set x [expr {$x + $pw}]
461	}
462	}
463	}
464
465	# ----------------------------------------------------------------------
466	# USAGE: _fixSashes
467	#
468	# Used internally to fix the appearance of sashes whenever a new
469	# sash appears or the controlling configuration options change.
470	# ----------------------------------------------------------------------
471	itcl::body Rappture::Panes::_fixSashes {args} {
472	if {$itk_option(-orientation) eq "vertical"} {
473	set ht [winfo pixels $itk_component(hull) $itk_option(-sashwidth)]
474	set bd [expr {$ht/2}]
475	foreach pane $_panes {
476	set sash "${pane}sashridge"
477	if {[info exists itk_component($sash)]} {
478	$itk_component($sash) configure -height $ht \
479	-borderwidth $bd -relief $itk_option(-sashrelief)
480	pack $itk_component($sash) -pady $itk_option(-sashpadding) \
481	-side top
482	}
483	}
484	} else {
485	set w [winfo pixels $itk_component(hull) $itk_option(-sashwidth)]
486	set bd [expr {$w/2}]
487	foreach pane $_panes {
488	set sash "${pane}sashridge"
489	if {[info exists itk_component($sash)]} {
490	$itk_component($sash) configure -width $w \
491	-borderwidth $bd -relief $itk_option(-sashrelief)
492	pack $itk_component($sash) -padx $itk_option(-sashpadding) \
493	-side left
494	}
495	}
496	}
497	}
498
499	# ----------------------------------------------------------------------
500	# CONFIGURATION OPTION: -sashrelief
501	# ----------------------------------------------------------------------
502	itcl::configbody Rappture::Panes::sashrelief {
503	$_dispatcher event -idle !sashes
504	}
505
506	# ----------------------------------------------------------------------
507	# CONFIGURATION OPTION: -sashwidth
508	# ----------------------------------------------------------------------
509	itcl::configbody Rappture::Panes::sashwidth {
510	$_dispatcher event -idle !sashes
511	}
512
513	# ----------------------------------------------------------------------
514	# CONFIGURATION OPTION: -sashpadding
515	# ----------------------------------------------------------------------
516	itcl::configbody Rappture::Panes::sashpadding {
517	set count 0
518	foreach val $itk_option(-sashpadding) {
519	if {![string is integer -strict $val]} {
520	error "bad padding value \"$val\": should be integer"
521	}
522	incr count
523	}
524	if {$count < 1 \|\| $count > 2} {
525	error "bad padding value \"$itk_option(-sashpadding)\": should be \"#\" or \"# #\""
526	}
527	$_dispatcher event -idle !sashes
528	}
529
530	# ----------------------------------------------------------------------
531	# CONFIGURATION OPTION: -orientation
532	# ----------------------------------------------------------------------
533	itcl::configbody Rappture::Panes::orientation {
534	foreach pname $_panes {
535	set sash "${pname}sash"
536	if {$itk_option(-orientation) eq "vertical"} {
537	place $itk_component($pname) -x 0 -relx 0.5 -relwidth 1 \
538	-y 0 -rely 0 -relheight 0
539
540	if {[info exists itk_component($sash)]} {
541	place $itk_component($sash) -x 0 -relx 0.5 -relwidth 1 \
542	-y 0 -rely 0 -relheight 0
543	$itk_component($sash) configure \
544	-cursor sb_v_double_arrow
545
546	pack $itk_component(${sash}ridge) -fill x -side top
547	$itk_component(${sash}ridge) configure \
548	-cursor sb_v_double_arrow
549	}
550	} else {
551	place $itk_component($pname) -y 0 -rely 0.5 -relheight 1 \
552	-x 0 -relx 0 -relwidth 0
553
554	if {[info exists itk_component($sash)]} {
555	place $itk_component($sash) -y 0 -rely 0.5 -relheight 1 \
556	-x 0 -relx 0 -relwidth 0
557	$itk_component($sash) configure \
558	-cursor sb_h_double_arrow
559
560	pack $itk_component(${sash}ridge) -fill y -side left
561	$itk_component(${sash}ridge) configure \
562	-cursor sb_h_double_arrow
563	}
564	}
565	}
566
567	# fix sash characteristics
568	$_dispatcher event -idle !sashes
569
570	# make sure we fix up the layout at some point
571	$_dispatcher event -idle !layout
572	}

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: