source: trunk/builder/scripts/filmstrip.tcl @ 2081

Last change on this file since 2081 was 2081, checked in by mmc, 13 years ago

Part 2 of the major reorganization to group all of the rappture utilties
under a single rappture command. Builds better now. Still need to fix
up the builder to work with the objects in a different location now.

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]
139        foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
140        set wd [expr {$x1-$x0}]
141        set ht [expr {$y1-$y0}]
142        set htmax [expr {$htmax+$ht}]
143        set s [set $whichsize]
144        if {$s > $sizemax} {set sizemax $s}
145    }
146
147    $itk_component(strip) bind $name:all <Enter> \
148        [itcl::code $this _hilite on $name]
149    $itk_component(strip) bind $name:all <Leave> \
150        [itcl::code $this _hilite off $name]
151
152    # make sure we fix up the layout at some point
153    $_dispatcher event -idle !layout
154}
155
156# ----------------------------------------------------------------------
157# USAGE: _hilite <state> <name>
158#
159# Called automatically when the mouse pointer enters/leaves an icon
160# on the film strip.  Changes the background to highlight the option.
161# ----------------------------------------------------------------------
162itcl::body Rappture::Filmstrip::_hilite {state name} {
163    if {$state} {
164        set bg $itk_option(-activebackground)
165    } else {
166        set bg ""
167    }
168    $itk_component(strip) itemconfigure $name:bg -fill $bg
169}
170
171# ----------------------------------------------------------------------
172# USAGE: _fixLayout ?<eventArgs>...?
173#
174# Used internally to realign all items vertically after new items
175# have been added to the strip.
176# ----------------------------------------------------------------------
177itcl::body Rappture::Filmstrip::_fixLayout {args} {
178    if {$itk_option(-orient) == "horizontal"} {
179        # figure out the max height for overall strip
180        set xpos $itk_option(-padding)
181        set hmax 0
182        foreach name $_items {
183            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:image] break
184            set h1 [expr {$y1-$y0}]
185            set w [expr {$x1-$x0}]
186            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
187            set h2 [expr {$y1-$y0}]
188            set h [expr {$h1+$h2}]
189            if {$h > $hmax} { set hmax $h }
190
191            set _data($name-pos) $xpos
192            $itk_component(strip) coords $name:image $xpos 0
193            set xpos [expr {$xpos + $w + $itk_option(-padding)}]
194        }
195        set hmax [expr {$hmax+2*$itk_option(-padding)}]
196
197        set sbarh [winfo reqheight $itk_component(sbar)]
198        component hull configure -height [expr {$hmax+$sbarh}]
199
200        foreach name $_items {
201            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:image] break
202            set y0 $itk_option(-padding)
203            set y1 $hmax
204            set w [expr {$x1-$x0}]
205            $itk_component(strip) coords $name:bg $x0 $y0 $x1 $y1
206
207            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
208            set titleh [expr {$y1-$y0}]
209            set x [expr {$_data($name-pos) + $w/2}]
210            set y [expr {$hmax-$itk_option(-padding)}]
211            $itk_component(strip) coords $name:title $x $y
212
213            foreach {x y} [$itk_component(strip) coords $name:image] break
214            set y [expr {($hmax-$titleh)/2}]
215            $itk_component(strip) coords $name:image $x $y
216        }
217
218        # fix up the scrolling region to include all of these items
219        foreach {x0 y0 x1 y1} [$itk_component(strip) bbox all] break
220        set x1 [expr {$x1+$itk_option(-padding)}]
221        $itk_component(strip) configure -scrollregion [list 0 0 $x1 $y1]
222
223        set size [winfo pixels $itk_component(hull) $itk_option(-length)]
224        if {$size == 0} {
225            component hull configure -width [expr {$x1+$itk_option(-padding)}]
226        }
227
228    } else {
229        # figure out the max width for overall strip
230        set ypos $itk_option(-padding)
231        set wmax 0
232        foreach name $_items {
233            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:image] break
234            set w [expr {$x1-$x0}]
235            set ht [expr {$y1-$y0}]
236            if {$w > $wmax} { set wmax $w }
237
238            if {"" != [$itk_component(strip) find withtag $name:title]} {
239                foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
240                set w [expr {$x1-$x0}]
241                set ht [expr {$ht+$y1-$y0}]
242                if {$w > $wmax} { set wmax $w }
243            }
244
245            set _data($name-pos) $ypos
246            $itk_component(strip) coords $name:image 0 $ypos
247            set ypos [expr {$ypos + $ht + $itk_option(-padding)}]
248        }
249        set wmax [expr {$wmax+2*$itk_option(-padding)}]
250
251        set sbarw [winfo reqwidth $itk_component(sbar)]
252        component hull configure -width [expr {$wmax+$sbarw}]
253
254        foreach name $_items {
255            foreach {x y} [$itk_component(strip) coords $name:image] break
256            set x [expr {$wmax/2}]
257            $itk_component(strip) coords $name:image $x $y
258
259            foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:image] break
260            set imght [expr {$y1-$y0}]
261
262            if {"" != [$itk_component(strip) find withtag $name:title]} {
263                foreach {x0 y0 x1 y1} [$itk_component(strip) bbox $name:title] break
264                set titleh [expr {$y1-$y0}]
265                set x [expr {$wmax/2}]
266                set y [expr {$_data($name-pos) + $imght + $titleh}]
267                $itk_component(strip) coords $name:title $x $y
268            } else {
269                set titleh 0
270            }
271
272            set x0 $itk_option(-padding)
273            set x1 $wmax
274            set y0 $_data($name-pos)
275            set y1 [expr {$y0 + $imght + $titleh}]
276            $itk_component(strip) coords $name:bg $x0 $y0 $x1 $y1
277        }
278
279        # fix up the scrolling region to include all of these items
280        foreach {x0 y0 x1 y1} [$itk_component(strip) bbox all] break
281        set x1 [expr {$x1+$itk_option(-padding)}]
282        $itk_component(strip) configure -scrollregion [list 0 0 $x1 $y1]
283
284        set size [winfo pixels $itk_component(hull) $itk_option(-length)]
285        if {$size == 0} {
286            component hull configure -height [expr {$y1+$itk_option(-padding)}]
287        }
288    }
289}
290
291# ----------------------------------------------------------------------
292# USAGE: _scroll <arg> <arg>...
293#
294# Used internally to handle the automatic scrollbar.  If a scrollbar
295# is needed, then it is packed into view.  Otherwise, it disappears.
296# ----------------------------------------------------------------------
297itcl::body Rappture::Filmstrip::_scroll {args} {
298    if {$itk_option(-orient) == "horizontal"} {
299        set view [$itk_component(strip) xview]
300        set side "bottom"
301        set fill "x"
302    } else {
303        set view [$itk_component(strip) yview]
304        set side "right"
305        set fill "y"
306    }
307
308    if {$view != {0 1}} {
309        pack $itk_component(sbar) -before $itk_component(strip) \
310            -side $side -fill $fill
311    } else {
312        pack forget $itk_component(sbar)
313    }
314    eval $itk_component(sbar) set $args
315}
316
317# ----------------------------------------------------------------------
318# USAGE: dd_get_source <widget> <x> <y>
319#
320# Looks at the given <widget> and <x>,<y> coordinate to figure out
321# what data value the source is exporting.  Returns a string that
322# identifies the type of the data.  This string is passed along to
323# targets via the dd_scan_target method.  If the target may check
324# the source type and reject the data.
325# ----------------------------------------------------------------------
326itcl::body Rappture::Filmstrip::dd_get_source {widget x y} {
327    if {[string length $itk_option(-dragdropcommand)] == 0} {
328        return ""
329    }
330
331    # translate the screen x,y to the canvas x,y (may be scrolled down)
332    set x [$itk_component(strip) canvasx $x]
333    set y [$itk_component(strip) canvasy $y]
334
335    foreach id [$itk_component(strip) find overlapping $x $y $x $y] {
336        foreach tag [$itk_component(strip) gettags $id] {
337            # search for a tag like XXX:all for item XXX
338            if {[regexp {^([a-zA-Z0-9]+):all$} $tag match name]} {
339                # invoke the dragdrop command with the item name
340                # and see if it returns anything
341                if {[catch {uplevel #0 $itk_option(-dragdropcommand) $name} result]} {
342                    bgerror $result
343                } elseif {[string length $result] > 0} {
344                    return $result
345                }
346            }
347        }
348    }
349    return ""
350}
351
352# ----------------------------------------------------------------------
353# USAGE: dd_scan_target <x> <y> <data>
354#
355# Looks at the given <x>,<y> coordinate and checks to see if the
356# dragdrop <data> can be accepted at that point.  Returns 1 if so,
357# and 0 if the data is rejected.
358# ----------------------------------------------------------------------
359itcl::body Rappture::Filmstrip::dd_scan_target {x y data} {
360}
361
362# ----------------------------------------------------------------------
363# USAGE: dd_finalize drop -op start|end -from <w> -to <w> \
364#                           -x <x> -y <y> -data <data>
365# USAGE: dd_finalize cancel
366#
367# Handles the end of a drag and drop operation.  The operation can be
368# completed with a successful drop of data, or cancelled.
369# ----------------------------------------------------------------------
370itcl::body Rappture::Filmstrip::dd_finalize {option args} {
371}
372
373# ----------------------------------------------------------------------
374# CONFIGURATION OPTION: -orient
375# ----------------------------------------------------------------------
376itcl::configbody Rappture::Filmstrip::orient {
377    switch -- $itk_option(-orient) {
378        horizontal {
379            $itk_component(strip) configure \
380                -xscrollcommand [itcl::code $this _scroll]
381            $itk_component(sbar) configure -orient horizontal \
382                -command [list $itk_component(strip) xview]
383            pack $itk_component(strip) -side top
384
385            set size [winfo pixels $itk_component(hull) $itk_option(-length)]
386            if {$size > 0} {
387                component hull configure -width $size
388            }
389        }
390        vertical {
391            $itk_component(strip) configure \
392                -yscrollcommand [itcl::code $this _scroll]
393            $itk_component(sbar) configure -orient vertical \
394                -command [list $itk_component(strip) yview]
395            pack $itk_component(strip) -side left
396
397            set size [winfo pixels $itk_component(hull) $itk_option(-length)]
398            if {$size > 0} {
399                component hull configure -height $size
400            }
401        }
402        default {
403            error "bad value \"$itk_option(-orient)\": should be horizontal, vertical"
404        }
405    }
406    $_dispatcher event -idle !layout
407}
408
409# ----------------------------------------------------------------------
410# CONFIGURATION OPTION: -length
411# ----------------------------------------------------------------------
412itcl::configbody Rappture::Filmstrip::length {
413    set size [winfo pixels $itk_component(hull) $itk_option(-length)]
414    if {$size > 0} {
415        if {$itk_option(-orient) == "horizontal"} {
416            component hull configure -width $size
417        } else {
418            component hull configure -height $size
419        }
420    } else {
421        $_dispatcher event -idle !layout
422    }
423}
424
425# ----------------------------------------------------------------------
426# CONFIGURATION OPTION: -titlebackground, -titleforeground
427# ----------------------------------------------------------------------
428itcl::configbody Rappture::Filmstrip::titlebackground {
429    foreach name $_items {
430        $itk_component(strip) itemconfigure $name:title \
431            -background $itk_option(-titlebackground)
432    }
433}
434itcl::configbody Rappture::Filmstrip::titleforeground {
435    foreach name $_items {
436        $itk_component(strip) itemconfigure $name:title \
437            -foreground $itk_option(-titleforeground)
438    }
439}
Note: See TracBrowser for help on using the repository browser.