source: trunk/gui/scripts/imageresult.tcl @ 1549

Last change on this file since 1549 was 1549, checked in by gah, 15 years ago

fixed improper transfer function for volumes

File size: 16.3 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: imageresult - picture image in a ResultSet
3#
4#  This widget displays an image found in the output of a Rappture
5#  tool run.  Use the "add" and "delete" methods to control the images
6#  showing in the widget.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005  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
15package require BLT
16package require Img
17
18option add *ImageResult.width 3i widgetDefault
19option add *ImageResult.height 3i widgetDefault
20option add *ImageResult.controlBackground gray widgetDefault
21option add *ImageResult.font \
22    -*-helvetica-medium-r-normal-*-12-* widgetDefault
23
24itcl::class Rappture::ImageResult {
25    inherit itk::Widget
26
27    constructor {args} { # defined below }
28    destructor { # defined below }
29
30    public method add {image {settings ""}}
31    public method get {}
32    public method delete {args}
33    public method scale {args}
34    public method parameters {title args} { # do nothing }
35    public method download {option args}
36
37    protected method _rebuild {args}
38    protected method _top {what}
39    protected method _zoom {option args}
40    protected method _move {option args}
41
42    private variable _dispatcher "" ;# dispatcher for !events
43    private variable _dlist ""      ;# list of data objects
44    private variable _topmost ""    ;# topmost image in _dlist
45    private variable _max           ;# max size of all images
46    private variable _scale         ;# info related to zoom
47    private variable _image         ;# image buffers used for scaling
48}
49                                                                               
50itk::usual ImageResult {
51    keep -background -foreground -cursor -font
52}
53
54# ----------------------------------------------------------------------
55# CONSTRUCTOR
56# ----------------------------------------------------------------------
57itcl::body Rappture::ImageResult::constructor {args} {
58    Rappture::dispatcher _dispatcher
59    $_dispatcher register !rebuild
60    $_dispatcher dispatch $this !rebuild [itcl::code $this _rebuild]
61
62    array set _scale {
63        max 1.0
64        current 1.0
65        default 1
66        x 0
67        y 0
68    }
69
70    option add hull.width hull.height
71    pack propagate $itk_component(hull) no
72
73    Rappture::Panes $itk_interior.panes -sashwidth 1 -sashrelief solid -sashpadding 2
74    pack $itk_interior.panes -expand yes -fill both
75    set main [$itk_interior.panes pane 0]
76    $itk_interior.panes fraction 0 1
77
78    itk_component add controls {
79        frame $main.cntls
80    } {
81        usual
82        rename -background -controlbackground controlBackground Background
83    }
84    pack $itk_component(controls) -side right -fill y
85
86    itk_component add reset {
87        button $itk_component(controls).reset \
88            -borderwidth 1 -padx 1 -pady 1 \
89            -bitmap [Rappture::icon reset] \
90            -command [itcl::code $this _zoom reset]
91    } {
92        usual
93        ignore -borderwidth
94        rename -highlightbackground -controlbackground controlBackground Background
95    }
96    pack $itk_component(reset) -padx 4 -pady 4
97    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
98
99    itk_component add zoomin {
100        button $itk_component(controls).zin \
101            -borderwidth 1 -padx 1 -pady 1 \
102            -bitmap [Rappture::icon zoomin] \
103            -command [itcl::code $this _zoom in]
104    } {
105        usual
106        ignore -borderwidth
107        rename -highlightbackground -controlbackground controlBackground Background
108    }
109    pack $itk_component(zoomin) -padx 4 -pady 4
110    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
111
112    itk_component add zoomout {
113        button $itk_component(controls).zout \
114            -borderwidth 1 -padx 1 -pady 1 \
115            -bitmap [Rappture::icon zoomout] \
116            -command [itcl::code $this _zoom out]
117    } {
118        usual
119        ignore -borderwidth
120        rename -highlightbackground -controlbackground controlBackground Background
121    }
122    pack $itk_component(zoomout) -padx 4 -pady 4
123    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
124
125
126    set _image(zoom) [image create photo]
127    set _image(final) [image create photo]
128
129    itk_component add image {
130        label $main.image -image $_image(final) -anchor c
131    } {
132        keep -background -foreground -cursor -font
133    }
134    pack $itk_component(image) -expand yes -fill both
135
136    #
137    # Add bindings for resize/move
138    #
139    bind $itk_component(image) <Configure> \
140        [list $_dispatcher event -idle !rebuild resize 1]
141
142    bind $itk_component(image) <ButtonPress-1> \
143        [itcl::code $this _move click %x %y]
144    bind $itk_component(image) <B1-Motion> \
145        [itcl::code $this _move drag %x %y]
146    bind $itk_component(image) <ButtonRelease-1> \
147        [itcl::code $this _move release %x %y]
148
149    #
150    # Add area at the bottom for notes.
151    #
152    set notes [$itk_interior.panes insert end -fraction 0.15]
153    $itk_interior.panes visibility 1 off
154    Rappture::Scroller $notes.scr -xscrollmode auto -yscrollmode auto
155    pack $notes.scr -expand yes -fill both
156    itk_component add notes {
157        Rappture::HTMLviewer $notes.scr.html
158    }
159    $notes.scr contents $notes.scr.html
160
161    eval itk_initialize $args
162}
163
164# ----------------------------------------------------------------------
165# DESTRUCTOR
166# ----------------------------------------------------------------------
167itcl::body Rappture::ImageResult::destructor {} {
168    foreach name [array names _image] {
169        image delete $_image($name)
170    }
171}
172
173# ----------------------------------------------------------------------
174# USAGE: add <image> ?<settings>?
175#
176# Clients use this to add an image to the plot.  The optional <settings>
177# are used to configure the image.  Allowed settings are -color,
178# -brightness, -width, -linestyle and -raise.
179# ----------------------------------------------------------------------
180itcl::body Rappture::ImageResult::add {image {settings ""}} {
181    array set params {
182        -color auto
183        -brightness 0
184        -width 1
185        -raise 0
186        -linestyle solid
187        -description ""
188        -param ""
189    }
190    foreach {opt val} $settings {
191        if {![info exists params($opt)]} {
192            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
193        }
194        set params($opt) $val
195    }
196
197    if {$params(-raise)} {
198        set _topmost $image
199        $_dispatcher event -idle !rebuild
200    }
201
202    set pos [lsearch -exact $image $_dlist]
203    if {$pos < 0} {
204        lappend _dlist $image
205        $_dispatcher event -idle !rebuild
206    }
207}
208
209# ----------------------------------------------------------------------
210# USAGE: get
211#
212# Clients use this to query the list of images being displayed, in
213# order from bottom to top of this result.
214# ----------------------------------------------------------------------
215itcl::body Rappture::ImageResult::get {} {
216    # put the dataobj list in order according to -raise options
217    set dlist $_dlist
218
219    set i [lsearch $_dlist $_topmost]
220    if {$i >= 0} {
221        set dlist [lreplace $dlist $i $i]
222        set dlist [linsert $dlist 0 $_topmost]
223    }
224    return $dlist
225}
226
227# ----------------------------------------------------------------------
228# USAGE: delete ?<image1> <image2> ...?
229#
230# Clients use this to delete an image from the plot.  If no images
231# are specified, then all images are deleted.
232# ----------------------------------------------------------------------
233itcl::body Rappture::ImageResult::delete {args} {
234    if {[llength $args] == 0} {
235        set args $_dlist
236    }
237
238    # delete all specified curves
239    set changed 0
240    foreach image $args {
241        set pos [lsearch -exact $_dlist $image]
242        if {$pos >= 0} {
243            set _dlist [lreplace $_dlist $pos $pos]
244            set changed 1
245
246            if {$image == $_topmost} {
247                set _topmost ""
248            }
249        }
250    }
251
252    # if anything changed, then rebuild the plot
253    if {$changed} {
254        $_dispatcher event -idle !rebuild
255    }
256}
257
258# ----------------------------------------------------------------------
259# USAGE: scale ?<image1> <image2> ...?
260#
261# Sets the default limits for the overall plot according to the
262# limits of the data for all of the given <image> objects.  This
263# accounts for all images--even those not showing on the screen.
264# Because of this, the limits are appropriate for all images as
265# the user scans through data in the ResultSet viewer.
266# ----------------------------------------------------------------------
267itcl::body Rappture::ImageResult::scale {args} {
268    set _max(w) 0
269    set _max(h) 0
270    foreach image $args {
271        set imh [$image tkimage]
272
273        set w [image width $imh]
274        if {$w > $_max(w)} { set _max(w) $w }
275
276        set h [image height $imh]
277        if {$h > $_max(h)} { set _max(h) $h }
278    }
279
280    # scale is unknown for now... scale later at next _rebuild
281    set _scale(max) "?"
282    set _scale(current) "?"
283
284    $_dispatcher event -idle !rebuild
285}
286
287# ----------------------------------------------------------------------
288# USAGE: download coming
289# USAGE: download controls <downloadCommand>
290# USAGE: download now
291#
292# Clients use this method to create a downloadable representation
293# of the plot.  Returns a list of the form {ext string}, where
294# "ext" is the file extension (indicating the type of data) and
295# "string" is the data itself.
296# ----------------------------------------------------------------------
297itcl::body Rappture::ImageResult::download {option args} {
298    switch $option {
299        coming {
300            # nothing to do
301        }
302        controls {
303            # no controls for this download yet
304            return ""
305        }
306        now {
307            set top [_top image]
308            if {$top == ""} {
309                return ""
310            }
311            # Get the image data (as base64) and decode it back to binary.
312            # This is better than writing to temporary files.  When we switch
313            # to the BLT picture image it won't be necessary to decode the
314            # image data.
315            set bytes [$top data -format "jpeg -quality 100"]
316            set bytes [Rappture::encoding::decode -as b64 $bytes]
317            return [list .jpg $bytes]
318        }
319        default {
320            error "bad option \"$option\": should be coming, controls, now"
321        }
322    }
323}
324
325# ----------------------------------------------------------------------
326# USAGE: _rebuild ?<eventData>...?
327#
328# Called automatically whenever something changes that affects the
329# data in the widget.  Clears any existing data and rebuilds the
330# widget to display new data.
331# ----------------------------------------------------------------------
332itcl::body Rappture::ImageResult::_rebuild {args} {
333    array set event $args
334    if {[info exists event(resize)] && $event(resize)} {
335        # window changed size -- recompute max scale below
336        set _scale(max) "?"
337    }
338
339    if {$_scale(max) == "?"} {
340        if {![_zoom rescale]} {
341            return
342        }
343    }
344    if {$_scale(current) == "?" || $_scale(default)} {
345        set _scale(current) $_scale(max)
346        set _scale(x) 0
347        set _scale(y) 0
348    }
349
350    set w [winfo width $itk_component(image)]
351    set h [winfo height $itk_component(image)]
352    $_image(final) configure -width $w -height $h
353    set bg [$itk_component(image) cget -background]
354    set rgb [winfo rgb . $bg]
355    set bg [format "#%03x%03x%03x" [lindex $rgb 0] [lindex $rgb 1] [lindex $rgb 2]]
356    $_image(final) put $bg -to 0 0 $w $h
357
358    set imh [_top image]
359    if {$imh != ""} {
360        if {$_scale(current) <= 1.0} {
361            set wz [expr {round($_scale(current)*$w)}]
362            set hz [expr {round($_scale(current)*$h)}]
363            if {$wz > 1 && $hz > 1} {
364                $_image(zoom) configure -width $wz -height $hz
365                $_image(zoom) put $bg -to 0 0 $wz $hz
366                set sx [expr {round($_scale(x)*$_scale(current))}]
367                set sy [expr {round($_scale(y)*$_scale(current))}]
368                $_image(zoom) copy $imh -from $sx $sy
369                blt::winop resample $_image(zoom) $_image(final) sinc
370            }
371        } else {
372            set iw [image width $imh]
373            set ih [image height $imh]
374            set wz [expr {round(double($iw)/$_scale(current))}]
375            set hz [expr {round(double($ih)/$_scale(current))}]
376            if {$wz > 1 && $hz > 1} {
377                $_image(zoom) configure -width $wz -height $hz
378                $_image(zoom) put $bg -to 0 0 $wz $hz
379                blt::winop resample $imh $_image(zoom) sinc
380                $_image(final) copy $_image(zoom) -from $_scale(x) $_scale(y)
381            }
382        }
383    }
384
385    set note [_top note]
386    if {[string length $note] > 0} {
387        if {[regexp {^html://} $note]} {
388            set note [string range $note 7 end]
389        } else {
390            regexp {&} $note {\007} note
391            regexp {<} $note {\&lt;} note
392            regexp {>} $note {\&gt;} note
393            regexp {\007} $note {\&amp;} note
394            regexp "\n\n" $note {<br/>} note
395            set note "<html><body>$note</body></html>"
396        }
397        set notes [$itk_interior.panes pane 1]
398        $itk_component(notes) load $note -in [file join [_top tooldir] docs]
399        $itk_interior.panes visibility 1 on
400    } else {
401        $itk_interior.panes visibility 1 off
402    }
403}
404
405# ----------------------------------------------------------------------
406# USAGE: _top image|note|tooldir
407#
408# Used internally to get the topmost image currently being displayed.
409# ----------------------------------------------------------------------
410itcl::body Rappture::ImageResult::_top {option} {
411    set top $_topmost
412    if {"" == $top} {
413        set top [lindex $_dlist 0]
414    }
415    if {"" != $top} {
416        switch -- $option {
417            image   { return [$top tkimage] }
418            note    { return [$top hints note] }
419            tooldir { return [$top hints tooldir] }
420            default { error "bad option \"$option\": should be image, note, tooldir" }
421        }
422    }
423    return ""
424}
425
426# ----------------------------------------------------------------------
427# USAGE: _zoom reset
428# USAGE: _zoom in
429# USAGE: _zoom out
430#
431# Called automatically when the user clicks on one of the zoom
432# controls for this widget.  Changes the zoom for the current view.
433# ----------------------------------------------------------------------
434itcl::body Rappture::ImageResult::_zoom {option args} {
435    switch -- $option {
436        rescale {
437            # empty list? then reset w/h max size
438            if {[llength $_dlist] == 0} {
439                set _max(w) 0
440                set _max(h) 0
441                set _scale(max) 1.0
442            } else {
443                set w [winfo width $itk_component(image)]
444                set h [winfo height $itk_component(image)]
445                if {$w == 1 && $h == 1} {
446                    return 0
447                }
448
449                set wfac [expr {$_max(w)/double($w)}]
450                set hfac [expr {$_max(h)/double($h)}]
451                set _scale(max) [expr {($wfac > $hfac) ? $wfac : $hfac}]
452            }
453            return 1
454        }
455        reset {
456            set _scale(current) $_scale(max)
457            set _scale(default) 1
458            set _scale(x) 0
459            set _scale(y) 0
460        }
461        in {
462            set _scale(current) [expr {$_scale(current)*0.5}]
463            set _scale(default) 0
464        }
465        out {
466            set w [winfo width $itk_component(image)]
467            set h [winfo height $itk_component(image)]
468            if {$_max(w)/$_scale(current) > $w
469                  || $_max(h)/$_scale(current) > $h} {
470                # must be room left to zoom -- zoom out, but not beyond max
471                set _scale(current) [expr {$_scale(current)*2.0}]
472                if {$_scale(current) < $_scale(max)} {
473                    set _scale(current) $_scale(max)
474                }
475            } else {
476                # no room left to zoom -- zoom out max
477                if {$_scale(max) < 1} {
478                    set _scale(current) 1
479                } else {
480                    set _scale(current) $_scale(max)
481                }
482            }
483            set _scale(default) 0
484        }
485    }
486    $_dispatcher event -idle !rebuild
487}
488
489# ----------------------------------------------------------------------
490# USAGE: _move click <x> <y>
491# USAGE: _move drag <x> <y>
492# USAGE: _move release <x> <y>
493#
494# Called automatically when the user clicks and drags on the image
495# to pan the view.  Adjusts the (x,y) offset for the scaling info
496# and redraws the widget.
497# ----------------------------------------------------------------------
498itcl::body Rappture::ImageResult::_move {option args} {
499    switch -- $option {
500        click {
501            foreach {x y} $args break
502            $itk_component(image) configure -cursor fleur
503            set _scale(x0) $_scale(x)
504            set _scale(y0) $_scale(y)
505            set _scale(xclick) $x
506            set _scale(yclick) $y
507        }
508        drag {
509            foreach {x y} $args break
510            if {[info exists _scale(xclick)] && [info exists _scale(yclick)]} {
511                set w [winfo width $itk_component(image)]
512                set h [winfo height $itk_component(image)]
513                set wx [expr {round($_max(w)/$_scale(current))}]
514                set hy [expr {round($_max(h)/$_scale(current))}]
515                if {$wx > $w || $hy > $h} {
516                    set x [expr {$_scale(x0)-$x+$_scale(xclick)}]
517                    if {$x > $wx-$w} {set x [expr {$wx-$w}]}
518                    if {$x < 0} {set x 0}
519
520                    set y [expr {$_scale(y0)-$y+$_scale(yclick)}]
521                    if {$y > $hy-$h} {set y [expr {$hy-$h}]}
522                    if {$y < 0} {set y 0}
523
524                    set _scale(x) $x
525                    set _scale(y) $y
526                } else {
527                    set _scale(x) 0
528                    set _scale(y) 0
529                }
530                $_dispatcher event -idle !rebuild
531            }
532        }
533        release {
534            eval _move drag $args
535            $itk_component(image) configure -cursor ""
536            catch {unset _scale(xclick)}
537            catch {unset _scale(yclick)}
538        }
539        default {
540            error "bad option \"$option\": should be click, drag, release"
541        }
542    }
543}
Note: See TracBrowser for help on using the repository browser.