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

Last change on this file since 4503 was 3177, checked in by mmc, 8 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.