source: trunk/gui/scripts/heightmapviewer.tcl @ 1349

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

my first cut at flowvisviewer client based on work by dsk
File size: 41.0 KB
Line 
1
2# ----------------------------------------------------------------------
3#  COMPONENT: heightmapviewer - 3D volume rendering
4#
5#  This widget performs volume rendering on 3D scalar/vector datasets.
6#  It connects to the Nanovis server running on a rendering farm,
7#  transmits data, and displays the results.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2005  Purdue Research Foundation
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15
16package require Itk
17package require BLT
18package require Img
19
20option add *HeightmapViewer.width 4i widgetDefault
21option add *HeightmapViewer.height 4i widgetDefault
22option add *HeightmapViewer.foreground black widgetDefault
23option add *HeightmapViewer.controlBackground gray widgetDefault
24option add *HeightmapViewer.controlDarkBackground #999999 widgetDefault
25option add *HeightmapViewer.plotBackground black widgetDefault
26option add *HeightmapViewer.plotForeground white widgetDefault
27option add *HeightmapViewer.plotOutline white widgetDefault
28option add *HeightmapViewer.font \
29    -*-helvetica-medium-r-normal-*-12-* widgetDefault
30
31# must use this name -- plugs into Rappture::resources::load
32proc HeightmapViewer_init_resources {} {
33    Rappture::resources::register \
34        nanovis_server Rappture::HeightmapViewer::SetServerList
35}
36
37itcl::class Rappture::HeightmapViewer {
38    inherit Rappture::VisViewer
39
40    itk_option define -plotforeground plotForeground Foreground ""
41    itk_option define -plotbackground plotBackground Background ""
42    itk_option define -plotoutline plotOutline PlotOutline ""
43
44    constructor { hostlist args } {
45        Rappture::VisViewer::constructor $hostlist
46    } {
47        # defined below
48    }
49    destructor {
50        # defined below
51    }
52
53    public proc SetServerList { namelist } {
54        Rappture::VisViewer::SetServerList "nanovis" $namelist
55    }
56    public method add {dataobj {settings ""}}
57    public method get {args}
58    public method delete {args}
59    public method scale {args}
60    public method download {option args}
61    public method parameters {title args} {
62        # do nothing
63    }
64    public method drawer {what who}
65    public method camera {option args}
66    protected method Connect {}
67    protected method Disconnect {}
68
69    protected method _send {string}
70    protected method _send_dataobjs {}
71    protected method ReceiveImage { args }
72    private method _ReceiveLegend {tf vmin vmax size}
73    private method _BuildSettingsDrawer {}
74    private method _BuildCameraDrawer {}
75    private method _PanCamera {}
76    protected method _receive_echo {channel {data ""}}
77
78    protected method _rebuild {}
79    protected method _zoom {option}
80    protected method _pan {option x y}
81    protected method _rotate {option x y}
82
83    protected method _state {comp}
84    protected method _fixSettings {what {value ""}}
85    protected method _getTransfuncData {dataobj comp}
86
87
88    private variable outbuf_       ;# buffer for outgoing commands
89
90    private variable dlist_ ""     ;# list of data objects
91    private variable obj2style_    ;# maps dataobj => style settings
92    private variable obj2ovride_   ;# maps dataobj => style override
93    private variable obj2id_       ;# maps dataobj => heightmap ID in server
94    private variable id2obj_       ;# maps heightmap ID => dataobj in server
95    private variable sendobjs_ ""  ;# list of data objs to send to server
96    private variable receiveIds_   ;# list of data responses from the server
97    private variable click_        ;# info used for _rotate operations
98    private variable limits_       ;# autoscale min/max for all axes
99    private variable view_         ;# view params for 3D view
100    private common settings_      ;# Array used for checkbuttons and radiobuttons
101    private variable initialized_
102    private common hardcopy_
103}
104
105itk::usual HeightmapViewer {
106    keep -background -foreground -cursor -font
107    keep -plotbackground -plotforeground
108}
109
110# ----------------------------------------------------------------------
111# CONSTRUCTOR
112# ----------------------------------------------------------------------
113itcl::body Rappture::HeightmapViewer::constructor {hostlist args} {
114    # Draw legend event
115    $_dispatcher register !legend
116    $_dispatcher dispatch $this !legend \
117        "[itcl::code $this _fixSettings legend]; list"
118    # Send dataobjs event
119    $_dispatcher register !send_dataobjs
120    $_dispatcher dispatch $this !send_dataobjs \
121        "[itcl::code $this _send_dataobjs]; list"
122    # Rebuild event
123    $_dispatcher register !rebuild
124    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
125
126    set outbuf_ ""
127
128    #
129    # Populate parser with commands handle incoming requests
130    #
131    $_parser alias image [itcl::code $this ReceiveImage]
132    $_parser alias legend [itcl::code $this _ReceiveLegend]
133
134    # Initialize the view to some default parameters.
135    array set view_ {
136        theta   45
137        phi     45
138        psi     0
139        zoom    1.0
140        pan-x   0
141        pan-y   0
142    }
143    set obj2id_(count) 0
144
145    itk_component add zoom {
146        frame $itk_component(controls).zoom
147    } {
148        usual
149        rename -background -controlbackground controlBackground Background
150    }
151    pack $itk_component(zoom) -side top
152
153    itk_component add reset {
154        button $itk_component(zoom).reset \
155            -borderwidth 1 -padx 1 -pady 1 \
156            -image [Rappture::icon reset-view] \
157            -command [itcl::code $this _zoom reset]
158    } {
159        usual
160        ignore -borderwidth
161        rename -highlightbackground -controlbackground controlBackground Background
162    }
163    pack $itk_component(reset) -side top -padx 2 -pady { 2 0 }
164    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
165
166    itk_component add zoomin {
167        button $itk_component(zoom).zin \
168            -borderwidth 1 -padx 1 -pady 1 \
169            -image [Rappture::icon zoom-in] \
170            -command [itcl::code $this _zoom in]
171    } {
172        usual
173        ignore -borderwidth
174        rename -highlightbackground -controlbackground controlBackground Background
175    }
176    pack $itk_component(zoomin) -side top -padx 2 -pady { 2 0 }
177    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
178
179    itk_component add zoomout {
180        button $itk_component(zoom).zout \
181            -borderwidth 1 -padx 1 -pady 1 \
182            -image [Rappture::icon zoom-out] \
183            -command [itcl::code $this _zoom out]
184    } {
185        usual
186        ignore -borderwidth
187        rename -highlightbackground -controlbackground controlBackground Background
188    }
189    pack $itk_component(zoomout) -side top -padx 2 -pady { 2 0 }
190    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
191
192    itk_component add settings_button {
193        label $itk_component(controls).settingsbutton \
194            -borderwidth 1 -padx 1 -pady 1 \
195            -relief "raised" -image [Rappture::icon wrench]
196    } {
197        usual
198        ignore -borderwidth
199        rename -highlightbackground -controlbackground controlBackground \
200            Background
201    }
202    pack $itk_component(settings_button) -padx 2 -pady { 0 2 } \
203        -ipadx 1 -ipady 1
204    Rappture::Tooltip::for $itk_component(settings_button) \
205        "Configure settings"
206    bind $itk_component(settings_button) <ButtonPress> \
207        [itcl::code $this drawer toggle settings]
208    pack $itk_component(settings_button) -side bottom \
209        -padx 2 -pady 2 -anchor e
210
211    itk_component add camera_button {
212        label $itk_component(controls).camerabutton \
213            -borderwidth 1 -padx 1 -pady 1 \
214            -relief "raised" -image [Rappture::icon camera]
215    } {
216        usual
217        ignore -borderwidth
218        rename -highlightbackground -controlbackground controlBackground \
219            Background
220    }
221    Rappture::Tooltip::for $itk_component(camera_button) \
222        "Camera settings"
223    bind $itk_component(camera_button) <ButtonPress> \
224        [itcl::code $this drawer toggle camera]
225    pack $itk_component(camera_button) -side bottom \
226        -padx 2 -pady { 0 2 } -ipadx 1 -ipady 1
227
228    _BuildSettingsDrawer
229    _BuildCameraDrawer
230
231    # Legend
232    set _image(legend) [image create photo]
233    itk_component add legend {
234        canvas $itk_component(area).legend -width 30 -highlightthickness 0
235    } {
236        usual
237        ignore -highlightthickness
238        rename -background -plotbackground plotBackground Background
239    }
240    pack $itk_component(legend) -side right -fill y
241    pack $itk_component(3dview) -side left -expand yes -fill both
242    bind $itk_component(legend) <Configure> \
243        [list $_dispatcher event -idle !legend]
244
245    # Bindings for rotation via mouse
246    bind $itk_component(3dview) <ButtonPress-1> \
247        [itcl::code $this _rotate click %x %y]
248    bind $itk_component(3dview) <B1-Motion> \
249        [itcl::code $this _rotate drag %x %y]
250    bind $itk_component(3dview) <ButtonRelease-1> \
251        [itcl::code $this _rotate release %x %y]
252    bind $itk_component(3dview) <Configure> \
253        [itcl::code $this _send "screen %w %h"]
254
255    # Bindings for panning via mouse
256    bind $itk_component(3dview) <ButtonPress-2> \
257        [itcl::code $this _pan click %x %y]
258    bind $itk_component(3dview) <B2-Motion> \
259        [itcl::code $this _pan drag %x %y]
260    bind $itk_component(3dview) <ButtonRelease-2> \
261        [itcl::code $this _pan release %x %y]
262
263    # Bindings for panning via keyboard
264    bind $itk_component(3dview) <KeyPress-Left> \
265        [itcl::code $this _pan set -10 0]
266    bind $itk_component(3dview) <KeyPress-Right> \
267        [itcl::code $this _pan set 10 0]
268    bind $itk_component(3dview) <KeyPress-Up> \
269        [itcl::code $this _pan set 0 -10]
270    bind $itk_component(3dview) <KeyPress-Down> \
271        [itcl::code $this _pan set 0 10]
272    bind $itk_component(3dview) <Shift-KeyPress-Left> \
273        [itcl::code $this _pan set -2 0]
274    bind $itk_component(3dview) <Shift-KeyPress-Right> \
275        [itcl::code $this _pan set 2 0]
276    bind $itk_component(3dview) <Shift-KeyPress-Up> \
277        [itcl::code $this _pan set 0 -2]
278    bind $itk_component(3dview) <Shift-KeyPress-Down> \
279        [itcl::code $this _pan set 0 2]
280
281    # Bindings for zoom via keyboard
282    bind $itk_component(3dview) <KeyPress-Prior> \
283        [itcl::code $this _zoom out]
284    bind $itk_component(3dview) <KeyPress-Next> \
285        [itcl::code $this _zoom in]
286
287    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
288
289    if {[string equal "x11" [tk windowingsystem]]} {
290        # Bindings for zoom via mouse
291        bind $itk_component(3dview) <4> [itcl::code $this _zoom out]
292        bind $itk_component(3dview) <5> [itcl::code $this _zoom in]
293    }
294
295    set _image(download) [image create photo]
296
297    eval itk_initialize $args
298
299    Connect
300}
301
302# ----------------------------------------------------------------------
303# DESTRUCTOR
304# ----------------------------------------------------------------------
305itcl::body Rappture::HeightmapViewer::destructor {} {
306    set sendobjs_ ""  ;# stop any send in progress
307    $_dispatcher cancel !rebuild
308    $_dispatcher cancel !send_dataobjs
309    image delete $_image(plot)
310    image delete $_image(legend)
311    image delete $_image(download)
312}
313
314# ----------------------------------------------------------------------
315# USAGE: add <dataobj> ?<settings>?
316#
317# Clients use this to add a data object to the plot.  The optional
318# <settings> are used to configure the plot.  Allowed settings are
319# -color, -brightness, -width, -linestyle, and -raise.
320# ----------------------------------------------------------------------
321itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
322    array set params {
323        -color auto
324        -width 1
325        -linestyle solid
326        -brightness 0
327        -raise 0
328        -description ""
329        -param ""
330    }
331    foreach {opt val} $settings {
332        if {![info exists params($opt)]} {
333            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
334        }
335        set params($opt) $val
336    }
337    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
338        # can't handle -autocolors yet
339        set params(-color) black
340    }
341    set location [$dataobj hints camera]
342    if { $location != "" } {
343        array set view_ $location
344    }
345    set pos [lsearch -exact $dataobj $dlist_]
346    if {$pos < 0} {
347        lappend dlist_ $dataobj
348        set obj2ovride_($dataobj-color) $params(-color)
349        set obj2ovride_($dataobj-width) $params(-width)
350        set obj2ovride_($dataobj-raise) $params(-raise)
351        $_dispatcher event -idle !rebuild
352    }
353}
354
355# ----------------------------------------------------------------------
356# USAGE: get ?-objects?
357# USAGE: get ?-image 3dview|legend?
358#
359# Clients use this to query the list of objects being plotted, in
360# order from bottom to top of this result.  The optional "-image"
361# flag can also request the internal images being shown.
362# ----------------------------------------------------------------------
363itcl::body Rappture::HeightmapViewer::get { args } {
364    if {[llength $args] == 0} {
365        set args "-objects"
366    }
367
368    set op [lindex $args 0]
369    switch -- $op {
370      -objects {
371        # put the dataobj list in order according to -raise options
372        set dlist $dlist_
373        foreach obj $dlist {
374            if { [info exists obj2ovride_($obj-raise)] &&
375                 $obj2ovride_($obj-raise)} {
376                set i [lsearch -exact $dlist $obj]
377                if {$i >= 0} {
378                    set dlist [lreplace $dlist $i $i]
379                    lappend dlist $obj
380                }
381            }
382        }
383        return $dlist
384      }
385      -image {
386        if {[llength $args] != 2} {
387            error "wrong # args: should be \"get -image 3dview|legend\""
388        }
389        switch -- [lindex $args end] {
390            3dview {
391                return $_image(plot)
392            }
393            legend {
394                return $_image(legend)
395            }
396            default {
397                error "bad image name \"[lindex $args end]\": should be 3dview or legend"
398            }
399        }
400      }
401      default {
402        error "bad option \"$op\": should be -objects or -image"
403      }
404    }
405}
406
407# ----------------------------------------------------------------------
408# USAGE: delete ?<dataobj1> <dataobj2> ...?
409#
410# Clients use this to delete a dataobj from the plot.  If no dataobjs
411# are specified, then all dataobjs are deleted.
412# ----------------------------------------------------------------------
413itcl::body Rappture::HeightmapViewer::delete { args } {
414    if {[llength $args] == 0} {
415        set args $dlist_
416    }
417
418    # delete all specified dataobjs
419    set changed 0
420    foreach dataobj $args {
421        set pos [lsearch -exact $dlist_ $dataobj]
422        if {$pos >= 0} {
423            set dlist_ [lreplace $dlist_ $pos $pos]
424            foreach key [array names obj2ovride_ $dataobj-*] {
425                unset obj2ovride_($key)
426            }
427            set changed 1
428        }
429    }
430
431    # if anything changed, then rebuild the plot
432    if {$changed} {
433        $_dispatcher event -idle !rebuild
434    }
435}
436
437# ----------------------------------------------------------------------
438# USAGE: scale ?<data1> <data2> ...?
439#
440# Sets the default limits for the overall plot according to the
441# limits of the data for all of the given <data> objects.  This
442# accounts for all objects--even those not showing on the screen.
443# Because of this, the limits are appropriate for all objects as
444# the user scans through data in the ResultSet viewer.
445# ----------------------------------------------------------------------
446itcl::body Rappture::HeightmapViewer::scale { args } {
447    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
448        set limits_($val) ""
449    }
450    foreach obj $args {
451        foreach axis {x y z v} {
452            foreach {min max} [$obj limits $axis] break
453            if {"" != $min && "" != $max} {
454                if {"" == $limits_(${axis}min)} {
455                    set limits_(${axis}min) $min
456                    set limits_(${axis}max) $max
457                } else {
458                    if {$min < $limits_(${axis}min)} {
459                        set limits_(${axis}min) $min
460                    }
461                    if {$max > $limits_(${axis}max)} {
462                        set limits_(${axis}max) $max
463                    }
464                }
465                set limits_(${axis}range) [expr {$max - $min}]
466            }
467        }
468    }
469}
470
471# ----------------------------------------------------------------------
472# USAGE: download coming
473# USAGE: download controls <downloadCommand>
474# USAGE: download now
475#
476# Clients use this method to create a downloadable representation
477# of the plot.  Returns a list of the form {ext string}, where
478# "ext" is the file extension (indicating the type of data) and
479# "string" is the data itself.
480# ----------------------------------------------------------------------
481itcl::body Rappture::HeightmapViewer::download {option args} {
482    switch $option {
483        coming {
484            if {[catch {
485                blt::winop snap $itk_component(area) $_image(download)
486            }]} {
487                $_image(download) configure -width 1 -height 1
488                $_image(download) put #000000
489            }
490        }
491        controls {
492            # no controls for this download yet
493            return ""
494        }
495        now {
496            # Get the image data (as base64) and decode it back to binary.
497            # This is better than writing to temporary files.  When we switch
498            # to the BLT picture image it won't be necessary to decode the
499            # image data.
500            set bytes [$_image(download) data -format "jpeg -quality 100"]
501            set bytes [Rappture::encoding::decode -as b64 $bytes]
502            return [list .jpg $bytes]
503        }
504        default {
505            error "bad option \"$option\": should be coming, controls, now"
506        }
507    }
508}
509
510# ----------------------------------------------------------------------
511# USAGE: Connect ?<host:port>,<host:port>...?
512#
513# Clients use this method to establish a connection to a new
514# server, or to reestablish a connection to the previous server.
515# Any existing connection is automatically closed.
516# ----------------------------------------------------------------------
517itcl::body Rappture::HeightmapViewer::Connect {} {
518    Disconnect
519    set _hosts [GetServerList "nanovis"]
520    if { "" == $_hosts } {
521        return 0
522    }
523    set result [VisViewer::Connect $_hosts]
524    return $result
525}
526
527# ----------------------------------------------------------------------
528# USAGE: Disconnect
529#
530# Clients use this method to disconnect from the current rendering
531# server.
532# ----------------------------------------------------------------------
533itcl::body Rappture::HeightmapViewer::Disconnect {} {
534    VisViewer::Disconnect
535
536    set outbuf_ ""
537    # disconnected -- no more data sitting on server
538    catch {unset obj2id_}
539    array unset id2obj_
540    set obj2id_(count) 0
541    set id2obj_(cound) 0
542    set sendobjs_ ""
543}
544
545#
546# _send
547#
548#       Send commands off to the rendering server.  If we're currently
549#       sending data objects to the server, buffer the commands to be
550#       sent later.
551#
552itcl::body Rappture::HeightmapViewer::_send {string} {
553    if {[llength $sendobjs_] > 0} {
554        append outbuf_ $string "\n"
555    } else {
556        if {[SendBytes $string]} {
557            foreach line [split $string \n] {
558                SendEcho >>line $line
559            }
560        }
561    }
562}
563
564# ----------------------------------------------------------------------
565# USAGE: _send_dataobjs
566#
567# Used internally to send a series of volume objects off to the
568# server.  Sends each object, a little at a time, with updates in
569# between so the interface doesn't lock up.
570# ----------------------------------------------------------------------
571itcl::body Rappture::HeightmapViewer::_send_dataobjs {} {
572    blt::busy hold $itk_component(hull); update idletasks
573
574    # Reset the overall limits
575    if { $sendobjs_ != "" } {
576        set limits_(vmin) ""
577        set limits_(vmax) ""
578    }
579    foreach dataobj $sendobjs_ {
580        foreach comp [$dataobj components] {
581            set data [$dataobj blob $comp]
582
583            foreach { vmin vmax }  [$dataobj limits v] break
584            if { $limits_(vmin) == "" || $vmin < $limits_(vmin) } {
585                set limits_(vmin) $vmin
586            }
587            if { $limits_(vmax) == "" || $vmax > $limits_(vmax) } {
588                set limits_(vmax) $vmax
589            }
590
591            # tell the engine to expect some data
592            set nbytes [string length $data]
593            if { ![SendBytes "heightmap data follows $nbytes"] } {
594                return
595
596            }
597            if { ![SendBytes $data] } {
598                return
599            }
600            set id $obj2id_(count)
601            incr obj2id_(count)
602            set id2obj_($id) [list $dataobj $comp]
603            set obj2id_($dataobj-$comp) $id
604            set receiveIds_($id) 1
605
606            #
607            # Determine the transfer function needed for this volume
608            # and make sure that it's defined on the server.
609            #
610            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
611            set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
612            if {![SendBytes $cmdstr]} {
613                return
614            }
615            set obj2style_($dataobj-$comp) $sname
616        }
617    }
618    set sendobjs_ ""
619    blt::busy release $itk_component(hull)
620
621    # activate the proper volume
622    set first [lindex [get] 0]
623    if {"" != $first} {
624        set axis [$first hints updir]
625        if {"" != $axis} {
626            _send "up $axis"
627        }
628    }
629
630    foreach key [array names obj2id_ *-*] {
631        set state [string match $first-* $key]
632        _send "heightmap data visible $state $obj2id_($key)"
633        if {[info exists obj2style_($key)]} {
634            _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
635        }
636    }
637
638    # if there are any commands in the buffer, send them now that we're done
639    SendBytes $outbuf_
640    set outbuf_ ""
641
642    $_dispatcher event -idle !legend
643}
644
645# ----------------------------------------------------------------------
646# USAGE: ReceiveImage -bytes <size>
647#
648# Invoked automatically whenever the "image" command comes in from
649# the rendering server.  Indicates that binary image data with the
650# specified <size> will follow.
651# ----------------------------------------------------------------------
652itcl::body Rappture::HeightmapViewer::ReceiveImage { args } {
653    if {![IsConnected]} {
654        return
655    }
656    array set info {
657        -type image
658    }
659    array set info $args
660    set bytes [ReceiveBytes $info(-bytes)]
661    ReceiveEcho <<line "<read $info(-bytes) bytes"
662    if { $info(-type) == "image" } {
663        $_image(plot) configure -data $bytes
664        ReceiveEcho <<line "<read for [image width $_image(plot)]x[image height $_image(plot)] image>"
665    } elseif { $info(type) == "print" } {
666        set tag $this-print-$info(-token)
667        set hardcopy_($tag) $bytes
668    }
669}
670
671# ----------------------------------------------------------------------
672# USAGE: _ReceiveLegend <tf> <vmin> <vmax> <size>
673#
674# Invoked automatically whenever the "legend" command comes in from
675# the rendering server.  Indicates that binary image data with the
676# specified <size> will follow.
677# ----------------------------------------------------------------------
678itcl::body Rappture::HeightmapViewer::_ReceiveLegend {tf vmin vmax size} {
679    if { [IsConnected] } {
680        set bytes [ReceiveBytes $size]
681        ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
682        if 1 {
683        set src [image create photo -data $bytes]
684        blt::winop image rotate $src $_image(legend) 90
685        set dst $_image(legend)
686        } else {
687        $_image(legend) configure -data $bytes
688        }
689        set c $itk_component(legend)
690        set w [winfo width $c]
691        set h [winfo height $c]
692        set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
693        if {"" == [$c find withtag transfunc]} {
694            $c create image 0 [expr $lineht] -anchor ne \
695                 -image $_image(legend) -tags transfunc
696            $c create text 10 [expr {$h-8}] -anchor se \
697                 -fill $itk_option(-plotforeground) -tags vmin
698            $c create text [expr {$w-10}] [expr {$h-8}] -anchor ne \
699                 -fill $itk_option(-plotforeground) -tags vmax
700        }
701        $c coords transfunc [expr $w - 5] [expr $lineht]
702        $c itemconfigure vmin -text $vmin
703        $c itemconfigure vmax -text $vmax
704        $c coords vmax [expr $w - 5] 2
705        $c coords vmin [expr $w - 5] [expr $h - 2]
706    }
707}
708
709# ----------------------------------------------------------------------
710# USAGE: _rebuild
711#
712# Called automatically whenever something changes that affects the
713# data in the widget.  Clears any existing data and rebuilds the
714# widget to display new data.
715# ----------------------------------------------------------------------
716itcl::body Rappture::HeightmapViewer::_rebuild {} {
717    # in the midst of sending data? then bail out
718    if {[llength $sendobjs_] > 0} {
719        return
720    }
721    # Find any new data that needs to be sent to the server.  Queue this up on
722    # the sendobjs_ list, and send it out a little at a time.  Do this first,
723    # before we rebuild the rest.
724    foreach dataobj [get] {
725        set comp [lindex [$dataobj components] 0]
726        if {![info exists obj2id_($dataobj-$comp)]} {
727            set i [lsearch -exact $sendobjs_ $dataobj]
728            if {$i < 0} {
729                lappend sendobjs_ $dataobj
730            }
731        }
732    }
733    if {[llength $sendobjs_] > 0} {
734        # Send off new data objects
735        $_dispatcher event -idle !send_dataobjs
736    } else {
737        # Nothing to send -- activate the proper volume
738        set first [lindex [get] 0]
739        if {"" != $first} {
740            set axis [$first hints updir]
741            if {"" != $axis} {
742                _send "up $axis"
743            }
744        }
745        foreach key [array names obj2id_ *-*] {
746            set state [string match $first-* $key]
747            _send "heightmap data visible $state $obj2id_($key)"
748            if {[info exists obj2style_($key)]} {
749                _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
750            }
751        }
752        $_dispatcher event -idle !legend
753    }
754
755    # Reset the screen size. 
756    set w [winfo width $itk_component(3dview)]
757    set h [winfo height $itk_component(3dview)]
758    _send "screen $w $h"
759
760    # Reset the camera and other view parameters
761    set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
762    _send "camera angle $xyz"
763    _PanCamera
764    _send "camera zoom $view_(zoom)"
765
766     if {"" == $itk_option(-plotoutline)} {
767         _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
768     }
769    set settings_($this-theta) $view_(theta)
770    set settings_($this-phi) $view_(phi)
771    set settings_($this-psi) $view_(psi)
772    set settings_($this-pan-x) $view_(pan-x)
773    set settings_($this-pan-y) $view_(pan-y)
774    set settings_($this-zoom) $view_(zoom)
775
776    _fixSettings wireframe
777    _fixSettings grid
778    _fixSettings axes
779    _fixSettings contourlines
780}
781
782# ----------------------------------------------------------------------
783# USAGE: _zoom in
784# USAGE: _zoom out
785# USAGE: _zoom reset
786#
787# Called automatically when the user clicks on one of the zoom
788# controls for this widget.  Changes the zoom for the current view.
789# ----------------------------------------------------------------------
790itcl::body Rappture::HeightmapViewer::_zoom {option} {
791    switch -- $option {
792        "in" {
793            set view_(zoom) [expr {$view_(zoom)*1.25}]
794            set settings_($this-zoom) $view_(zoom)
795        }
796        "out" {
797            set view_(zoom) [expr {$view_(zoom)*0.8}]
798            set settings_($this-zoom) $view_(zoom)
799        }
800        "reset" {
801            array set view_ {
802                theta   45
803                phi     45
804                psi     0
805                zoom    1.0
806                pan-x   0
807                pan-y   0
808            }
809            set first [lindex [get] 0]
810            if { $first != "" } {
811                set location [$first hints camera]
812                if { $location != "" } {
813                    array set view_ $location
814                }
815            }
816            set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
817            _send "camera angle $xyz"
818            _PanCamera
819            set settings_($this-theta) $view_(theta)
820            set settings_($this-phi) $view_(phi)
821            set settings_($this-psi) $view_(psi)
822            set settings_($this-pan-x) $view_(pan-x)
823            set settings_($this-pan-y) $view_(pan-y)
824            set settings_($this-zoom) $view_(zoom)
825        }
826    }
827    _send "camera zoom $view_(zoom)"
828}
829
830# ----------------------------------------------------------------------
831# USAGE: $this _pan click x y
832#        $this _pan drag x y
833#        $this _pan release x y
834#
835# Called automatically when the user clicks on one of the zoom
836# controls for this widget.  Changes the zoom for the current view.
837# ----------------------------------------------------------------------
838itcl::body Rappture::HeightmapViewer::_pan {option x y} {
839    # Experimental stuff
840    set w [winfo width $itk_component(3dview)]
841    set h [winfo height $itk_component(3dview)]
842    if { $option == "set" } {
843        set x [expr ($x / double($w)) * $limits_(xrange)]
844        set y [expr ($y / double($h)) * $limits_(yrange)]
845        set view_(pan-x) [expr $view_(pan-x) + $x]
846        set view_(pan-y) [expr $view_(pan-y) + $y]
847        _PanCamera
848        set settings_($this-pan-x) $view_(pan-x)
849        set settings_($this-pan-y) $view_(pan-y)
850        return
851    }
852    if { $option == "click" } {
853        set click_(x) $x
854        set click_(y) $y
855        $itk_component(3dview) configure -cursor hand1
856    }
857    if { $option == "drag" || $option == "release" } {
858        set dx [expr (($click_(x) - $x)/double($w)) * $limits_(xrange)]
859        set dy [expr (($click_(y) - $y)/double($h)) * $limits_(yrange)]
860        set click_(x) $x
861        set click_(y) $y
862        set view_(pan-x) [expr $view_(pan-x) - $dx]
863        set view_(pan-y) [expr $view_(pan-y) - $dy]
864        _PanCamera
865        set settings_($this-pan-x) $view_(pan-x)
866        set settings_($this-pan-y) $view_(pan-y)
867    }
868    if { $option == "release" } {
869        $itk_component(3dview) configure -cursor ""
870    }
871}
872
873itcl::body Rappture::HeightmapViewer::_PanCamera {} {
874    set x [expr ($view_(pan-x)) / $limits_(xrange)]
875    set y [expr ($view_(pan-y)) / $limits_(yrange)]
876    _send "camera pan $x $y"
877}
878
879# ----------------------------------------------------------------------
880# USAGE: _rotate click <x> <y>
881# USAGE: _rotate drag <x> <y>
882# USAGE: _rotate release <x> <y>
883#
884# Called automatically when the user clicks/drags/releases in the
885# plot area.  Moves the plot according to the user's actions.
886# ----------------------------------------------------------------------
887itcl::body Rappture::HeightmapViewer::_rotate {option x y} {
888    switch -- $option {
889        click {
890            $itk_component(3dview) configure -cursor fleur
891            array set click_ [subst {
892                x       $x
893                y       $y
894                theta   $view_(theta)
895                phi     $view_(phi)
896            }]
897        }
898        drag {
899            if {[array size click_] == 0} {
900                _rotate click $x $y
901            } else {
902                set w [winfo width $itk_component(3dview)]
903                set h [winfo height $itk_component(3dview)]
904                if {$w <= 0 || $h <= 0} {
905                    return
906                }
907
908                if {[catch {
909                    # this fails sometimes for no apparent reason
910                    set dx [expr {double($x-$click_(x))/$w}]
911                    set dy [expr {double($y-$click_(y))/$h}]
912                }] != 0 } {
913                    return
914                }
915
916                #
917                # Rotate the camera in 3D
918                #
919                if {$view_(psi) > 90 || $view_(psi) < -90} {
920                    # when psi is flipped around, theta moves backwards
921                    set dy [expr {-$dy}]
922                }
923                set theta [expr {$view_(theta) - $dy*180}]
924                while {$theta < 0} { set theta [expr {$theta+180}] }
925                while {$theta > 180} { set theta [expr {$theta-180}] }
926
927                if {abs($theta) >= 30 && abs($theta) <= 160} {
928                    set phi [expr {$view_(phi) - $dx*360}]
929                    while {$phi < 0} { set phi [expr {$phi+360}] }
930                    while {$phi > 360} { set phi [expr {$phi-360}] }
931                    set psi $view_(psi)
932                } else {
933                    set phi $view_(phi)
934                    set psi [expr {$view_(psi) - $dx*360}]
935                    while {$psi < -180} { set psi [expr {$psi+360}] }
936                    while {$psi > 180} { set psi [expr {$psi-360}] }
937                }
938
939                set view_(theta)        $theta
940                set view_(phi)          $phi
941                set view_(psi)          $psi
942                set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
943                set settings_($this-theta) $view_(theta)
944                set settings_($this-phi) $view_(phi)
945                set settings_($this-psi) $view_(psi)
946                _send "camera angle $xyz"
947                set click_(x) $x
948                set click_(y) $y
949            }
950        }
951        release {
952            _rotate drag $x $y
953            $itk_component(3dview) configure -cursor ""
954            catch {unset click_}
955        }
956        default {
957            error "bad option \"$option\": should be click, drag, release"
958        }
959    }
960}
961
962# ----------------------------------------------------------------------
963# USAGE: _state <component>
964#
965# Used internally to determine the state of a toggle button.
966# The <component> is the itk component name of the button.
967# Returns on/off for the state of the button.
968# ----------------------------------------------------------------------
969itcl::body Rappture::HeightmapViewer::_state {comp} {
970    if {[$itk_component($comp) cget -relief] == "sunken"} {
971        return "on"
972    }
973    return "off"
974}
975
976# ----------------------------------------------------------------------
977# USAGE: _fixSettings <what> ?<value>?
978#
979# Used internally to update rendering settings whenever parameters
980# change in the popup settings panel.  Sends the new settings off
981# to the back end.
982# ----------------------------------------------------------------------
983itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } {
984    switch -- $what {
985        "legend" {
986            if { $settings_($this-legend) } {
987                pack $itk_component(legend) -side right -fill y
988            } else {
989                pack forget $itk_component(legend)
990            }
991            set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
992            set w [expr {[winfo height $itk_component(legend)] - 2*$lineht}]
993            set h [expr {[winfo width $itk_component(legend)] - 16}]
994            set imap ""
995            set dataobj [lindex [get] 0]
996            if {"" != $dataobj} {
997                set comp [lindex [$dataobj components] 0]
998                if {[info exists obj2id_($dataobj-$comp)]} {
999                    set imap $obj2id_($dataobj-$comp)
1000                }
1001            }
1002            if {$w > 0 && $h > 0 && "" != $imap} {
1003                _send "heightmap legend $imap $w $h"
1004            } else {
1005                $itk_component(legend) delete all
1006            }
1007        }
1008        "grid" {
1009            if { [IsConnected] } {
1010                _send "grid visible $settings_($this-grid)"
1011            }
1012        }
1013        "axes" {
1014            if { [IsConnected] } {
1015                _send "axis visible $settings_($this-axes)"
1016            }
1017        }
1018        "wireframe" {
1019            if { [IsConnected] } {
1020                _send "heightmap polygon $settings_($this-wireframe)"
1021            }
1022        }
1023        "contourlines" {
1024            if {[IsConnected]} {
1025                set dataobj [lindex [get] 0]
1026                if {"" != $dataobj} {
1027                    set comp [lindex [$dataobj components] 0]
1028                    if {[info exists obj2id_($dataobj-$comp)]} {
1029                        set i $obj2id_($dataobj-$comp)
1030                        set bool $settings_($this-contourlines)
1031                        _send "heightmap linecontour visible $bool $i"
1032                    }
1033                }
1034            }
1035        }
1036        default {
1037            error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
1038        }
1039    }
1040}
1041
1042# ----------------------------------------------------------------------
1043# USAGE: _getTransfuncData <dataobj> <comp>
1044#
1045# Used internally to compute the colormap and alpha map used to define
1046# a transfer function for the specified component in a data object.
1047# Returns: name {v r g b ...} {v w ...}
1048# ----------------------------------------------------------------------
1049itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} {
1050    array set style {
1051        -color rainbow
1052        -levels 6
1053        -opacity 0.5
1054    }
1055    array set style [lindex [$dataobj components -style $comp] 0]
1056    set sname "$style(-color):$style(-levels):$style(-opacity)"
1057
1058    if {$style(-color) == "rainbow"} {
1059        set style(-color) "white:yellow:green:cyan:blue:magenta"
1060    }
1061    set clist [split $style(-color) :]
1062    set color white
1063    set cmap "0.0 [Color2RGB $color] "
1064    set range [expr $limits_(vmax) - $limits_(vmin)]
1065    for {set i 0} {$i < [llength $clist]} {incr i} {
1066        set xval [expr {double($i+1)/([llength $clist]+1)}]
1067        set color [lindex $clist $i]
1068        append cmap "$xval [Color2RGB $color] "
1069    }
1070    append cmap "1.0 [Color2RGB $color] "
1071
1072    set opacity $style(-opacity)
1073    set levels $style(-levels)
1074    set wmap {}
1075    if {[string is int $levels]} {
1076        lappend wmap 0.0 0.0
1077        set delta [expr {0.125/($levels+1)}]
1078        for {set i 1} {$i <= $levels} {incr i} {
1079            # add spikes in the middle
1080            set xval [expr {double($i)/($levels+1)}]
1081            lappend wmap [expr {$xval-$delta-0.01}] 0.0
1082            lappend wmap [expr {$xval-$delta}] $opacity
1083            lappend wmap [expr {$xval+$delta}] $opacity
1084            lappend wmap [expr {$xval+$delta+0.01}] 0.0
1085        }
1086        lappend wmap 1.0 0.0
1087    } else {
1088        lappend wmap 0.0 0.0
1089        set delta 0.05
1090        foreach xval [split $levels ,] {
1091            lappend wmap [expr {$xval-$delta}] 0.0
1092            lappend $xval $opacity
1093            lappend [expr {$xval+$delta}] 0.0
1094        }
1095        lappend wmap 1.0 0.0
1096    }
1097    return [list $sname $cmap $wmap]
1098}
1099
1100# ----------------------------------------------------------------------
1101# CONFIGURATION OPTION: -plotbackground
1102# ----------------------------------------------------------------------
1103itcl::configbody Rappture::HeightmapViewer::plotbackground {
1104    foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1105    #fix this!
1106    #_send "color background $r $g $b"
1107}
1108
1109# ----------------------------------------------------------------------
1110# CONFIGURATION OPTION: -plotforeground
1111# ----------------------------------------------------------------------
1112itcl::configbody Rappture::HeightmapViewer::plotforeground {
1113    foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1114    #fix this!
1115    #_send "color background $r $g $b"
1116}
1117
1118# ----------------------------------------------------------------------
1119# CONFIGURATION OPTION: -plotoutline
1120# ----------------------------------------------------------------------
1121itcl::configbody Rappture::HeightmapViewer::plotoutline {
1122    if {[IsConnected]} {
1123        _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
1124    }
1125}
1126
1127
1128
1129#  camera --
1130#
1131itcl::body Rappture::HeightmapViewer::camera {option args} {
1132    switch -- $option {
1133        "show" {
1134            puts [array get view_]
1135        }
1136        "set" {
1137            set who [lindex $args 0]
1138            set x $settings_($this-$who)
1139            set code [catch { string is double $x } result]
1140            if { $code != 0 || !$result } {
1141                set settings_($this-$who) $view_($who)
1142                return
1143            }
1144            switch -- $who {
1145                "pan-x" - "pan-y" {
1146                    set view_($who) $settings_($this-$who)
1147                    _PanCamera
1148                }
1149                "phi" - "theta" - "psi" {
1150                    set view_($who) $settings_($this-$who)
1151                    set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
1152                    _send "camera angle $xyz"
1153                }
1154                "zoom" {
1155                    set view_($who) $settings_($this-$who)
1156                    _send "camera zoom $view_(zoom)"
1157                }
1158            }
1159        }
1160    }
1161}
1162
1163itcl::body Rappture::HeightmapViewer::_BuildSettingsDrawer {} {
1164
1165    itk_component add settings {
1166        Rappture::Scroller $itk_component(drawer).scrl \
1167            -xscrollmode auto -yscrollmode auto \
1168            -width 200 -height 100
1169    }
1170
1171    itk_component add settings_canvas {
1172        canvas $itk_component(settings).canvas -highlightthickness 0
1173    }
1174    $itk_component(settings) contents $itk_component(settings_canvas)
1175
1176    itk_component add settings_frame {
1177        frame $itk_component(settings_canvas).frame -bg white \
1178            -highlightthickness 0
1179    }
1180    $itk_component(settings_canvas) create window 0 0 \
1181        -anchor nw -window $itk_component(settings_frame)
1182    bind $itk_component(settings_frame) <Configure> \
1183        [itcl::code $this drawer resize settings]
1184
1185    set fg [option get $itk_component(hull) font Font]
1186
1187    set inner $itk_component(settings_frame)
1188
1189    foreach { key value } {
1190        grid            1
1191        axes            0
1192        contourlines    1
1193        wireframe       fill
1194        legend          1
1195    } {
1196        set settings_($this-$key) $value
1197    }
1198    set inner $itk_component(settings_frame)
1199    label $inner.title -text "View Settings" -font "Arial 10 bold"
1200    checkbutton $inner.grid \
1201        -text "grid" \
1202        -variable [itcl::scope settings_($this-grid)] \
1203        -command [itcl::code $this _fixSettings grid] \
1204        -font "Arial 9"
1205    checkbutton $inner.axes \
1206        -text "axes" \
1207        -variable ::Rappture::HeightmapViewer::settings_($this-axes) \
1208        -command [itcl::code $this _fixSettings axes] \
1209        -font "Arial 9"
1210    checkbutton $inner.contourlines \
1211        -text "contour lines" \
1212        -variable ::Rappture::HeightmapViewer::settings_($this-contourlines) \
1213        -command [itcl::code $this _fixSettings contourlines]\
1214        -font "Arial 9"
1215    checkbutton $inner.wireframe \
1216        -text "wireframe" \
1217        -onvalue "wireframe" -offvalue "fill" \
1218        -variable ::Rappture::HeightmapViewer::settings_($this-wireframe) \
1219        -command [itcl::code $this _fixSettings wireframe]\
1220        -font "Arial 9"
1221    checkbutton $inner.legend \
1222        -text "legend" \
1223        -variable ::Rappture::HeightmapViewer::settings_($this-legend) \
1224        -command [itcl::code $this _fixSettings legend]\
1225        -font "Arial 9"
1226
1227    blt::table $inner \
1228        0,0 $inner.title -anchor w -columnspan 2 \
1229        1,1 $inner.grid -anchor w  \
1230        2,1 $inner.axes -anchor w \
1231        3,1 $inner.contourlines -anchor w \
1232        4,1 $inner.wireframe -anchor w \
1233        5,1 $inner.legend -anchor w
1234
1235    blt::table configure $inner c0 -resize expand -width 2
1236    blt::table configure $inner c2 -resize expand
1237    blt::table configure $inner c1 -resize none
1238
1239}
1240
1241itcl::body Rappture::HeightmapViewer::_BuildCameraDrawer {} {
1242
1243    itk_component add camera {
1244        Rappture::Scroller $itk_component(drawer).camerascrl \
1245            -xscrollmode auto -yscrollmode auto \
1246            -highlightthickness 0
1247    }
1248
1249    itk_component add camera_canvas {
1250        canvas $itk_component(camera).canvas -highlightthickness 0
1251    } {
1252        ignore -highlightthickness
1253    }
1254    $itk_component(camera) contents $itk_component(camera_canvas)
1255
1256    itk_component add camera_frame {
1257        frame $itk_component(camera_canvas).frame \
1258            -highlightthickness 0
1259    }
1260    $itk_component(camera_canvas) create window 0 0 \
1261        -anchor nw -window $itk_component(camera_frame)
1262    bind $itk_component(camera_frame) <Configure> \
1263        [itcl::code $this drawer resize camera]
1264
1265    set inner $itk_component(camera_frame)
1266
1267    label $inner.title -text "Camera Settings" -font "Arial 10 bold"
1268
1269    set labels { phi theta psi pan-x pan-y zoom }
1270    blt::table $inner \
1271        0,0 $inner.title -anchor w  -columnspan 4
1272    set row 1
1273    foreach tag $labels {
1274        label $inner.${tag}label -text $tag -font "Arial 9"
1275        entry $inner.${tag} -font "Arial 9"  -bg white \
1276            -textvariable [itcl::scope settings_($this-$tag)]
1277        bind $inner.${tag} <KeyPress-Return> \
1278            [itcl::code $this camera set ${tag}]
1279        blt::table $inner \
1280            $row,1 $inner.${tag}label -anchor e \
1281            $row,2 $inner.${tag} -anchor w
1282        incr row
1283    }
1284    bind $inner.title <Shift-ButtonPress> \
1285        [itcl::code $this camera show]
1286    blt::table configure $inner c0 -resize expand -width 4
1287    blt::table configure $inner c1 c2 -resize none
1288    blt::table configure $inner c3 -resize expand
1289
1290}
1291
1292itcl::body Rappture::HeightmapViewer::drawer { what who } {
1293    switch -- ${what} {
1294        "activate" {
1295            $itk_component(drawer) add $itk_component($who) -sticky nsew
1296            after idle [list focus $itk_component($who)]
1297            if { ![info exists initialized_($who)] } {
1298                set w [winfo width $itk_component(drawer)]
1299                set x [expr $w - 120]
1300                $itk_component(drawer) sash place 0 $x 0
1301                set initialized_($who) 1
1302            }
1303            $itk_component(${who}_button) configure -relief sunken
1304        }
1305        "deactivate" {
1306            $itk_component(drawer) forget $itk_component($who)
1307            $itk_component(${who}_button) configure -relief raised
1308        }
1309        "toggle" {
1310            set slaves [$itk_component(drawer) panes]
1311            if { [lsearch $slaves $itk_component($who)] >= 0 } {
1312                drawer deactivate $who
1313            } else {
1314                drawer activate $who
1315            }
1316        }
1317        "resize" {
1318            set bbox [$itk_component(${who}_canvas) bbox all]
1319            set wid [winfo width $itk_component(${who}_frame)]
1320            $itk_component(${who}_canvas) configure -width $wid \
1321                -scrollregion $bbox -yscrollincrement 0.1i
1322        }
1323    }
1324}
1325
Note: See TracBrowser for help on using the repository browser.