source: trunk/builder/scripts/filmstrip.tcl

Last change on this file was 3177, checked in by mmc, 12 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.

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-2012  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# ======================================================================
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        set x1 0
281        set y1 0
282        foreach {x0 y0 x1 y1} [$itk_component(strip) bbox all] break
283        set x1 [expr {$x1+$itk_option(-padding)}]
284        $itk_component(strip) configure -scrollregion [list 0 0 $x1 $y1]
285
286        set size [winfo pixels $itk_component(hull) $itk_option(-length)]
287        if {$size == 0} {
288            component hull configure -height [expr {$y1+$itk_option(-padding)}]
289        }
290    }
291}
292
293# ----------------------------------------------------------------------
294# USAGE: _scroll <arg> <arg>...
295#
296# Used internally to handle the automatic scrollbar.  If a scrollbar
297# is needed, then it is packed into view.  Otherwise, it disappears.
298# ----------------------------------------------------------------------
299itcl::body Rappture::Filmstrip::_scroll {args} {
300    if {$itk_option(-orient) == "horizontal"} {
301        set view [$itk_component(strip) xview]
302        set side "bottom"
303        set fill "x"
304    } else {
305        set view [$itk_component(strip) yview]
306        set side "right"
307        set fill "y"
308    }
309
310    if {$view != {0 1}} {
311        pack $itk_component(sbar) -before $itk_component(strip) \
312            -side $side -fill $fill
313    } else {
314        pack forget $itk_component(sbar)
315    }
316    eval $itk_component(sbar) set $args
317}
318
319# ----------------------------------------------------------------------
320# USAGE: dd_get_source <widget> <x> <y>
321#
322# Looks at the given <widget> and <x>,<y> coordinate to figure out
323# what data value the source is exporting.  Returns a string that
324# identifies the type of the data.  This string is passed along to
325# targets via the dd_scan_target method.  If the target may check
326# the source type and reject the data.
327# ----------------------------------------------------------------------
328itcl::body Rappture::Filmstrip::dd_get_source {widget x y} {
329    if {[string length $itk_option(-dragdropcommand)] == 0} {
330        return ""
331    }
332
333    # translate the screen x,y to the canvas x,y (may be scrolled down)
334    set x [$itk_component(strip) canvasx $x]
335    set y [$itk_component(strip) canvasy $y]
336
337    foreach id [$itk_component(strip) find overlapping $x $y $x $y] {
338        foreach tag [$itk_component(strip) gettags $id] {
339            # search for a tag like XXX:all for item XXX
340            if {[regexp {^([a-zA-Z0-9]+):all$} $tag match name]} {
341                # invoke the dragdrop command with the item name
342                # and see if it returns anything
343                if {[catch {uplevel #0 $itk_option(-dragdropcommand) $name} result]} {
344                    bgerror $result
345                } elseif {[string length $result] > 0} {
346                    return $result
347                }
348            }
349        }
350    }
351    return ""
352}
353
354# ----------------------------------------------------------------------
355# USAGE: dd_scan_target <x> <y> <data>
356#
357# Looks at the given <x>,<y> coordinate and checks to see if the
358# dragdrop <data> can be accepted at that point.  Returns 1 if so,
359# and 0 if the data is rejected.
360# ----------------------------------------------------------------------
361itcl::body Rappture::Filmstrip::dd_scan_target {x y data} {
362}
363
364# ----------------------------------------------------------------------
365# USAGE: dd_finalize drop -op start|end -from <w> -to <w> \
366#                           -x <x> -y <y> -data <data>
367# USAGE: dd_finalize cancel
368#
369# Handles the end of a drag and drop operation.  The operation can be
370# completed with a successful drop of data, or cancelled.
371# ----------------------------------------------------------------------
372itcl::body Rappture::Filmstrip::dd_finalize {option args} {
373}
374
375# ----------------------------------------------------------------------
376# CONFIGURATION OPTION: -orient
377# ----------------------------------------------------------------------
378itcl::configbody Rappture::Filmstrip::orient {
379    switch -- $itk_option(-orient) {
380        horizontal {
381            $itk_component(strip) configure \
382                -xscrollcommand [itcl::code $this _scroll]
383            $itk_component(sbar) configure -orient horizontal \
384                -command [list $itk_component(strip) xview]
385            pack $itk_component(strip) -side top
386
387            set size [winfo pixels $itk_component(hull) $itk_option(-length)]
388            if {$size > 0} {
389                component hull configure -width $size
390            }
391        }
392        vertical {
393            $itk_component(strip) configure \
394                -yscrollcommand [itcl::code $this _scroll]
395            $itk_component(sbar) configure -orient vertical \
396                -command [list $itk_component(strip) yview]
397            pack $itk_component(strip) -side left
398
399            set size [winfo pixels $itk_component(hull) $itk_option(-length)]
400            if {$size > 0} {
401                component hull configure -height $size
402            }
403        }
404        default {
405            error "bad value \"$itk_option(-orient)\": should be horizontal, vertical"
406        }
407    }
408    $_dispatcher event -idle !layout
409}
410
411# ----------------------------------------------------------------------
412# CONFIGURATION OPTION: -length
413# ----------------------------------------------------------------------
414itcl::configbody Rappture::Filmstrip::length {
415    set size [winfo pixels $itk_component(hull) $itk_option(-length)]
416    if {$size > 0} {
417        if {$itk_option(-orient) == "horizontal"} {
418            component hull configure -width $size
419        } else {
420            component hull configure -height $size
421        }
422    } else {
423        $_dispatcher event -idle !layout
424    }
425}
426
427# ----------------------------------------------------------------------
428# CONFIGURATION OPTION: -titlebackground, -titleforeground
429# ----------------------------------------------------------------------
430itcl::configbody Rappture::Filmstrip::titlebackground {
431    foreach name $_items {
432        $itk_component(strip) itemconfigure $name:title \
433            -background $itk_option(-titlebackground)
434    }
435}
436itcl::configbody Rappture::Filmstrip::titleforeground {
437    foreach name $_items {
438        $itk_component(strip) itemconfigure $name:title \
439            -foreground $itk_option(-titleforeground)
440    }
441}
Note: See TracBrowser for help on using the repository browser.