source: trunk/instant/filmstrip.tcl @ 1728

Last change on this file since 1728 was 1728, checked in by mmc, 14 years ago

Initial version of the "instant rappture" gui builder. To run this,
just say "irappture" or "irappture -tool path/to/tool.xml". It will
bring up an editor that lets you specify inputs/outputs and preview
the tool.

Made two fixes along the way to the scroller, so that it handles
automatic scrollbars better, and to the grab stack, so that it avoids
pushing the same window on the grab stack twice. Both of these fixes
solved problems in iRappture, and they'll probably fix strange behaviors
in the main rappture as well.

File size: 16.4 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: filmstrip - palette of objects arranged horizontally
3#
4#  This widget is similar to the "film strip" view in windows.  It
5#  shows a horizontal arrangement of objects and lets you click on
6#  each one to initiate an action.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2010  Purdue Research Foundation
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# ======================================================================
14package require Itk
15
16option add *Filmstrip.padding 8 widgetDefault
17option add *Filmstrip.background #999999 widgetDefault
18option add *Filmstrip.troughColor #666666 widgetDefault
19option add *Filmstrip.activeBackground #d9d9d9 widgetDefault
20option add *Filmstrip.titleBackground #888888 widgetDefault
21option add *Filmstrip.titleForeground white widgetDefault
22option add *Filmstrip.font {helvetica -12} widgetDefault
23
24itcl::class Rappture::Filmstrip {
25    inherit itk::Widget Rappture::Dragdrop
26
27    itk_option define -orient orient Orient "horizontal"
28    itk_option define -length length Length 0
29    itk_option define -padding padding Padding 0
30    itk_option define -titlebackground titleBackground Background ""
31    itk_option define -titleforeground titleForeground Foreground ""
32    itk_option define -activebackground activeBackground Foreground ""
33    itk_option define -dragdropcommand dragDropCommand DragDropCommand ""
34
35    constructor {args} { # defined below }
36    public method add {name args}
37
38    protected method _hilite {state name}
39    protected method _fixLayout {args}
40    protected method _scroll {args}
41
42    # define these for drag-n-drop support of items
43    protected method dd_get_source {widget x y}
44    protected method dd_scan_target {x y data}
45    protected method dd_finalize {option args}
46
47    private variable _dispatcher ""  ;# dispatcher for !events
48    private variable _items ""       ;# list of item names
49    private variable _data           ;# maps item name => title, image, etc.
50}
51
52itk::usual Filmstrip {
53    keep -cursor -font -foreground -background
54}
55
56# ----------------------------------------------------------------------
57# CONSTRUCTOR
58# ----------------------------------------------------------------------
59itcl::body Rappture::Filmstrip::constructor {args} {
60    component hull configure -height 100
61    pack propagate $itk_component(hull) off
62
63    # create a dispatcher for events
64    Rappture::dispatcher _dispatcher
65    $_dispatcher register !layout
66    $_dispatcher dispatch $this !layout [itcl::code $this _fixLayout]
67
68    itk_component add strip {
69        canvas $itk_interior.strip -highlightthickness 0
70    } {
71        usual
72        keep -borderwidth -relief
73        ignore -highlightthickness -highlightbackground -highlightcolor
74    }
75    pack $itk_component(strip) -expand yes -fill both
76
77    # this widget exports nodes via drag-n-drop
78    dragdrop source $itk_component(strip)
79
80    itk_component add sbar {
81        scrollbar $itk_interior.sbar
82    }
83
84    eval itk_initialize $args
85}
86
87# ----------------------------------------------------------------------
88# USAGE: add <name> ?-title <string>? ?-image <handle>?
89#
90# Clients use this to add new items onto the film strip.  Each item
91# has an internal <name> that refers to it, along with an icon and
92# a title.
93# ----------------------------------------------------------------------
94itcl::body Rappture::Filmstrip::add {name args} {
95    Rappture::getopts args params {
96        value -title ""
97        value -image ""
98    }
99    if {[llength $args] > 0} {
100        error "wrong # args: should be \"add name ?-option val -option val...?\""
101    }
102
103    set i [lsearch $_items $name]
104    if {$i >= 0} {
105        error "name \"$name\" already exists"
106    }
107    lappend _items $name
108    set _data($name-title) $params(-title)
109    set _data($name-image) $params(-image)
110    set _data($name-pos) 0
111
112    if {$itk_option(-orient) == "horizontal"} {
113        set anchor w
114        set whichsize wd
115    } else {
116        set anchor n
117        set whichsize ht
118    }
119
120    $itk_component(strip) create rectangle 0 0 0 0 \
121        -outline "" -fill "" -tags [list $name:all $name:bg]
122
123    set htmax 0
124    set sizemax 0
125    if {"" != $params(-image)} {
126        $itk_component(strip) create image 0 0 -anchor $anchor \
127            -image $params(-image) -tags [list $name:all $name:image]
128        foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:image] break
129        set wd [expr {$x1-$x0}]
130        set ht [expr {$y1-$y0}]
131        set htmax $ht
132        set sizemax [set $whichsize]
133    }
134    if {"" != $params(-title)} {
135        $itk_component(strip) create placard 0 0 -anchor s \
136            -foreground $itk_option(-titleforeground) \
137            -background $itk_option(-titlebackground) \
138            -text $params(-title) -tags [list $name:all $name:title]
139puts "created placard for $params(-title)"
140        foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
141        set wd [expr {$x1-$x0}]
142        set ht [expr {$y1-$y0}]
143        set htmax [expr {$htmax+$ht}]
144        set s [set $whichsize]
145        if {$s > $sizemax} {set sizemax $s}
146    }
147
148    $itk_component(strip) bind $name:all <Enter> \
149        [itcl::code $this _hilite on $name]
150    $itk_component(strip) bind $name:all <Leave> \
151        [itcl::code $this _hilite off $name]
152
153    # make sure we fix up the layout at some point
154    $_dispatcher event -idle !layout
155}
156
157# ----------------------------------------------------------------------
158# USAGE: _hilite <state> <name>
159#
160# Called automatically when the mouse pointer enters/leaves an icon
161# on the film strip.  Changes the background to highlight the option.
162# ----------------------------------------------------------------------
163itcl::body Rappture::Filmstrip::_hilite {state name} {
164    if {$state} {
165        set bg $itk_option(-activebackground)
166    } else {
167        set bg ""
168    }
169    $itk_component(strip) itemconfigure $name:bg -fill $bg
170}
171
172# ----------------------------------------------------------------------
173# USAGE: _fixLayout ?<eventArgs>...?
174#
175# Used internally to realign all items vertically after new items
176# have been added to the strip.
177# ----------------------------------------------------------------------
178itcl::body Rappture::Filmstrip::_fixLayout {args} {
179    if {$itk_option(-orient) == "horizontal"} {
180        # figure out the max height for overall strip
181        set xpos $itk_option(-padding)
182        set hmax 0
183        foreach name $_items {
184            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:image] break
185            set h1 [expr {$y1-$y0}]
186            set w [expr {$x1-$x0}]
187            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
188            set h2 [expr {$y1-$y0}]
189            set h [expr {$h1+$h2}]
190            if {$h > $hmax} { set hmax $h }
191
192            set _data($name-pos) $xpos
193            $itk_component(strip) coords $name:image $xpos 0
194            set xpos [expr {$xpos + $w + $itk_option(-padding)}]
195        }
196        set hmax [expr {$hmax+2*$itk_option(-padding)}]
197
198        set sbarh [winfo reqheight $itk_component(sbar)]
199        component hull configure -height [expr {$hmax+$sbarh}]
200
201        foreach name $_items {
202            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:image] break
203            set y0 $itk_option(-padding)
204            set y1 $hmax
205            set w [expr {$x1-$x0}]
206            $itk_component(strip) coords $name:bg $x0 $y0 $x1 $y1
207
208            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
209            set titleh [expr {$y1-$y0}]
210            set x [expr {$_data($name-pos) + $w/2}]
211            set y [expr {$hmax-$itk_option(-padding)}]
212            $itk_component(strip) coords $name:title $x $y
213
214            foreach {x y} [$itk_component(strip) coords $name:image] break
215            set y [expr {($hmax-$titleh)/2}]
216            $itk_component(strip) coords $name:image $x $y
217        }
218
219        # fix up the scrolling region to include all of these items
220        foreach {x0 y0 x1 y1} [$itk_component(strip) bbox all] break
221        set x1 [expr {$x1+$itk_option(-padding)}]
222        $itk_component(strip) configure -scrollregion [list 0 0 $x1 $y1]
223
224        set size [winfo pixels $itk_component(hull) $itk_option(-length)]
225        if {$size == 0} {
226            component hull configure -width [expr {$x1+$itk_option(-padding)}]
227        }
228
229    } else {
230        # figure out the max width for overall strip
231        set ypos $itk_option(-padding)
232        set wmax 0
233        foreach name $_items {
234            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:image] break
235            set w [expr {$x1-$x0}]
236            set ht [expr {$y1-$y0}]
237            if {$w > $wmax} { set wmax $w }
238
239            if {"" != [$itk_component(strip) find withtag $name:title]} {
240                foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
241                set w [expr {$x1-$x0}]
242                set ht [expr {$ht+$y1-$y0}]
243                if {$w > $wmax} { set wmax $w }
244            }
245
246            set _data($name-pos) $ypos
247            $itk_component(strip) coords $name:image 0 $ypos
248            set ypos [expr {$ypos + $ht + $itk_option(-padding)}]
249        }
250        set wmax [expr {$wmax+2*$itk_option(-padding)}]
251
252        set sbarw [winfo reqwidth $itk_component(sbar)]
253        component hull configure -width [expr {$wmax+$sbarw}]
254
255        foreach name $_items {
256            foreach {x y} [$itk_component(strip) coords $name:image] break
257            set x [expr {$wmax/2}]
258            $itk_component(strip) coords $name:image $x $y
259
260            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:image] break
261            set imght [expr {$y1-$y0}]
262
263            if {"" != [$itk_component(strip) find withtag $name:title]} {
264                foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
265                set titleh [expr {$y1-$y0}]
266                set x [expr {$wmax/2}]
267                set y [expr {$_data($name-pos) + $imght + $titleh}]
268                $itk_component(strip) coords $name:title $x $y
269            } else {
270                set titleh 0
271            }
272
273            set x0 $itk_option(-padding)
274            set x1 $wmax
275            set y0 $_data($name-pos)
276            set y1 [expr {$y0 + $imght + $titleh}]
277            $itk_component(strip) coords $name:bg $x0 $y0 $x1 $y1
278        }
279
280        # fix up the scrolling region to include all of these items
281        foreach {x0 y0 x1 y1} [$itk_component(strip) bbox all] break
282        set x1 [expr {$x1+$itk_option(-padding)}]
283        $itk_component(strip) configure -scrollregion [list 0 0 $x1 $y1]
284
285        set size [winfo pixels $itk_component(hull) $itk_option(-length)]
286        if {$size == 0} {
287            component hull configure -height [expr {$y1+$itk_option(-padding)}]
288        }
289    }
290}
291
292# ----------------------------------------------------------------------
293# USAGE: _scroll <arg> <arg>...
294#
295# Used internally to handle the automatic scrollbar.  If a scrollbar
296# is needed, then it is packed into view.  Otherwise, it disappears.
297# ----------------------------------------------------------------------
298itcl::body Rappture::Filmstrip::_scroll {args} {
299    if {$itk_option(-orient) == "horizontal"} {
300        set view [$itk_component(strip) xview]
301        set side "bottom"
302        set fill "x"
303    } else {
304        set view [$itk_component(strip) yview]
305        set side "right"
306        set fill "y"
307    }
308
309    if {$view != {0 1}} {
310        pack $itk_component(sbar) -before $itk_component(strip) \
311            -side $side -fill $fill
312    } else {
313        pack forget $itk_component(sbar)
314    }
315    eval $itk_component(sbar) set $args
316}
317
318# ----------------------------------------------------------------------
319# USAGE: dd_get_source <widget> <x> <y>
320#
321# Looks at the given <widget> and <x>,<y> coordinate to figure out
322# what data value the source is exporting.  Returns a string that
323# identifies the type of the data.  This string is passed along to
324# targets via the dd_scan_target method.  If the target may check
325# the source type and reject the data.
326# ----------------------------------------------------------------------
327itcl::body Rappture::Filmstrip::dd_get_source {widget x y} {
328    if {[string length $itk_option(-dragdropcommand)] == 0} {
329        return ""
330    }
331
332    # translate the screen x,y to the canvas x,y (may be scrolled down)
333    set x [$itk_component(strip) canvasx $x]
334    set y [$itk_component(strip) canvasy $y]
335
336    foreach id [$itk_component(strip) find overlapping $x $y $x $y] {
337        foreach tag [$itk_component(strip) gettags $id] {
338            # search for a tag like XXX:all for item XXX
339            if {[regexp {^([a-zA-Z0-9]+):all$} $tag match name]} {
340                # invoke the dragdrop command with the item name
341                # and see if it returns anything
342                if {[catch {uplevel #0 $itk_option(-dragdropcommand) $name} result]} {
343                    bgerror $result
344                } elseif {[string length $result] > 0} {
345                    return $result
346                }
347            }
348        }
349    }
350    return ""
351}
352
353# ----------------------------------------------------------------------
354# USAGE: dd_scan_target <x> <y> <data>
355#
356# Looks at the given <x>,<y> coordinate and checks to see if the
357# dragdrop <data> can be accepted at that point.  Returns 1 if so,
358# and 0 if the data is rejected.
359# ----------------------------------------------------------------------
360itcl::body Rappture::Filmstrip::dd_scan_target {x y data} {
361}
362
363# ----------------------------------------------------------------------
364# USAGE: dd_finalize drop -op start|end -from <w> -to <w> \
365#                           -x <x> -y <y> -data <data>
366# USAGE: dd_finalize cancel
367#
368# Handles the end of a drag and drop operation.  The operation can be
369# completed with a successful drop of data, or cancelled.
370# ----------------------------------------------------------------------
371itcl::body Rappture::Filmstrip::dd_finalize {option args} {
372}
373
374# ----------------------------------------------------------------------
375# CONFIGURATION OPTION: -orient
376# ----------------------------------------------------------------------
377itcl::configbody Rappture::Filmstrip::orient {
378    switch -- $itk_option(-orient) {
379        horizontal {
380            $itk_component(strip) configure \
381                -xscrollcommand [itcl::code $this _scroll]
382            $itk_component(sbar) configure -orient horizontal \
383                -command [list $itk_component(strip) xview]
384            pack $itk_component(strip) -side top
385
386            set size [winfo pixels $itk_component(hull) $itk_option(-length)]
387            if {$size > 0} {
388                component hull configure -width $size
389            }
390        }
391        vertical {
392            $itk_component(strip) configure \
393                -yscrollcommand [itcl::code $this _scroll]
394            $itk_component(sbar) configure -orient vertical \
395                -command [list $itk_component(strip) yview]
396            pack $itk_component(strip) -side left
397
398            set size [winfo pixels $itk_component(hull) $itk_option(-length)]
399            if {$size > 0} {
400                component hull configure -height $size
401            }
402        }
403        default {
404            error "bad value \"$itk_option(-orient)\": should be horizontal, vertical"
405        }
406    }
407    $_dispatcher event -idle !layout
408}
409
410# ----------------------------------------------------------------------
411# CONFIGURATION OPTION: -length
412# ----------------------------------------------------------------------
413itcl::configbody Rappture::Filmstrip::length {
414    set size [winfo pixels $itk_component(hull) $itk_option(-length)]
415    if {$size > 0} {
416        if {$itk_option(-orient) == "horizontal"} {
417            component hull configure -width $size
418        } else {
419            component hull configure -height $size
420        }
421    } else {
422        $_dispatcher event -idle !layout
423    }
424}
425
426# ----------------------------------------------------------------------
427# CONFIGURATION OPTION: -titlebackground, -titleforeground
428# ----------------------------------------------------------------------
429itcl::configbody Rappture::Filmstrip::titlebackground {
430    foreach name $_items {
431        $itk_component(strip) itemconfigure $name:title \
432            -background $itk_option(-titlebackground)
433    }
434}
435itcl::configbody Rappture::Filmstrip::titleforeground {
436    foreach name $_items {
437        $itk_component(strip) itemconfigure $name:title \
438            -foreground $itk_option(-titleforeground)
439    }
440}
Note: See TracBrowser for help on using the repository browser.