source: trunk/gui/scripts/balloon.tcl @ 46

Last change on this file since 46 was 46, checked in by mmc, 16 years ago
  • Added a new Balloon panel, and used it to configure axis properties in the XyResult? widget. You can now click on the axis to set min/max limits and change linear/log scale.
  • Added "Find" and "Select All" to the TextResult? widget.
File size: 14.4 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: Balloon - toplevel popup window, like a cartoon balloon
3#
4#  This widget is used as a container for pop-up panels in Rappture.
5#  If shape extensions are supported, then the window is drawn as
6#  a cartoon balloon.  Otherwise, it is a raised panel, with a little
7#  line connecting it to the widget that brought it up.  When active,
8#  the panel has a global grab and focus, so the user must interact
9#  with it or dismiss it.
10# ======================================================================
11#  AUTHOR:  Michael McLennan, Purdue University
12#  Copyright (c) 2004-2005
13#  Purdue Research Foundation, West Lafayette, IN
14# ======================================================================
15package require Itk
16
17namespace eval Rappture { # forward declaration }
18
19option add *Balloon.stemLength 16 widgetDefault
20
21itcl::class Rappture::Balloon {
22    inherit itk::Toplevel
23
24    itk_option define -stemlength stemLength StemLength 20
25
26    constructor {args} { # defined below }
27
28    public method activate {where placement}
29    public method deactivate {}
30
31    protected method _createStems {}
32
33    protected variable _stems   ;# windows for cartoon balloon stems
34    protected variable _masks   ;# masks for cartoon balloon stems
35    protected variable _fills   ;# lines for cartoon balloon stems
36
37    public proc outside {widget x y}
38
39    bind RapptureBalloon <ButtonPress> \
40        {if {[Rappture::Balloon::outside %W %X %Y]} {%W deactivate}}
41}
42
43itk::usual Balloon {
44}
45
46# ----------------------------------------------------------------------
47# CONSTRUCTOR
48# ----------------------------------------------------------------------
49itcl::body Rappture::Balloon::constructor {args} {
50    wm overrideredirect $itk_component(hull) yes
51    wm withdraw $itk_component(hull)
52    component hull configure -borderwidth 1 -relief solid
53
54    itk_component add inner {
55        frame $itk_interior.inner -borderwidth 2 -relief raised
56    }
57    pack $itk_component(inner) -expand yes -fill both
58
59    # add bindings to release the grab
60    set btags [bindtags $itk_component(hull)]
61    bindtags $itk_component(hull) [linsert $btags 1 RapptureBalloon]
62
63    eval itk_initialize $args
64
65    _createStems
66}
67
68# ----------------------------------------------------------------------
69# USAGE: activate <where> <placement>
70#
71# Clients use this to pop up this balloon panel pointing to the
72# <where> location, which should be a widget name or @X,Y.  The
73# <placement> indicates whether the panel should be left, right,
74# above, or below the <where> coordinate.
75# ----------------------------------------------------------------------
76itcl::body Rappture::Balloon::activate {where placement} {
77    if {![info exists _stems($placement)]} {
78        error "bad placement \"$placement\": should be [join [lsort [array names _stems]] {, }]"
79    }
80    set s $_stems($placement)
81    set sw [image width $_fills($placement)]
82    set sh [image height $_fills($placement)]
83    set p $itk_component(hull)
84
85    if {[winfo exists $where]} {
86        set x [expr {[winfo rootx $where]+[winfo width $where]/2}]
87        set y [expr {[winfo rooty $where]+[winfo height $where]/2}]
88        switch -- $placement {
89            left { set x [expr {[winfo rootx $where]+5}] }
90            right { set x [expr {[winfo rootx $where]+[winfo width $where]-5}] }
91            above { set y [expr {[winfo rooty $where]+5}] }
92            below { set y [expr {[winfo rooty $where]+[winfo height $where]-5}] }
93        }
94    } elseif {[regexp {^@([0-9]+),([0-9]+)$} $where match x y]} {
95        # got x and y
96    } else {
97        error "bad location \"$where\": should be widget or @x,y"
98    }
99
100    # if the panel is already up, take it down
101    deactivate
102
103    switch -- $placement {
104        left {
105            set sx [expr {$x-$sw+3}]
106            set sy [expr {$y-$sh/2}]
107            set px [expr {$sx-[winfo reqwidth $p]+3}]
108            set py [expr {$y-[winfo reqheight $p]/2}]
109        }
110        right {
111            set sx $x
112            set sy [expr {$y-$sh/2}]
113            set px [expr {$x+$sw-3}]
114            set py [expr {$y-[winfo reqheight $p]/2}]
115        }
116        above {
117            set sx [expr {$x-$sw/2}]
118            set sy [expr {$y-$sh+3}]
119            set px [expr {$x-[winfo reqwidth $p]/2}]
120            set py [expr {$sy-[winfo reqheight $p]+3}]
121        }
122        below {
123            set sx [expr {$x-$sw/2}]
124            set sy $y
125            set px [expr {$x-[winfo reqwidth $p]/2}]
126            set py [expr {$y+$sh-3}]
127        }
128    }
129    shape set $s -bound photo $_masks($placement)
130
131    wm geometry $p +$px+$py
132    wm deiconify $p
133    raise $p
134
135    wm geometry $s +$sx+$sy
136    wm deiconify $s
137    raise $s
138
139    # grab the mouse pointer
140    update
141    while {[catch {grab set -global $itk_component(hull)}]} {
142        after 100
143    }
144    focus $itk_component(hull)
145}
146
147# ----------------------------------------------------------------------
148# USAGE: deactivate
149#
150# Clients use this to take down the balloon panel if it is on screen.
151# ----------------------------------------------------------------------
152itcl::body Rappture::Balloon::deactivate {} {
153    grab release $itk_component(hull)
154
155    wm withdraw $itk_component(hull)
156    foreach dir {left right above below} {
157        wm withdraw $_stems($dir)
158    }
159}
160
161# ----------------------------------------------------------------------
162# USAGE: _createStems
163#
164# Used internally to create the stems that connect a balloon panel
165# to its anchor point, in all four possible directions:  left, right,
166# above, and below.
167# ----------------------------------------------------------------------
168itcl::body Rappture::Balloon::_createStems {} {
169    # destroy any existing stems
170    foreach dir [array names _stems] {
171        destroy $_stems($dir)
172        unset _stems($dir)
173    }
174    foreach dir [array names _masks] {
175        image delete $_masks($dir)
176        unset _masks($dir)
177    }
178    foreach dir [array names _fills] {
179        image delete $_fills($dir)
180        unset _fills($dir)
181    }
182
183    if {[catch {package require Shape}] == 0} {
184        #
185        # We have the Shape extension.  Use it to create nice
186        # looking (triangle-shaped) stems.
187        #
188        set s $itk_option(-stemlength)
189        foreach dir {left right above below} {
190            switch -- $dir {
191                left - right {
192                    set sw [expr {$s+2}]
193                    set sh $s
194                }
195                above - below {
196                    set sw $s
197                    set sh [expr {$s+2}]
198                }
199            }
200
201            set _stems($dir) [toplevel $itk_interior.s$dir -borderwidth 0]
202            label $_stems($dir).l \
203                -width $sw -height $sh -borderwidth 0
204            pack $_stems($dir).l -expand yes -fill both
205
206            wm withdraw $_stems($dir)
207            wm overrideredirect $_stems($dir) yes
208
209            #
210            # Draw the triangle part of the stem, with a black outline
211            # and light/dark highlights:
212            #
213            #     --------  ---       LEFT STEM
214            #    |..##    |  ^ 
215            #    |  ..##  |  |        . = light color
216            #    |    ..##|  | s      @ = dark color
217            #    |    @@##|  |        # = black
218            #    |  @@##  |  |
219            #    |@@##    |  v
220            #     --------  ---
221            #    |<------>|
222            #        s+2
223            #
224            set _masks($dir) [image create photo -width $sw -height $sh]
225            set _fills($dir) [image create photo -width $sw -height $sh]
226
227            set bg $itk_option(-background)
228            set light [Rappture::color::brightness $bg 0.4]
229            set dark [Rappture::color::brightness $bg -0.4]
230
231            $_fills($dir) put $bg -to 0 0 $sw $sh
232
233            switch -- $dir {
234              left {
235                set i 0
236                for {set j 0} {$j < $s/2} {incr j} {
237                    set ybtm [expr {$s-$j-1}]
238                    $_fills($dir) put $dark \
239                        -to $i [expr {$ybtm-1}] [expr {$i+2}] [expr {$ybtm+1}]
240                    $_fills($dir) put black \
241                        -to [expr {$i+2}] $ybtm [expr {$i+4}] [expr {$ybtm+1}]
242
243                    set ytop $j
244                    set ytoffs [expr {($j == $s/2-1) ? 1 : 2}]
245                    $_fills($dir) put $light \
246                        -to $i $ytop [expr {$i+2}] [expr {$ytop+$ytoffs}]
247                    $_fills($dir) put black \
248                        -to [expr {$i+2}] $ytop [expr {$i+4}] [expr {$ytop+1}]
249                    incr i 2
250                }
251                $_stems($dir).l configure -image $_fills($dir)
252
253                $_masks($dir) put black -to 0 0 $sw $sh
254                set i 0
255                for {set j 0} {$j < $s/2} {incr j} {
256                    for {set k [expr {$i+4}]} {$k < $s+2} {incr k} {
257                        $_masks($dir) transparency set $k $j yes
258                        $_masks($dir) transparency set $k [expr {$s-$j-1}] yes
259                    }
260                    incr i 2
261                }
262              }
263              right {
264                set i $sw
265                for {set j 0} {$j < $s/2} {incr j} {
266                    set ybtm [expr {$s-$j-1}]
267                    $_fills($dir) put $dark \
268                        -to [expr {$i-2}] [expr {$ybtm-1}] $i [expr {$ybtm+1}]
269                    $_fills($dir) put black \
270                        -to [expr {$i-4}] $ybtm [expr {$i-2}] [expr {$ybtm+1}]
271
272                    set ytop $j
273                    set ytoffs [expr {($j == $s/2-1) ? 1 : 2}]
274                    $_fills($dir) put $light \
275                        -to [expr {$i-2}] $ytop $i [expr {$ytop+$ytoffs}]
276                    $_fills($dir) put black \
277                        -to [expr {$i-4}] $ytop [expr {$i-2}] [expr {$ytop+1}]
278                    incr i -2
279                }
280                $_stems($dir).l configure -image $_fills($dir)
281
282                $_masks($dir) put black -to 0 0 $sw $sh
283                set i $sw
284                for {set j 0} {$j < $s/2} {incr j} {
285                    for {set k 0} {$k < $i-4} {incr k} {
286                        $_masks($dir) transparency set $k $j yes
287                        $_masks($dir) transparency set $k [expr {$s-$j-1}] yes
288                    }
289                    incr i -2
290                }
291              }
292              above {
293                set i 0
294                for {set j 0} {$j < $s/2} {incr j} {
295                    set xrhs [expr {$s-$j-1}]
296                    $_fills($dir) put $dark \
297                        -to [expr {$xrhs-1}] $i [expr {$xrhs+1}] [expr {$i+2}]
298                    $_fills($dir) put black \
299                        -to $xrhs [expr {$i+2}] [expr {$xrhs+1}] [expr {$i+4}]
300
301                    set xlhs $j
302                    set xloffs [expr {($j == $s/2-1) ? 1 : 2}]
303                    $_fills($dir) put $light \
304                        -to $xlhs $i [expr {$xlhs+$xloffs}] [expr {$i+2}]
305                    $_fills($dir) put black \
306                        -to $xlhs [expr {$i+2}] [expr {$xlhs+1}] [expr {$i+4}]
307                    incr i 2
308                }
309                $_stems($dir).l configure -image $_fills($dir)
310
311                $_masks($dir) put black -to 0 0 $sw $sh
312                set i 0
313                for {set j 0} {$j < $s/2} {incr j} {
314                    for {set k [expr {$i+4}]} {$k < $s+2} {incr k} {
315                        $_masks($dir) transparency set $j $k yes
316                        $_masks($dir) transparency set [expr {$s-$j-1}] $k yes
317                    }
318                    incr i 2
319                }
320              }
321              below {
322                set i $sh
323                for {set j 0} {$j < $s/2} {incr j} {
324                    set xrhs [expr {$s-$j-1}]
325                    $_fills($dir) put $dark \
326                        -to [expr {$xrhs-1}] [expr {$i-2}] [expr {$xrhs+1}] $i
327                    $_fills($dir) put black \
328                        -to $xrhs [expr {$i-4}] [expr {$xrhs+1}] [expr {$i-2}]
329
330                    set xlhs $j
331                    set xloffs [expr {($j == $s/2-1) ? 1 : 2}]
332                    $_fills($dir) put $light \
333                        -to $xlhs [expr {$i-2}] [expr {$xlhs+$xloffs}] $i
334                    $_fills($dir) put black \
335                        -to $xlhs [expr {$i-4}] [expr {$xlhs+1}] [expr {$i-2}]
336                    incr i -2
337                }
338                $_stems($dir).l configure -image $_fills($dir)
339
340                $_masks($dir) put black -to 0 0 $sw $sh
341                set i $sh
342                for {set j 0} {$j < $s/2} {incr j} {
343                    for {set k 0} {$k < $i-4} {incr k} {
344                        $_masks($dir) transparency set $j $k yes
345                        $_masks($dir) transparency set [expr {$s-$j-1}] $k yes
346                    }
347                    incr i -2
348                }
349              }
350            }
351        }
352    } else {
353        #
354        # No shape extension.  Do the best we can by creating a
355        # black line for all directions.
356        #
357        foreach {dir w h} [list \
358            left   $itk_option(-stemlength) 3 \
359            right  $itk_option(-stemlength) 3 \
360            above  3 $itk_option(-stemlength) \
361            below  3 $itk_option(-stemlength) \
362        ] {
363            set _stems($dir) [toplevel $itk_interior.s$dir \
364                -width $w -height $h \
365                -borderwidth 1 -relief solid -background black]
366            wm withdraw $_stems($dir)
367            wm overrideredirect $_stems($dir) yes
368        }
369    }
370}
371
372# ----------------------------------------------------------------------
373# USAGE: outside <widget> <x> <y>
374#
375# Used internally to see if the click point <x>,<y> is outside of
376# this widget.  If so, the widget usually releases is grab and
377# deactivates.
378# ----------------------------------------------------------------------
379itcl::body Rappture::Balloon::outside {widget x y} {
380    return [expr {$x < [winfo rootx $widget]
381             || $x > [winfo rootx $widget]+[winfo width $widget]
382             || $y < [winfo rooty $widget]
383             || $y > [winfo rooty $widget]+[winfo height $widget]}]
384}
385
386# ----------------------------------------------------------------------
387# CONFIGURATION OPTION: -stemlength
388#
389# Used internally to create the stems that connect a balloon panel
390# to its anchor point, in all four possible directions:  left, right,
391# above, and below.
392# ----------------------------------------------------------------------
393itcl::configbody Rappture::Balloon::stemlength {
394    if {$itk_option(-stemlength) % 2 != 0} {
395        error "stem length should be an even number of pixels"
396    }
397}
Note: See TracBrowser for help on using the repository browser.