File: panner.tcl

package info (click to toggle)
moomps 4.6-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 2,444 kB
  • ctags: 2,307
  • sloc: tcl: 34,882; sh: 167; makefile: 91
file content (334 lines) | stat: -rw-r--r-- 14,930 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
# $Id: panner.tcl,v 2.7 2002/05/30 17:11:45 jfontain Exp $


class panner {
    set (default,HandleSize) 8
}

proc panner::panner {this parentPath args} composite {[new frame $parentPath] $args} {
    set ($this,handles) {}
    set ($this,lastManagerSize) 0
    set ($this,handleSize) $(default,HandleSize)
    composite::complete $this
}

proc panner::~panner {this} {}

proc panner::options {this} {
    # force default orientation so that children are managed geometry wise
    # force panes number for initial configuration
    return [list\
        [list -handlesize $(default,HandleSize)]\
        [list -handleplacement 0.9 0.9]\
        [list -orient vertical]\
        [list -panes 2 3]\
    ]
}

proc panner::try {this option value} {
    set path $widget::($this,path)
    catch {$path configure $option $value}
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    for {set itemIndex 0} {$itemIndex<=$lastIndex} {incr itemIndex} {
        set frame $path.$itemIndex
        catch {$frame configure $option $value}
        if {($itemIndex%2)!=0} {                                                                                        ;# separator
            catch {$frame.separator configure $option $value}
            catch {$frame.handle configure $option $value}
        }
    }
}
proc panner::set-handlesize {this value} {
    # always convert to pixels for easier use and error checking and make sure value is even
    set ($this,handleSize) [expr {(([winfo pixels $widget::($this,path) $value]+1)/2)*2}]
    if {$composite::($this,complete)} {
        updateHandleSize $this                                                            ;# cannot update handles before they exist
    }
}

proc panner::set-orient {this value} {
    if {$composite::($this,complete)} {
        error {option -orient cannot be set dynamically}
    }
    if {([string first $value vertical]!=0)&&([string first $value horizontal]!=0)} {
        error "bad orientation value \"$value\": must be horizontal or vertical (or any abbreviation)"
    }
    if {[string match v* $composite::($this,-orient)]} {
        bind $widget::($this,path) <Configure> "panner::resize $this %h"
    } else {
        bind $widget::($this,path) <Configure> "panner::resize $this %w"
    }
}

proc panner::set-panes {this value} {
    if {$composite::($this,complete)} {
        error {option -panes cannot be set dynamically}
    }
    set path $widget::($this,path)
    if {[string match v* $composite::($this,-orient)]} {                                                     ;# vertical arrangement
        set vertical 1
        grid columnconfigure $path 0 -weight 1
        set sticky ew
        set cursor sb_v_double_arrow
    } else {                                                                                               ;# horizontal arrangement
        set vertical 0
        grid rowconfigure $path 0 -weight 1
        set sticky ns
        set cursor sb_h_double_arrow
    }
    set paneIndex 0
    set itemIndex 0
    while {1} {
        set frame [frame $path.$itemIndex]
        if {$vertical} {
            grid $frame -sticky nsew -row $itemIndex -column 0
            grid rowconfigure $path $itemIndex -weight 1000000                                 ;### should be 1, grid bug workaround
        } else {
            grid $frame -sticky nsew -column $itemIndex -row 0
            grid columnconfigure $path $itemIndex -weight 1000000                              ;### should be 1, grid bug workaround
        }
        incr paneIndex                                                                      ;# frame numbers start at 1 for the user
        set ($this,frame$paneIndex) $frame
        if {$paneIndex==$value} {
            break
        }
        incr itemIndex
        set frame [frame $path.$itemIndex]
        if {$vertical} {
            grid $frame -sticky $sticky -row $itemIndex -column 0
            grid rowconfigure $path $itemIndex -weight 1                           ;### should not be necessary, grid bug workaround
        } else {
            grid $frame -sticky $sticky -column $itemIndex -row 0
            grid columnconfigure $path $itemIndex -weight 1                        ;### should not be necessary, grid bug workaround
        }
        frame $frame.separator -borderwidth 1 -relief ridge
        if {$vertical} {
            $frame.separator configure -height 2
        } else {
            $frame.separator configure -width 2
        }
        place $frame.separator -anchor center -relx 0.5 -rely 0.5
        if {$vertical} {
            place $frame.separator -relwidth 1
        } else {
            place $frame.separator -relheight 1
        }
        button $frame.handle -borderwidth 1 -highlightthickness 0 -cursor $cursor -takefocus 0
        bind $frame.handle <ButtonPress-1> "panner::startMotion $this %W"
        if {$vertical} {
            bind $frame.handle <ButtonRelease-1> "panner::endMotion $this %W $itemIndex %Y"
            place $frame.handle -rely 0.5 -anchor center
        } else {
            bind $frame.handle <ButtonRelease-1> "panner::endMotion $this %W $itemIndex %X"
            place $frame.handle -relx 0.5 -anchor center
        }
        incr itemIndex
    }
    updateHandleSize $this
    set-handleplacement $this $composite::($this,-handleplacement)
}

proc panner::set-handleplacement {this value} {
    set path $widget::($this,path)
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    if {[string first $composite::($this,-orient) vertical]==0} {
        for {set itemIndex 1} {$itemIndex<=$lastIndex} {incr itemIndex 2} {
            place $path.$itemIndex.handle -relx $value
        }
    } else {
        for {set itemIndex 1} {$itemIndex<=$lastIndex} {incr itemIndex 2} {
            place $path.$itemIndex.handle -rely $value
        }
    }
}

proc panner::startMotion {this handle} {
    # grab is unnecessary as it is activated and released automatically when using a button
    set path $widget::($this,path)
    if {[string first $composite::($this,-orient) vertical]==0} {                                            ;# vertical arrangement
        bind $handle <Motion> "panner::verticalMotion $this %Y"
        set (line) [frame $path.line -background black -height 1 -width [winfo width $path]]
        set (minimum) [winfo rooty $path]
        set (maximum) [expr {$(minimum)+[winfo height $path]-1}]
    } else {                                                                                               ;# horizontal arrangement
        bind $handle <Motion> "panner::horizontalMotion $this %X"
        set (line) [frame $path.line -background black -width 1 -height [winfo height $path]]
        set (minimum) [winfo rootx $path]
        set (maximum) [expr {$(minimum)+[winfo width $path]-1}]
    }
}

proc panner::clip {coordinate} {
    if {$coordinate<$(minimum)} {
        return $(minimum)
    } elseif {$coordinate>$(maximum)} {
        return $(maximum)
    } else {
        return $coordinate
    }
}

proc panner::endMotion {this handle row rootCoordinate} {
    set visible [expr {[llength [place info $(line)]]>0}]
    destroy $(line)
    bind $handle <Motion> {}
    if {$visible} {                                                                                 ;# only if line has been visible
        split $this $row [expr {[clip $rootCoordinate]-$(minimum)}]
    }
    unset (line) (minimum) (maximum)
}

proc panner::verticalMotion {this yRoot} {
    place $(line) -y [expr {[clip $yRoot]-$(minimum)}]
}

proc panner::horizontalMotion {this xRoot} {
    place $(line) -x [expr {[clip $xRoot]-$(minimum)}]
}

proc panner::split {this handleIndex coordinate} {
    # coordinate is the separator axis one, handle index can be a row or column index depending on the orientation
    if {[string match v* $composite::($this,-orient)]} {                                                     ;# vertical arrangement
        set vertical 1
        set itemName row
        set sizeName height
    } else {                                                                                               ;# horizontal arrangement
        set vertical 0
        set itemName column
        set sizeName width
    }
    set path $widget::($this,path)
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    if {[grid propagate $path]} {                                                                          ;# first user interaction
        grid propagate $path 0                                    ;# stop propagation otherwise enclosing widget would resize larger
        for {set itemIndex 0} {$itemIndex<=$lastIndex} {incr itemIndex} {                 ;# initialize minimum sizes for all frames
            grid ${itemName}configure $path $itemIndex -minsize [winfo $sizeName $path.$itemIndex]
        }
    }
    set separatorsSize 0
    set framesSize 0
    set beforeIndex [expr {$handleIndex-1}]
    set afterIndex [expr {$handleIndex+1}]
    if {$vertical} {
        set lastCoordinate [lindex [grid bbox $path 0 $handleIndex] 1]
        set masterSize [lindex [grid bbox $path] 3]
        set frameStart [lindex [grid bbox $path 0 $beforeIndex] 1]
        set box [grid bbox $path 0 $afterIndex]
        set frameEnd [expr {[lindex $box 1]+[lindex $box 3]}]
    } else {
        set lastCoordinate [lindex [grid bbox $path $handleIndex 0] 0]
        set masterSize [lindex [grid bbox $path] 2]
        set frameStart [lindex [grid bbox $path $beforeIndex 0] 0]
        set box [grid bbox $path $afterIndex 0]
        set frameEnd [expr {[lindex $box 0]+[lindex $box 2]}]
    }
    if {$coordinate>$lastCoordinate} {                                                                ;# grow frame before separator
        incr coordinate -[expr {$($this,handleSize)/2}]                              ;# set coordinate to the resized frame boundary
        for {set itemIndex $handleIndex} {$itemIndex<=$lastIndex} {incr itemIndex} {
            if {($itemIndex%2)==0} {
                incr framesSize [grid ${itemName}configure $path $itemIndex -minsize]
            } else {
                incr separatorsSize $($this,handleSize)
            }
        }
        set remaining [expr {$masterSize-$coordinate-$separatorsSize}]
        if {$remaining<0} {
            set size [expr {$masterSize-$frameStart-$separatorsSize}]
            set remaining 0
        } else {
            set size [expr {$coordinate-$frameStart}]
        }
        grid ${itemName}configure $path $beforeIndex -minsize $size
        for {set itemIndex $lastIndex} {$itemIndex>=$afterIndex} {incr itemIndex -2} { ;# push other frames from nearest to farthest
            if {$remaining>[grid ${itemName}configure $path $itemIndex -minsize]} {
                incr remaining -[grid ${itemName}configure $path $itemIndex -minsize]
            } elseif {$remaining>0} {
                grid ${itemName}configure $path $itemIndex -minsize $remaining
                set remaining 0
            } else {
                grid ${itemName}configure $path $itemIndex -minsize 0
            }
        }
    } elseif {$coordinate<$lastCoordinate} {                                                           ;# grow frame after separator
        incr coordinate [expr {$($this,handleSize)/2}]                               ;# set coordinate to the resized frame boundary
        for {set itemIndex $handleIndex} {$itemIndex>=0} {incr itemIndex -1} {
            if {($itemIndex%2)==0} {
                incr framesSize [grid ${itemName}configure $path $itemIndex -minsize]
            } else {
                incr separatorsSize $($this,handleSize)
            }
        }
        set remaining [expr {$coordinate-$separatorsSize}]
        if {$remaining<0} {
            set size [expr {$frameEnd-$separatorsSize}]                                            ;# leave one pixel for each frame
            set remaining 0
        } else {
            set size [expr {$frameEnd-$coordinate}]
        }
        grid ${itemName}configure $path $afterIndex -minsize $size
        for {set itemIndex 0} {$itemIndex<=$beforeIndex} {incr itemIndex 2} {          ;# push other frames from nearest to farthest
            if {$remaining>[grid ${itemName}configure $path $itemIndex -minsize]} {
                incr remaining -[grid ${itemName}configure $path $itemIndex -minsize]
            } elseif {$remaining>0} {
                grid ${itemName}configure $path $itemIndex -minsize $remaining
                set remaining 0
            } else {
                grid ${itemName}configure $path $itemIndex -minsize 0
            }
        }
    }
}

proc panner::updateHandleSize {this} {
    set size $($this,handleSize)
    set path $widget::($this,path)
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    if {[string match v* $composite::($this,-orient)]} {
        for {set row 1} {$row<$lastIndex} {incr row 2} {
            set frame $path.$row
            place $frame.handle -width $size -height $size
            $frame configure -height $size
            grid rowconfigure $path $row -minsize $size                            ;### should not be necessary, grid bug workaround
        }
    } else {
        for {set column 1} {$column<$lastIndex} {incr column 2} {
            set frame $path.$column
            place $frame.handle -width $size -height $size
            $frame configure -width $size
            grid columnconfigure $path $column -minsize $size                      ;### should not be necessary, grid bug workaround
        }
    }
}

proc panner::resize {this size} {
    if {$size==$($this,lastManagerSize)} {
        return
    }
    set ($this,lastManagerSize) $size
    set path $widget::($this,path)
    if {[grid propagate $path]} {
        return               ;# if there has not been any user interaction yet, let the grid manager handle the configuration change
    }
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    set lastSize 0
    set newSize $size
    if {[string match v* $composite::($this,-orient)]} {
        set itemName row
    } else {
        set itemName column
    }
    for {set itemIndex 0} {$itemIndex<=$lastIndex} {incr itemIndex} {
        if {($itemIndex%2)==0} {
            incr lastSize [grid ${itemName}configure $path $itemIndex -minsize]
        } else {
            incr newSize -$($this,handleSize)
        }
    }
    set ratio [expr {double($newSize)/$lastSize}]
    for {set itemIndex 0} {$itemIndex<$lastIndex} {incr itemIndex 2} {                      ;# set frame sizes except for last frame
        set size [expr {round($ratio*[grid ${itemName}configure $path $itemIndex -minsize])}]
        grid ${itemName}configure $path $itemIndex -minsize $size
        incr newSize -$size
    }
    grid ${itemName}configure $path $itemIndex -minsize $newSize            ;# last frame size is remainder to avoid rounding errors
}